unmaintained/factory/commands/commands.factor

   1 USING: kernel combinators sequences math math.functions math.vectors mortar
   2     slot-accessors x x.widgets.wm.root x.widgets.wm.frame sequences.lib ;
   3 IN: factory.commands
   4
   5 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   6
   7 : up-till-frame ( window -- wm-frame )
   8 { { [ dup <wm-frame> is? ]
   9     [ ] }
  10   { [ dup $dpy $default-root $id over $id = ]
  11     [ drop f ] }
  12   { [ t ]
  13     [ <- parent up-till-frame ] } } cond ;
  14
  15 : pointer-window ( -- window ) dpy> <- pointer-window ;
  16
  17 : pointer-frame ( -- wm-frame )
  18 pointer-window up-till-frame dup <wm-frame> is? [ ] [ drop f ] if ;
  19
  20 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  21
  22 : maximize ( -- ) pointer-frame wm-frame-maximize drop ;
  23
  24 : minimize ( -- ) pointer-frame <- unmap drop ;
  25
  26 : maximize-vertical ( -- ) pointer-frame wm-frame-maximize-vertical drop ;
  27
  28 : restore ( -- ) pointer-frame <- restore-state drop ;
  29
  30 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  31
  32
  33
  34 : tile-master ( -- )
  35
  36 wm-root>
  37   <- children
  38   [ <- mapped? ] filter
  39   [ check-window-table ] map
  40   reverse
  41
  42 unclip
  43   { 0 0 } <-- move
  44   wm-root> <- size { 1/2 1 } v*
  45   [ floor ] map <-- resize
  46   <- adjust-child
  47 drop
  48
  49 dup empty? [ drop ] [
  50
  51 wm-root> <- width 2 / floor [ <-- set-width ] curry map
  52 wm-root> <- height over length / floor [ <-- set-height ] curry map
  53
  54 wm-root> <- width 2 / floor [ <-- set-x ] curry map
  55
  56 wm-root> <- height over length /   over length   [ * floor ] map-with
  57 [ <-- set-y <- adjust-child ] 2map
  58
  59 drop
  60
  61 ] if ;
  62
  63 ! : tile-master ( -- )
  64
  65 ! wm-root>
  66 !   <- children
  67 !   [ <- mapped? ] filter
  68 !   [ check-window-table ] map
  69 !   reverse
  70
  71 ! { { [ dup empty? ] [ drop ] }
  72 !   { [ dup length 1 = ] [ drop maximize ] }
  73 !   { [ t ] [ tile-master* ] }