refactoring timers

diff --git a/CHANGES.html b/CHANGES.html
index 7266cd6c5752cf3220e5eb1fe097301b6a53c6c4..9df93c39c3af47aeb1e572edb9826ba7cc741872 100644 (file)
--- a/CHANGES.html
+++ b/CHANGES.html
@@ -46,6 +46,7 @@
 <li>Everything else:
 
 <ul>
+<li>New <code>sleep ( ms -- )</code> word pauses current thread for a number of milliseconds.</li>
 <li>New <code>make-hash ( quot -- namespace )</code> combinator executes quotation in a new namespace, which is then pushed on the stack.</li>
 <li>Erlang/Termite-style concurrency library in <code>contrib/concurrency</code> (Chris Double).</li>
 <li>Object slots are now clickable in the inspector</li>

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 666c66bd3164c75c6d5ceaeffefbeabd150ee4c4..d9d77cc8b9063c5bf5a4a90485085249c2d1f073 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -15,7 +15,6 @@
 - an interior paint that is only painted on rollover and mouse press;\r
   use it for menu items. give menus a gradient background\r
 - scroll bar: more intuitive behavior when clicking inside the elevator\r
-- timers\r
 - nicer scrollbars with up/down buttons\r
 - icons\r
 - use incremental strategy for all pack layouts where possible\r

diff --git a/library/threads.factor b/library/threads.factor
index a65584af930c805fe7abe12fb971b152a0fee462..8fc21eb7e7caba4b33e4ceb1640de7561eb56062 100644 (file)
--- a/library/threads.factor
+++ b/library/threads.factor
@@ -46,4 +46,44 @@ DEFER: next-thread
     global [
         <queue> \ run-queue set
         10 <vector> \ sleep-queue set
+        <namespace> \ timers set
     ] bind ;
+
+TUPLE: timer object delay last ;
+
+: timer-now millis swap set-timer-last ;
+
+C: timer ( object delay -- timer )
+    [ set-timer-delay ] keep
+    [ set-timer-object ] keep
+    dup timer-now ;
+
+GENERIC: tick ( ms object -- )
+
+: timers ( -- hash ) \ timers global hash ;
+
+: add-timer ( object delay -- )
+    [ <timer> ] keep timers set-hash ;
+
+: remove-timer ( object -- ) timers remove-hash ;
+
+: restart-timer ( object -- )
+    timers hash [ timer-now ] when* ;
+
+: next-time ( timer -- ms ) dup timer-delay 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-object tick*
+    ] [
+        2drop
+    ] ifte ;
+
+: do-timers ( -- )
+    millis timers hash-values [ do-timer ] each-with ;

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index 830207a8469b5dd513fd55181730153a9f326900..eccf25bd09846cd42cae29bd75512837375f4fa0 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -2,15 +2,14 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic kernel math matrices namespaces sdl sequences
-strings styles vectors ;
+strings styles threads 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 ;
+    dup red background set-paint-prop ;
 
 : toggle-visible ( gadget -- )
     dup gadget-visible? not over set-gadget-visible?
@@ -18,9 +17,16 @@ C: caret ( -- caret )
 
 M: caret tick* ( ms caret -- ) nip toggle-visible ;
 
-: add-caret ( caret parent -- ) dupd add-gadget add-timer ;
+: caret-block 500 ;
 
-: unparent-caret ( caret -- ) dup remove-timer unparent ;
+: add-caret ( caret parent -- )
+    dupd add-gadget caret-block add-timer ;
+
+: unparent-caret ( caret -- )
+    dup remove-timer unparent ;
+
+: reset-caret ( caret -- )
+    dup restart-timer t swap set-gadget-visible? ;
 
 USE: line-editor
 
@@ -33,6 +39,7 @@ TUPLE: editor line caret ;
     #! Execute a quotation in the line editor scope, then
     #! update the display.
     swap [ editor-line swap bind ] keep
+    dup editor-caret reset-caret
     dup relayout scroll>bottom ; inline
 
 : editor-text ( editor -- text )

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index d7f9c1abdbc02b07ecf991237e84c4e069eca430..9a9f063303dd038d01195dd8671c66ec32a8e8c8 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 framerate visible? relayout? root?
+    paint gestures visible? relayout? root?
     parent children ;
 
 : gadget-child gadget-children first ;

diff --git a/library/ui/timer.factor b/library/ui/timer.factor
deleted file mode 100644 (file)
index 766357b..0000000
--- a/library/ui/timer.factor
+++ /dev/null
@@ -1,36 +0,0 @@
-! 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 785a9920a3b89327abe9b8e4eb7080e0efd0b23b..2cfb9dbe7507772ddcf0b9fb06524c41fc942666 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -9,7 +9,7 @@ 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 timers ;
+TUPLE: world running? hand glass invalid ;
 
 DEFER: <hand>
 DEFER: update-hand
@@ -18,8 +18,7 @@ DEFER: do-timers
 C: world ( -- world )
     f <stack> over set-delegate
     t over set-gadget-root?
-    dup <hand> over set-world-hand
-    <namespace> over set-world-timers ;
+    dup <hand> over set-world-hand ;
 
 : add-invalid ( gadget -- )
     world get [ world-invalid cons ] keep set-world-invalid ;