diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 0b3c1e5cf5..e3ce693542 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,7 +1,5 @@ + bugs to fix soon - if write returns -1 and errno == EINTR then it's not a real error, you can try again - http://developer.apple.com/technotes/tn2004/tn2123.html#SECLIMITATIONS http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4742.html not *too* long diff --git a/library/ui/fonts.factor b/library/ui/fonts.factor index e00a683cff..8c0c01512d 100644 --- a/library/ui/fonts.factor +++ b/library/ui/fonts.factor @@ -5,7 +5,7 @@ USING: alien hashtables io kernel lists namespaces sdl sequences styles ; : ttf-name ( font style -- name ) - cons [ + cons {{ [[ [[ "Monospaced" plain ]] "VeraMono" ]] [[ [[ "Monospaced" bold ]] "VeraMoBd" ]] [[ [[ "Monospaced" bold-italic ]] "VeraMoBI" ]] @@ -18,7 +18,7 @@ styles ; [[ [[ "Serif" bold ]] "VeraSeBd" ]] [[ [[ "Serif" bold-italic ]] "VeraBI" ]] [[ [[ "Serif" italic ]] "VeraIt" ]] - ] assoc ; + }} hash ; : ttf-path ( name -- string ) [ resource-path % "/fonts/" % % ".ttf" % ] make-string ; @@ -35,7 +35,9 @@ global [ open-fonts nest drop ] bind : ttf-init ( -- ) TTF_Init - open-fonts [ [ cdr expired? not ] hash-subset ] change ; + global [ + open-fonts [ [ cdr expired? not ] hash-subset ] change + ] bind ; : gadget-font ( gadget -- font ) [ font paint-prop ] keep diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor index f7aeecbcb8..c43512e0ac 100644 --- a/library/ui/hierarchy.factor +++ b/library/ui/hierarchy.factor @@ -4,36 +4,34 @@ IN: gadgets USING: generic hashtables kernel lists math matrices namespaces sequences ; -: remove-gadget ( gadget box -- ) +: remove-gadget ( gadget parent -- ) [ 2dup gadget-children remq swap set-gadget-children ] keep relayout f swap set-gadget-parent ; -: (add-gadget) ( gadget box -- ) - #! This is inefficient. - [ gadget-children swap add ] keep - set-gadget-children ; - : unparent ( gadget -- ) [ dup gadget-parent dup [ remove-gadget ] [ 2drop ] ifte ] when* ; -: add-gadget ( gadget box -- ) - #! Add a gadget to a box. +: (add-gadget) ( gadget box -- ) + #! This is inefficient. over unparent dup pick set-gadget-parent - tuck (add-gadget) - relayout ; + [ gadget-children swap add ] keep set-gadget-children ; -: (parent-list) ( gadget -- ) - [ dup gadget-parent (parent-list) , ] when* ; +: add-gadget ( gadget parent -- ) + #! Add a gadget to a parent gadget. + [ (add-gadget) ] keep relayout ; -: parent-list ( gadget -- list ) +: (parents) ( gadget -- ) + [ dup gadget-parent (parents) , ] when* ; + +: parents ( gadget -- list ) #! A list of all parents of the gadget, including the #! gadget itself. - [ (parent-list) ] make-list ; + [ (parents) ] make-list ; : (each-parent) ( list quot -- ? ) over [ @@ -51,7 +49,7 @@ sequences ; : each-parent ( gadget quot -- ? ) #! Keep executing the quotation on higher and higher #! parents until it returns f. - >r parent-list r> (each-parent) ; inline + >r parents r> (each-parent) ; inline : screen-pos ( gadget -- point ) #! The position of the gadget on the screen. diff --git a/library/ui/incremental.factor b/library/ui/incremental.factor index e5c42a08a2..f92ee39bd2 100644 --- a/library/ui/incremental.factor +++ b/library/ui/incremental.factor @@ -14,12 +14,14 @@ USING: generic kernel matrices ; TUPLE: incremental cursor ; -M: incremental pref-dim incremental-cursor ; - C: incremental ( pack -- incremental ) [ set-delegate ] keep { 0 0 0 } over set-incremental-cursor ; +M: incremental pref-dim incremental-cursor ; + +M: incremental layout* drop ; + : next-cursor ( gadget incremental -- cursor ) [ swap shape-dim swap incremental-cursor @@ -33,8 +35,12 @@ C: incremental ( pack -- incremental ) dup incremental-cursor dup rot pack-vector v* v- swap set-shape-loc ; +: prefer-incremental ( gadget -- ) + dup pref-dim swap set-shape-dim ; + : add-incremental ( gadget incremental -- ) - 2dup add-gadget - >r dup dup pref-dim swap set-shape-dim r> - f over set-gadget-relayout? - 2dup incremental-loc update-cursor ; + 2dup (add-gadget) + over prefer-incremental + 2dup incremental-loc + tuck update-cursor + prefer-incremental ; diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor index 10791ef1eb..61177c2ff5 100644 --- a/library/ui/init-world.factor +++ b/library/ui/init-world.factor @@ -1,16 +1,15 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets -USING: generic kernel math namespaces styles ; +USING: generic io kernel listener math namespaces styles threads ; global [ world set {{ - [[ background [ 255 255 255 ] ]] - [[ rollover-bg [ 216 216 216 ] ]] + [[ rollover-bg [ 255 255 204 ] ]] [[ foreground [ 0 0 0 ] ]] [[ reverse-video f ]] [[ font "Sans Serif" ]] @@ -22,9 +21,13 @@ global [ add-layer - dup - "Stack display goes here"