blinking cursor in UI

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 1cbcc78c563ed74d0b409ce3205ddfb668bee211..666c66bd3164c75c6d5ceaeffefbeabd150ee4c4 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,5 +1,4 @@
 - reader syntax for arrays, byte arrays, displaced aliens\r
-- sleep word\r
 - fix infer hang\r
 \r
 + ui:\r

diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor
index 321c93d6d89d1a6b18b0a057cd2ff7e6ba82b641..8f2de62e04a843a67d68edfb5bc9c40a5eecf32d 100644 (file)
--- a/library/generic/tuple.factor
+++ b/library/generic/tuple.factor
@@ -31,7 +31,7 @@ namespaces parser sequences strings vectors words ;
 : check-shape ( word slots -- )
     #! If the new list of slots is different from the previous,
     #! forget the old definition.
-    >r "use" get search dup [
+    >r "in" get lookup dup [
         dup "tuple-size" word-prop r> length 2 + =
         [ drop ] [ forget-tuple ] ifte
     ] [

diff --git a/library/test/tuple.factor b/library/test/tuple.factor
index af57abebce7936a9baefce5f3bb318b216abb2d3..f220de53038df3343c0e296c5bbdf6473c4acdbd 100644 (file)
--- a/library/test/tuple.factor
+++ b/library/test/tuple.factor
@@ -94,3 +94,11 @@ TUPLE: delegate-clone ;
 ! This must be the last test in the file!
 [ "<constructor-test>" ]
 [ "TUPLE: constructor-test ; C: constructor-test ;" eval word word-name ] unit-test
+
+! There was a typo in check-shape; it would unintern the wrong
+! words!
+[ "temporary-1" ]
+[
+    "IN: temporary-1 SYMBOL: foobar IN: temporary TUPLE: foobar ;" eval
+    "foobar" [ "temporary-1" "temporary" ] search word-vocabulary
+] unit-test

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index 5c0f5ac07d17779fe6e54a02d156eef27f35941d..830207a8469b5dd513fd55181730153a9f326900 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -1,8 +1,28 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel line-editor math matrices namespaces
-sdl sequences strings styles vectors ;
+USING: generic kernel math matrices namespaces sdl sequences
+strings styles vectors ;
+
+! A blinking caret
+TUPLE: caret ;
+
+C: caret ( -- caret )
+    <plain-gadget> over set-delegate
+    dup red background set-paint-prop
+    500 over set-gadget-framerate ;
+
+: toggle-visible ( gadget -- )
+    dup gadget-visible? not over set-gadget-visible?
+    relayout ;
+
+M: caret tick* ( ms caret -- ) nip toggle-visible ;
+
+: add-caret ( caret parent -- ) dupd add-gadget add-timer ;
+
+: unparent-caret ( caret -- ) dup remove-timer unparent ;
+
+USE: line-editor
 
 ! An editor gadget wraps a line editor object and passes
 ! gestures to the line editor.
@@ -22,10 +42,10 @@ TUPLE: editor line caret ;
     [ set-line-text ] with-editor ;
 
 : focus-editor ( editor -- )
-    dup editor-caret swap add-gadget ;
+    dup editor-caret swap add-caret ;
 
 : unfocus-editor ( editor -- )
-    editor-caret unparent ;
+    editor-caret unparent-caret ;
 
 : run-char-widths ( font str -- wlist )
     #! List of x co-ordinates of each character.
@@ -58,9 +78,6 @@ TUPLE: editor line caret ;
         [[ [ "END" ] [ [ end ] with-editor ] ]]
     ] swap add-actions ;
 
-: <caret> ( -- caret )
-    <plain-gadget> dup red background set-paint-prop ;
-
 C: editor ( text -- )
     <gadget> over set-delegate
     [ <line-editor> swap set-editor-line ] keep

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 9a9f063303dd038d01195dd8671c66ec32a8e8c8..d7f9c1abdbc02b07ecf991237e84c4e069eca430 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -33,7 +33,7 @@ M: rectangle inside? ( loc rect -- ? )
 ! A gadget is a rectangle, a paint, a mapping of gestures to
 ! actions, and a reference to the gadget's parent.
 TUPLE: gadget
-    paint gestures visible? relayout? root?
+    paint gestures framerate visible? relayout? root?
     parent children ;
 
 : gadget-child gadget-children first ;

diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index e57bf5717c065bcf66c0b4c26c426dc243f7be36..776d4169dec8f6b4c6f2d1b89ed5da0274d1f3df 100644 (file)
--- a/library/ui/hierarchy.factor
+++ b/library/ui/hierarchy.factor
@@ -6,8 +6,7 @@ sequences vectors ;
 
 : remove-gadget ( gadget parent -- )
     [ 2dup gadget-children remq swap set-gadget-children ] keep
-    relayout
-    f swap set-gadget-parent ;
+    relayout f swap set-gadget-parent ;
 
 : unparent ( gadget -- )
     [

diff --git a/library/ui/load.factor b/library/ui/load.factor
index b996162deb62f2f349ed0f53dd571cd0c95bbe7a..706d38a22fd966f4dff7692b0ec8c907cb927a22 100644 (file)
--- a/library/ui/load.factor
+++ b/library/ui/load.factor
@@ -10,6 +10,7 @@ USING: kernel parser sequences io ;
     "/library/ui/borders.factor"
     "/library/ui/frames.factor"
     "/library/ui/world.factor"
+    "/library/ui/timer.factor"
     "/library/ui/hand.factor"
     "/library/ui/labels.factor"
     "/library/ui/buttons.factor"

diff --git a/library/ui/timer.factor b/library/ui/timer.factor
new file mode 100644 (file)
index 0000000..766357b
--- /dev/null
+++ b/library/ui/timer.factor
@@ -0,0 +1,36 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
+USING: hashtables kernel math namespaces sequences ;
+
+TUPLE: timer gadget last ;
+
+C: timer ( gadget -- timer )
+    [ set-timer-gadget ] keep
+    millis over set-timer-last ;
+
+GENERIC: tick* ( ms gadget -- )
+
+: next-time ( timer -- ms )
+    dup timer-gadget gadget-framerate swap timer-last + ;
+
+: advance-timer ( ms timer -- delay )
+    #! Outputs the time since the last firing.
+    [ timer-last - 0 max ] 2keep set-timer-last ;
+
+: do-timer ( ms timer -- )
+    #! Takes current time, and a timer. If the timer is set to
+    #! fire, calls its callback.
+    dup next-time pick <=
+    [ [ advance-timer ] keep timer-gadget tick* ] [ 2drop ] ifte ;
+
+: timers ( -- hash ) world get world-timers ;
+
+: add-timer ( gadget -- ) [ <timer> ] keep timers set-hash ;
+
+: remove-timer ( gadget -- ) timers remove-hash ;
+
+: do-timers ( -- )
+    millis timers hash-values [ do-timer ] each-with ;
+
+M: gadget tick* ( ms gadget -- ) 2drop ;

diff --git a/library/ui/world.factor b/library/ui/world.factor
index 68c49436a817533de838e21b05e275ab8099d74f..785a9920a3b89327abe9b8e4eb7080e0efd0b23b 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -9,15 +9,17 @@ vectors ;
 ! gadgets are contained in. The current world is stored in the
 ! world variable. The invalid slot is a list of gadgets that
 ! need to be layout.
-TUPLE: world running? hand glass invalid ;
+TUPLE: world running? hand glass invalid timers ;
 
 DEFER: <hand>
 DEFER: update-hand
+DEFER: do-timers
 
 C: world ( -- world )
     f <stack> over set-delegate
     t over set-gadget-root?
-    dup <hand> over set-world-hand ;
+    dup <hand> over set-world-hand
+    <namespace> over set-world-timers ;
 
 : add-invalid ( gadget -- )
     world get [ world-invalid cons ] keep set-world-invalid ;
@@ -65,7 +67,7 @@ DEFER: handle-event
     next-event [
         handle-event run-world
     ] [
-        drop world-step
+        drop world-step do-timers
         world get world-running? [ 10 sleep run-world ] when
     ] ifte ;