presentations in UI of words and vocabs

library/ui/layouts.factor

@@ -27,10 +27,13 @@ namespaces sdl sequences ;
 : with-layout ( quot -- )
     [ 0 x set 0 y set call ] with-scope ; inline
 
-: packed-pref-dim ( children gap axis -- dim )
+: pref-dims ( gadget -- list )
+    gadget-children [ pref-dim ] map ;
+
+: packed-pref-dim ( gadget gap axis -- dim )
     #! The preferred size of the gadget, if all children are
     #! packed in the direction of the given axis.
     >r
-    over length 0 max v*n >r [ pref-dim ] map r>
+    over length 0 max v*n >r pref-dims r>
     2dup [ v+ ] reduce >r [ vmax ] reduce r>
     r> set-axis ;

library/ui/panes.factor

@@ -29,15 +29,16 @@ TUPLE: pane output active current input continuation ;
 : pop-continuation ( pane -- quot )
     dup pane-continuation f rot set-pane-continuation ;
 
-: pane-return ( pane -- )
+: pane-eval ( line pane -- )
-    [
-        pane-input [
-            commit-history line-text get line-clear
-        ] with-editor
-    ] keep
     2dup stream-write "\n" over stream-write
     pop-continuation in-thread drop ;
 
+: pane-return ( pane -- )
+    [
+        pane-input
+        [ commit-history line-text get line-clear ] with-editor
+    ] keep pane-eval ;
+ 
 : pane-actions ( line -- )
     [
         [[ [ button-down 1 ] [ pane-input click-editor ] ]]
@@ -55,15 +56,15 @@ C: pane ( -- pane )
     dup pane-paint
     dup pane-actions ;
 
-: pane-write-1 ( style pane text -- )
+: pane-write-1 ( style text pane -- )
-    swap >r <styled-label> r> pane-current add-gadget ;
+    [ <presentation> ] keep pane-current add-gadget ;
 
 : pane-terpri ( pane -- )
     dup pane-current over pane-output add-gadget
     <line-shelf> over set-pane-current init-active-line ;
 
 : pane-write ( style pane list -- )
-    3dup car pane-write-1 cdr dup
+    3dup car swap pane-write-1 cdr dup
     [ over pane-terpri pane-write ] [ 3drop ] ifte ;
 
 ! Panes are streams.

library/ui/piles.factor

@@ -32,7 +32,7 @@ C: pile ( align gap fill -- pile )
 : <line-pile> 0 { 0 0 0 } 1 <pile> ;
 
 M: pile pref-dim ( pile -- dim )
-    dup gadget-children swap pile-gap { 0 1 0 } packed-pref-dim ;
+    dup pile-gap { 0 1 0 } packed-pref-dim ;
 
 : w- swap shape-w swap pref-size drop - ;
 : pile-x/y ( pile gadget offset -- )

library/ui/presentations.factor

@@ -4,13 +4,18 @@ IN: gadgets
 USING: hashtables io kernel lists namespaces parser prettyprint
 sequences ;
 
-: actions-menu ( -- )
+: actions-menu ( pane actions -- menu )
-    "actions" get [ uncons [ eval ] append cons ] map
+    [ uncons rot [ pane-eval ] cons cons cons ] map-with <menu> ;
-    <menu> show-menu ;
 
-: init-actions ( gadget -- )
+: init-actions ( gadget pane -- )
-    [ "actions" get actions-menu ] button-gestures ;
+    over "actions" paint-prop dup [
+        actions-menu [ show-menu ] cons button-gestures
+    ] [
+        3drop
+    ] ifte ;
 
 : <styled-label> ( style text -- label )
-    <label> "actions" pick assoc [ dup init-actions ] when
+    <label> swap alist>hash over set-gadget-paint ;
-    swap alist>hash over set-gadget-paint ;
+
+: <presentation> ( style text pane -- presentation )
+    >r <styled-label> dup r> init-actions ;

library/ui/scrolling.factor

@@ -123,7 +123,7 @@ TUPLE: scroller viewport x y ;
 : add-y-slider 2dup set-scroller-y add-right ;
 
 : viewport>bottom ( -- viewport )
-    dup viewport-dim vneg over viewport-origin
+    dup viewport-origin over viewport-dim vneg
     { 0 1 0 } set-axis swap scroll ;
 
 : (scroll>bottom) ( scroller -- )

library/ui/splitters.factor

@@ -44,8 +44,7 @@ C: splitter ( first second vector -- splitter )
 : <y-splitter> { 1 0 0 } <splitter> ;
 
 M: splitter pref-dim
-    dup gadget-children swap splitter-vector
+    { 0 0 0 } over splitter-vector packed-pref-dim ;
-    { 0 0 0 } swap packed-pref-dim ;
 
 : splitter-part ( splitter -- vec )
     dup splitter-split swap shape-dim n*v divider-size 1/2 v*n v- ;

native/alien.c

@@ -5,7 +5,10 @@ void primitive_expired(void)
 	CELL object = dpeek();
 
 	if(type_of(object) == ALIEN_TYPE)
+	{
+		ALIEN *alien = untag_alien_fast(object);
 		drepl(tag_boolean(alien->expired));
+	}
 	else
 		drepl(F);
 }