Minor UI tweaks

TODO.FACTOR.txt

@@ -44,6 +44,9 @@
 
 + ui:
 
+- list of key bindings
+- presentation types
+- present/accept
 - graphical module manager tool
 - figure out what goes in the .app and what doesn't
 - should be possible to drop an image file on the .app to run it

library/ui/gadgets/tracks.factor

@@ -33,7 +33,7 @@ C: track ( orientation -- track )
     nip ;
 
 M: track layout*
-    dup track-layout packed-layout ;
+    dup track-layout pack-layout ;
 
 : track-pref-dims ( dims sizes -- dims )
     [ [ dup zero? [ nip ] [ v/n ] if ] 2map max-dim ] keep

library/ui/layouts.factor

@@ -110,12 +110,14 @@ TUPLE: pack align fill gap ;
 : packed-locs ( gadget sizes -- seq )
     over pack-gap over gap-locs >r dupd aligned-locs r> orient ;
 
-: packed-layout ( gadget sizes -- )
-    over gadget-children
-    >r dupd packed-dims r> 2dup
-    [ >r [ ceiling >fixnum ] map r> set-layout-dim ] 2each
-    >r packed-locs r>
-    [ >r [ >fixnum ] map r> set-rect-loc ] 2each ;
+: round-dims ( seq -- newseq )
+    { 0 0 } swap
+    [ swap v- dup [ ceiling ] map [ swap v- ] keep ] map nip ;
+
+: pack-layout ( gadget sizes -- )
+    round-dims over gadget-children
+    >r dupd packed-dims r> 2dup [ set-layout-dim ] 2each
+    >r packed-locs r> [ set-rect-loc ] 2each ;
 
 C: pack ( vector -- pack )
     #! gap: between each child.
@@ -133,19 +135,20 @@ C: pack ( vector -- pack )
 
 : <shelf> ( -- pack ) { 1 0 } <pack> ;
 
-: gap-dims ( gap sizes -- seeq )
-    [ { 0 0 } [ v+ ] reduce ] keep
-    length 1 [-] rot n*v v+ ;
+: dim-sum ( seq -- dim ) { 0 0 } [ v+ ] reduce ;
 
-: pack-pref-dim ( children gadget -- dim )
-    [ >r [ max-dim ] keep r> pack-gap swap gap-dims ] keep
-    gadget-orientation set-axis ;
+: gap-dims ( gap sizes -- seeq )
+    [ dim-sum ] keep length 1 [-] rot n*v v+ ;
+
+: pack-pref-dim ( gadget sizes -- dim )
+    over pack-gap over gap-dims >r max-dim r>
+    rot gadget-orientation set-axis ;
 
 M: pack pref-dim*
-    [ gadget-children pref-dims ] keep pack-pref-dim ;
+    dup gadget-children pref-dims pack-pref-dim ;
 
 M: pack layout*
-    dup gadget-children pref-dims packed-layout ;
+    dup gadget-children pref-dims pack-layout ;
 
 : fast-children-on ( dim axis gadgets -- i )
     swapd [ rect-loc v- over v. ] binsearch nip ;
@@ -153,9 +156,11 @@ M: pack layout*
 M: pack children-on
     dup gadget-orientation swap gadget-children [
         3dup
-        >r >r dup rect-loc swap rect-dim v+ origin get v- r> r> fast-children-on 1+
+        >r >r dup rect-loc swap rect-dim v+ origin get v-
+        r> r> fast-children-on 1+
         >r
-        >r >r rect-loc origin get v- r> r> fast-children-on
+        >r >r rect-loc origin get v-
+        r> r> fast-children-on
         0 max
         r>
     ] keep <slice> ;

library/ui/tools/listener.factor

@@ -48,9 +48,6 @@ C: listener-gadget ( -- gadget )
         { [ <listener-input> ] set-listener-gadget-input [ <scroller> ] 1/6 }
     } { 0 1 } make-track* dup start-listener ;
 
-M: listener-gadget pref-dim*
-    delegate pref-dim* { 500 600 } vmax ;
-
 M: listener-gadget focusable-child*
     listener-gadget-input ;
 

library/ui/world.factor

@@ -41,7 +41,7 @@ C: world ( gadget -- world )
 : find-world [ world? ] find-parent ;
 
 M: world pref-dim*
-    delegate pref-dim* { 1024 768 } vmin ;
+    delegate pref-dim* [ >fixnum ] map { 1024 768 } vmin ;
 
 : activate-world-model ( world model -- )
     [ add-connection ] keep activate-model ;