splitter work, renaming compiler-backend::reduce to collapse

library/compiler/simplifier.factor

@@ -192,7 +192,7 @@ M: object next-logical ( linear vop -- linear )
 : next-logical? ( op linear -- ? )
     dup car next-logical dup [ car class = ] [ 2drop f ] ifte ;
 
-: reduce ( linear op new -- linear ? )
+: collapse ( linear op new -- linear ? )
     >r over cdr next-logical? [
         dup car vop-label
         r> execute swap cdr cons t
@@ -202,11 +202,11 @@ M: object next-logical ( linear vop -- linear )
 
 M: %call simplify-node ( linear vop -- ? )
     #! Tail call optimization.
-    drop \ %return \ %jump reduce ;
+    drop \ %return \ %jump collapse ;
 
 M: %call-label simplify-node ( linear vop -- ? )
     #! Tail call optimization.
-    drop \ %return \ %jump-label reduce ;
+    drop \ %return \ %jump-label collapse ;
 
 : double-jump ( linear op2 op1 -- linear ? )
     #! A jump to a jump is just a jump. If the next logical node

library/ui/splitters.factor

@@ -1,56 +1,56 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel matrices sequences ;
+USING: generic kernel lists matrices namespaces sequences ;
 
 TUPLE: divider splitter ;
 
-C: divider ( splitter -- divider )
-    [ set-divider-splitter ] keep
+C: divider ( -- divider )
     <plain-gadget> over set-delegate
     dup t reverse-video set-paint-prop ;
 
-M: divider pref-size drop 16 16 ;
+: divider-size { 8 8 0 } ;
 
-TUPLE: splitter vector first divider second split ;
+M: divider pref-size drop divider-size 3unseq drop ;
+
+TUPLE: splitter vector split ;
 
 M: splitter orientation splitter-vector ;
 
 C: splitter ( first second vector -- splitter )
     <empty-gadget> over set-delegate
     [ set-splitter-vector ] keep
-    [ set-splitter-second ] keep
-    [ set-splitter-first ] keep
-    [ dup <divider> swap set-splitter-divider ] keep
+    swapd
+    [ add-gadget ] keep
+    <divider> over add-gadget
+    [ add-gadget ] keep
     1/2 over set-splitter-split ;
 
-: <x-splitter> ( first second -- splitter )
-    { 1 0 0 } <splitter> ;
+: <x-splitter> { 1 0 0 } <splitter> ;
 
-: <y-splitter> ( first second -- splitter )
-    { 0 1 0 } <splitter> ;
+: <y-splitter> { 0 1 0 } <splitter> ;
 
-: splitter-pref-dims ( splitter -- dim dim dim )
-    dup splitter-first pref-dim
-    over splitter-divider pref-dim
-    rot splitter-second pref-dim ;
-
-M: splitter pref-size ( splitter -- w h )
-    [ splitter-pref-dims 3dup vmax vmax >r v+ v+ r> ] keep
-    orient 3unseq drop ;
-
-: size-divider ( splitter -- )
-    dup shape-dim over splitter-divider
-    [ rot orient ] keep set-gadget-dim ;
-
-: move-divider ( splitter -- )
+M: splitter pref-size
     [
-        dup shape-dim dup pick splitter-split v*n { 8 8 8 } v-
-        rot orient
-    ] keep splitter-divider set-gadget-loc ;
+        gadget-children [ pref-dim ] map
+        dup { 0 0 0 } swap [ vmax ] each
+        swap { 0 0 0 } swap [ v+ ] each
+    ] keep orient 3unseq drop ;
 
-: layout-divider ( splitter -- )
-    dup size-divider move-divider ;
+: splitter-part ( splitter -- vec )
+    dup splitter-split swap shape-dim n*v divider-size 1/2 v*n v- ;
+
+: splitter-layout ( splitter -- [ a b c ] )
+    [
+        dup splitter-part ,
+        divider-size ,
+        dup shape-dim swap splitter-part v- ,
+    ] make-list ;
+
+: layout-divider ( assoc -- )
+    [ uncons set-gadget-dim ] each ;
 
 M: splitter layout* ( splitter -- )
-    ( layout-divider ) drop ;
+    [
+        dup splitter-layout [ nip ( { 0 0 0 } rot orient ) ] map-with
+    ] keep gadget-children zip layout-divider ;