]> gitweb.factorcode.org Git - factor.git/commitdiff
Rename alarms -> timers
authorDoug Coleman <doug.coleman@gmail.com>
Thu, 10 Jun 2010 21:39:13 +0000 (16:39 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Thu, 10 Jun 2010 21:39:13 +0000 (16:39 -0500)
31 files changed:
basis/alarms/alarms-docs.factor [deleted file]
basis/alarms/alarms-tests.factor [deleted file]
basis/alarms/alarms.factor
basis/alarms/authors.txt [changed mode: 0755->0644]
basis/alarms/summary.txt [deleted file]
basis/concurrency/conditions/conditions.factor
basis/furnace/alloy/alloy.factor
basis/furnace/sessions/sessions.factor
basis/io/timeouts/timeouts.factor
basis/logging/insomniac/insomniac.factor
basis/models/delay/delay.factor
basis/timers/authors.txt [new file with mode: 0755]
basis/timers/summary.txt [new file with mode: 0644]
basis/timers/timers-docs.factor [new file with mode: 0644]
basis/timers/timers-tests.factor [new file with mode: 0644]
basis/timers/timers.factor [new file with mode: 0644]
basis/tools/deploy/config/config-docs.factor
basis/tools/deploy/shaker/shaker.factor
basis/tools/scaffold/scaffold.factor
basis/ui/gadgets/editors/editors.factor
basis/ui/gestures/gestures.factor
extra/audio/engine/engine.factor
extra/audio/engine/test/test.factor
extra/game/input/demos/joysticks/joysticks.factor
extra/game/input/demos/key-caps/key-caps.factor
extra/game/loop/loop.factor
extra/irc/gitbot/gitbot.factor
extra/key-logger/key-logger.factor
extra/site-watcher/site-watcher.factor
extra/tetris/tetris.factor
extra/webapps/planet/planet.factor

diff --git a/basis/alarms/alarms-docs.factor b/basis/alarms/alarms-docs.factor
deleted file mode 100644 (file)
index 3b70b43..0000000
+++ /dev/null
@@ -1,74 +0,0 @@
-USING: help.markup help.syntax calendar quotations system ;\r
-IN: alarms\r
-\r
-HELP: alarm\r
-{ $class-description "An alarm. Can be passed to " { $link stop-alarm } "." } ;\r
-\r
-HELP: start-alarm\r
-{ $values { "alarm" alarm } }\r
-{ $description "Starts an alarm." } ;\r
-\r
-HELP: restart-alarm\r
-{ $values { "alarm" alarm } }\r
-{ $description "Starts or restarts an alarm. Restarting an alarm causes the a sleep of initial delay nanoseconds before looping. An alarm's parameters may be modified and restarted with this word." } ;\r
-\r
-HELP: stop-alarm\r
-{ $values { "alarm" alarm } }\r
-{ $description "Prevents an alarm from calling its quotation again. Has no effect on alarms that are not currently running." } ;\r
-\r
-HELP: every\r
-{ $values\r
-     { "quot" quotation } { "interval-duration" duration }\r
-     { "alarm" alarm } }\r
-{ $description "Creates an alarm that calls the quotation repeatedly, using " { $snippet "duration" } " as the frequency. The first call of " { $snippet "quot" } " will happen immediately. If the quotation throws an exception, the alarm will stop." }\r
-{ $examples\r
-    { $unchecked-example\r
-        "USING: alarms io calendar ;"\r
-        """[ "Hi Buddy." print flush ] 10 seconds every drop"""\r
-        ""\r
-    }\r
-} ;\r
-\r
-HELP: later\r
-{ $values { "quot" quotation } { "delay-duration" duration } { "alarm" alarm } }\r
-{ $description "Sleeps for " { $snippet "duration" } " and then calls a " { $snippet "quot" } ". The user may cancel the alarm before " { $snippet "quot" } " runs. This alarm is not repeated." }\r
-{ $examples\r
-    { $unchecked-example\r
-        "USING: alarms io calendar ;"\r
-        """[ "Break's over!" print flush ] 15 minutes later drop"""\r
-        ""\r
-    }\r
-} ;\r
-\r
-HELP: delayed-every\r
-{ $values\r
-     { "quot" quotation } { "duration" duration }\r
-     { "alarm" alarm } }\r
-{ $description "Creates an alarm that calls " { $snippet "quot" } " repeatedly, waiting " { $snippet "duration" } " before calling " { $snippet "quot" } " the first time and then waiting " { $snippet "duration" } " between further calls. If the quotation throws an exception, the alarm will stop." }\r
-{ $examples\r
-    { $unchecked-example\r
-        "USING: alarms io calendar ;"\r
-        """[ "Hi Buddy." print flush ] 10 seconds every drop"""\r
-        ""\r
-    }\r
-} ;\r
-\r
-ARTICLE: "alarms" "Alarms"\r
-"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks. Alarms run in a single green thread per alarm and consist of a quotation, a delay duration, and an interval duration. After starting an alarm, the alarm thread sleeps for the delay duration and calls the quotation. Then it waits out the interval duration and calls the quotation again until something stops the alarm. If a recurring alarm's quotation would be scheduled to run again before the previous quotation has finished processing, the alarm will be run again immediately afterwards. This may result in the alarm falling behind indefinitely, in which case the it will run as often as possible while still allowing other green threads to run. Recurring alarms that execute 'on time' or 'catch up' will always be scheduled for an exact multiple of the interval from the original starting time to prevent the alarm from drifting over time. Alarms use " { $link nano-count } " as the timing primitive, so they will continue to work across system clock changes." $nl\r
-"The alarm class:"\r
-{ $subsections alarm }\r
-"Create an alarm before starting it:"\r
-{ $subsections <alarm> }\r
-"Starting an alarm:"\r
-{ $subsections start-alarm restart-alarm }\r
-"Stopping an alarm:"\r
-{ $subsections stop-alarm }\r
-\r
-"A recurring alarm without an initial delay:"\r
-{ $subsections every }\r
-"A one-time alarm with an initial delay:"\r
-{ $subsections later }\r
-"A recurring alarm with an initial delay:"\r
-{ $subsections delayed-every } ;\r
-\r
-ABOUT: "alarms"\r
diff --git a/basis/alarms/alarms-tests.factor b/basis/alarms/alarms-tests.factor
deleted file mode 100644 (file)
index ed1ab63..0000000
+++ /dev/null
@@ -1,67 +0,0 @@
-USING: alarms alarms.private calendar concurrency.count-downs\r
-concurrency.promises fry kernel math math.order sequences\r
-threads tools.test tools.time ;\r
-IN: alarms.tests\r
-\r
-[ ] [\r
-    1 <count-down>\r
-    { f } clone 2dup\r
-    [ first stop-alarm count-down ] 2curry 1 seconds later\r
-    swap set-first\r
-    await\r
-] unit-test\r
-\r
-[ ] [\r
-    self [ resume ] curry instant later drop\r
-    "test" suspend drop\r
-] unit-test\r
-\r
-[ t ] [\r
-    [\r
-        <promise>\r
-        [ '[ t _ fulfill ] 2 seconds later drop ]\r
-        [ 5 seconds ?promise-timeout drop ] bi\r
-    ] benchmark 1,500,000,000 2,500,000,000 between?\r
-] unit-test\r
-\r
-[ { 3 } ] [\r
-    { 3 } dup\r
-    '[ 4 _ set-first ] 2 seconds later\r
-    1/2 seconds sleep\r
-    stop-alarm\r
-] unit-test\r
-\r
-[ { 1 } ] [\r
-    { 0 }\r
-    dup '[ 0 _ [ 1 + ] change-nth ] 3 seconds later\r
-    [ stop-alarm ] [ start-alarm ] bi\r
-    4 seconds sleep\r
-] unit-test\r
-\r
-[ { 0 } ] [\r
-    { 0 }\r
-    dup '[ 3 seconds sleep 1 _ set-first ] 1 seconds later\r
-    2 seconds sleep stop-alarm\r
-    1/2 seconds sleep\r
-] unit-test\r
-\r
-[ { 0 } ] [\r
-    { 0 }\r
-    dup '[ 1 _ set-first ] 300 milliseconds later\r
-    150 milliseconds sleep\r
-    [ restart-alarm ] [ 200 milliseconds sleep stop-alarm ] bi\r
-] unit-test\r
-\r
-[ { 1 } ] [\r
-    { 0 }\r
-    dup '[ 0 _ [ 1 + ] change-nth ] 200 milliseconds later\r
-    100 milliseconds sleep restart-alarm 300 milliseconds sleep\r
-] unit-test\r
-\r
-[ { 4 } ] [\r
-    { 0 }\r
-    dup '[ 0 _ [ 1 + ] change-nth ] 300 milliseconds 300 milliseconds\r
-    <alarm> dup start-alarm\r
-    700 milliseconds sleep dup restart-alarm\r
-    700 milliseconds sleep stop-alarm 500 milliseconds sleep\r
-] unit-test\r
index 92035a19c8d16277267cf6491c238eb93de19935..ddca921c784380e9b6484584ed18be9587c6a933 100644 (file)
@@ -1,119 +1,5 @@
-! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
+! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs calendar combinators.short-circuit fry
-heaps init kernel math math.functions math.parser namespaces
-quotations sequences system threads ;
+USING: ;
 IN: alarms
 
-TUPLE: alarm
-    { quot callable initial: [ ] }
-    start-nanos 
-    delay-nanos
-    interval-nanos
-    iteration-start-nanos
-    quotation-running?
-    restart?
-    thread ;
-
-<PRIVATE
-
-GENERIC: >nanoseconds ( obj -- duration/f )
-M: f >nanoseconds ;
-M: real >nanoseconds >integer ;
-M: duration >nanoseconds duration>nanoseconds >integer ;
-
-: set-next-alarm-time ( alarm -- alarm )
-    ! start + delay + ceiling((now - (start + delay)) / interval) * interval
-    nano-count 
-    over start-nanos>> -
-    over delay-nanos>> [ - ] when*
-    over interval-nanos>> / ceiling
-    over interval-nanos>> *
-    over start-nanos>> +
-    over delay-nanos>> [ + ] when*
-    >>iteration-start-nanos ;
-
-: stop-alarm? ( alarm -- ? )
-    { [ thread>> self eq? not ] [ restart?>> ] } 1|| ;
-
-DEFER: call-alarm-loop
-
-: loop-alarm ( alarm -- )
-    nano-count over
-    [ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
-    [ set-next-alarm-time ] dip
-    [ dup iteration-start-nanos>> ] [ 0 ] if
-    0 or sleep-until call-alarm-loop ;
-
-: maybe-loop-alarm ( alarm -- )
-    dup { [ stop-alarm? ] [ interval-nanos>> not ] } 1||
-    [ drop ] [ loop-alarm ] if ;
-
-: call-alarm-loop ( alarm -- )
-    dup stop-alarm? [
-        drop
-    ] [
-        [
-            [ t >>quotation-running? drop ]
-            [ quot>> call( -- ) ]
-            [ f >>quotation-running? drop ] tri
-        ] keep
-        maybe-loop-alarm
-    ] if ;
-
-: sleep-delay ( alarm -- )
-    dup stop-alarm? [
-        drop
-    ] [
-        nano-count >>start-nanos
-        delay-nanos>> [ sleep ] when*
-    ] if ;
-
-: alarm-loop ( alarm -- )
-    [ sleep-delay ]
-    [ nano-count >>iteration-start-nanos call-alarm-loop ]
-    [ dup restart?>> [ f >>restart? alarm-loop ] [ drop ] if ] tri ;
-
-PRIVATE>
-
-: <alarm> ( quot delay-duration/f interval-duration/f -- alarm )
-    alarm new
-        swap >nanoseconds >>interval-nanos
-        swap >nanoseconds >>delay-nanos
-        swap >>quot ; inline
-
-: start-alarm ( alarm -- )
-    [
-        '[ _ alarm-loop ] "Alarm execution" spawn
-    ] keep thread<< ;
-
-: stop-alarm ( alarm -- )
-    dup quotation-running?>> [
-        f >>thread drop
-    ] [
-        [ [ interrupt ] when* f ] change-thread drop
-    ] if ;
-
-: restart-alarm ( alarm -- )
-    t >>restart?
-    dup quotation-running?>> [
-        drop
-    ] [
-        dup thread>> [ nip interrupt ] [ start-alarm ] if*
-    ] if ;
-
-<PRIVATE
-
-: (start-alarm) ( quot start-duration interval-duration -- alarm )
-    <alarm> [ start-alarm ] keep ;
-
-PRIVATE>
-
-: every ( quot interval-duration -- alarm )
-    [ f ] dip (start-alarm) ;
-
-: later ( quot delay-duration -- alarm )
-    f (start-alarm) ;
-
-: delayed-every ( quot duration -- alarm )
-    dup (start-alarm) ;
old mode 100755 (executable)
new mode 100644 (file)
diff --git a/basis/alarms/summary.txt b/basis/alarms/summary.txt
deleted file mode 100644 (file)
index f6e1223..0000000
+++ /dev/null
@@ -1 +0,0 @@
-One-time and recurring events
index 9353317f0bc758d9ed10c1e4c6162781282b9472..7bd72ec826607535c56ea0ed3da95d72bb1ba343 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: deques threads kernel arrays sequences alarms fry ;\r
+USING: deques threads kernel arrays sequences timers fry ;\r
 IN: concurrency.conditions\r
 \r
 : notify-1 ( deque -- )\r
@@ -9,8 +9,8 @@ IN: concurrency.conditions
 : notify-all ( deque -- )\r
     [ resume-now ] slurp-deque ; inline\r
 \r
-: queue-timeout ( queue timeout -- alarm )\r
-    #! Add an alarm which removes the current thread from the\r
+: queue-timeout ( queue timeout -- timer )\r
+    #! Add an timer which removes the current thread from the\r
     #! queue, and resumes it, passing it a value of t.\r
     [\r
         [ self swap push-front* ] keep '[\r
@@ -28,7 +28,7 @@ ERROR: wait-timeout ;
 : wait ( queue timeout status -- )\r
     over [\r
         [ queue-timeout ] dip suspend\r
-        [ wait-timeout ] [ stop-alarm ] if\r
+        [ wait-timeout ] [ stop-timer ] if\r
     ] [\r
         [ drop queue ] dip suspend drop\r
     ] if ; inline\r
index dc280c1e4474f38f5817a21306def76e0aca8309..ef4270221fd376809088a7d1ee0365272cca9129 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences db.tuples alarms calendar db fry
+USING: kernel sequences db.tuples timers calendar db fry
 furnace.db
 furnace.cache
 furnace.asides
index 3eb7a1121519855b6df5416c4c9868087e89a122..33de393d900d9dc7ed2703cf793060b7d437e002 100644 (file)
@@ -3,7 +3,7 @@
 USING: assocs kernel math.intervals math.parser namespaces
 strings random accessors quotations hashtables sequences
 continuations fry calendar combinators combinators.short-circuit
-destructors alarms io.sockets db db.tuples db.types
+destructors io.sockets db db.tuples db.types
 http http.server http.server.dispatchers http.server.filters
 furnace.cache furnace.scopes furnace.utilities ;
 IN: furnace.sessions
index 957ba301938033cfd9d8ac2f71257fede331dec0..68110ded1599ca22f914d9f6bd2d74a076d4c679 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov, Doug Coleman\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel calendar alarms io io.encodings accessors\r
+USING: kernel calendar timers io io.encodings accessors\r
 namespaces fry io.streams.null ;\r
 IN: io.timeouts\r
 \r
@@ -13,11 +13,11 @@ M: encoder set-timeout stream>> set-timeout ;
 \r
 GENERIC: cancel-operation ( obj -- )\r
 \r
-: queue-timeout ( obj timeout -- alarm )\r
+: queue-timeout ( obj timeout -- timer )\r
     [ '[ _ cancel-operation ] ] dip later ;\r
 \r
 : with-timeout* ( obj timeout quot -- )\r
-    3dup drop queue-timeout [ nip call ] dip stop-alarm ;\r
+    3dup drop queue-timeout [ nip call ] dip stop-timer ;\r
     inline\r
 \r
 : with-timeout ( obj quot -- )\r
index 72e37ef8af458561841b97b43b23d73227d107d7..2a0be6aa79ed1fd571c1cf1269fb608ca08abc94 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 USING: logging.analysis logging.server logging smtp kernel\r
-io.files io.streams.string namespaces make alarms assocs\r
+io.files io.streams.string namespaces make timers assocs\r
 io.encodings.utf8 accessors calendar sequences ;\r
 QUALIFIED: io.sockets\r
 IN: logging.insomniac\r
index 8292bb9c04fb9ba0e852cc18300eb46c4731eca3..d194d76e6d09e5902d46ca9bad794eb04c4bb6c3 100644 (file)
@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors alarms fry kernel models ;\r
+USING: accessors timers fry kernel models ;\r
 IN: models.delay\r
 \r
-TUPLE: delay < model model timeout alarm ;\r
+TUPLE: delay < model model timeout timer ;\r
 \r
 : update-delay-model ( delay -- )\r
     [ model>> value>> ] keep set-model ;\r
@@ -15,13 +15,13 @@ TUPLE: delay < model model timeout alarm ;
         [ add-dependency ] keep ;\r
 \r
 : stop-delay ( delay -- )\r
-    alarm>> [ stop-alarm ] when* ;\r
+    timer>> [ stop-timer ] when* ;\r
 \r
 : start-delay ( delay -- )\r
     dup\r
-    [ '[ _ f >>alarm update-delay-model ] ] [ timeout>> ] bi\r
+    [ '[ _ f >>timer update-delay-model ] ] [ timeout>> ] bi\r
     later\r
-    >>alarm drop ;\r
+    >>timer drop ;\r
 \r
 M: delay model-changed nip dup stop-delay start-delay ;\r
 \r
diff --git a/basis/timers/authors.txt b/basis/timers/authors.txt
new file mode 100755 (executable)
index 0000000..7c1b2f2
--- /dev/null
@@ -0,0 +1 @@
+Doug Coleman
diff --git a/basis/timers/summary.txt b/basis/timers/summary.txt
new file mode 100644 (file)
index 0000000..56260b6
--- /dev/null
@@ -0,0 +1 @@
+One-time and recurring timers for relative time offsets
diff --git a/basis/timers/timers-docs.factor b/basis/timers/timers-docs.factor
new file mode 100644 (file)
index 0000000..fb07c8a
--- /dev/null
@@ -0,0 +1,74 @@
+USING: help.markup help.syntax calendar quotations system ;\r
+IN: timers\r
+\r
+HELP: timer\r
+{ $class-description "A timer. Can be passed to " { $link stop-timer } "." } ;\r
+\r
+HELP: start-timer\r
+{ $values { "timer" timer } }\r
+{ $description "Starts a timer." } ;\r
+\r
+HELP: restart-timer\r
+{ $values { "timer" timer } }\r
+{ $description "Starts or restarts a timer. Restarting a timer causes the a sleep of initial delay nanoseconds before looping. An timer's parameters may be modified and restarted with this word." } ;\r
+\r
+HELP: stop-timer\r
+{ $values { "timer" timer } }\r
+{ $description "Prevents a timer from calling its quotation again. Has no effect on timers that are not currently running." } ;\r
+\r
+HELP: every\r
+{ $values\r
+     { "quot" quotation } { "interval-duration" duration }\r
+     { "timer" timer } }\r
+{ $description "Creates a timer that calls the quotation repeatedly, using " { $snippet "duration" } " as the frequency. The first call of " { $snippet "quot" } " will happen immediately. If the quotation throws an exception, the timer will stop." }\r
+{ $examples\r
+    { $unchecked-example\r
+        "USING: timers io calendar ;"\r
+        """[ "Hi Buddy." print flush ] 10 seconds every drop"""\r
+        ""\r
+    }\r
+} ;\r
+\r
+HELP: later\r
+{ $values { "quot" quotation } { "delay-duration" duration } { "timer" timer } }\r
+{ $description "Sleeps for " { $snippet "duration" } " and then calls a " { $snippet "quot" } ". The user may cancel the timer before " { $snippet "quot" } " runs. This timer is not repeated." }\r
+{ $examples\r
+    { $unchecked-example\r
+        "USING: timers io calendar ;"\r
+        """[ "Break's over!" print flush ] 15 minutes later drop"""\r
+        ""\r
+    }\r
+} ;\r
+\r
+HELP: delayed-every\r
+{ $values\r
+     { "quot" quotation } { "duration" duration }\r
+     { "timer" timer } }\r
+{ $description "Creates a timer that calls " { $snippet "quot" } " repeatedly, waiting " { $snippet "duration" } " before calling " { $snippet "quot" } " the first time and then waiting " { $snippet "duration" } " between further calls. If the quotation throws an exception, the timer will stop." }\r
+{ $examples\r
+    { $unchecked-example\r
+        "USING: timers io calendar ;"\r
+        """[ "Hi Buddy." print flush ] 10 seconds every drop"""\r
+        ""\r
+    }\r
+} ;\r
+\r
+ARTICLE: "timers" "Alarms"\r
+"The " { $vocab-link "timers" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks. Alarms run in a single green thread per timer and consist of a quotation, a delay duration, and an interval duration. After starting a timer, the timer thread sleeps for the delay duration and calls the quotation. Then it waits out the interval duration and calls the quotation again until something stops the timer. If a recurring timer's quotation would be scheduled to run again before the previous quotation has finished processing, the timer will be run again immediately afterwards. This may result in the timer falling behind indefinitely, in which case the it will run as often as possible while still allowing other green threads to run. Recurring timers that execute 'on time' or 'catch up' will always be scheduled for an exact multiple of the interval from the original starting time to prevent the timer from drifting over time. Alarms use " { $link nano-count } " as the timing primitive, so they will continue to work across system clock changes." $nl\r
+"The timer class:"\r
+{ $subsections timer }\r
+"Create a timer before starting it:"\r
+{ $subsections <timer> }\r
+"Starting a timer:"\r
+{ $subsections start-timer restart-timer }\r
+"Stopping a timer:"\r
+{ $subsections stop-timer }\r
+\r
+"A recurring timer without an initial delay:"\r
+{ $subsections every }\r
+"A one-time timer with an initial delay:"\r
+{ $subsections later }\r
+"A recurring timer with an initial delay:"\r
+{ $subsections delayed-every } ;\r
+\r
+ABOUT: "timers"\r
diff --git a/basis/timers/timers-tests.factor b/basis/timers/timers-tests.factor
new file mode 100644 (file)
index 0000000..82274af
--- /dev/null
@@ -0,0 +1,67 @@
+USING: timers timers.private calendar concurrency.count-downs\r
+concurrency.promises fry kernel math math.order sequences\r
+threads tools.test tools.time ;\r
+IN: timers.tests\r
+\r
+[ ] [\r
+    1 <count-down>\r
+    { f } clone 2dup\r
+    [ first stop-timer count-down ] 2curry 1 seconds later\r
+    swap set-first\r
+    await\r
+] unit-test\r
+\r
+[ ] [\r
+    self [ resume ] curry instant later drop\r
+    "test" suspend drop\r
+] unit-test\r
+\r
+[ t ] [\r
+    [\r
+        <promise>\r
+        [ '[ t _ fulfill ] 2 seconds later drop ]\r
+        [ 5 seconds ?promise-timeout drop ] bi\r
+    ] benchmark 1,500,000,000 2,500,000,000 between?\r
+] unit-test\r
+\r
+[ { 3 } ] [\r
+    { 3 } dup\r
+    '[ 4 _ set-first ] 2 seconds later\r
+    1/2 seconds sleep\r
+    stop-timer\r
+] unit-test\r
+\r
+[ { 1 } ] [\r
+    { 0 }\r
+    dup '[ 0 _ [ 1 + ] change-nth ] 3 seconds later\r
+    [ stop-timer ] [ start-timer ] bi\r
+    4 seconds sleep\r
+] unit-test\r
+\r
+[ { 0 } ] [\r
+    { 0 }\r
+    dup '[ 3 seconds sleep 1 _ set-first ] 1 seconds later\r
+    2 seconds sleep stop-timer\r
+    1/2 seconds sleep\r
+] unit-test\r
+\r
+[ { 0 } ] [\r
+    { 0 }\r
+    dup '[ 1 _ set-first ] 300 milliseconds later\r
+    150 milliseconds sleep\r
+    [ restart-timer ] [ 200 milliseconds sleep stop-timer ] bi\r
+] unit-test\r
+\r
+[ { 1 } ] [\r
+    { 0 }\r
+    dup '[ 0 _ [ 1 + ] change-nth ] 200 milliseconds later\r
+    100 milliseconds sleep restart-timer 300 milliseconds sleep\r
+] unit-test\r
+\r
+[ { 4 } ] [\r
+    { 0 }\r
+    dup '[ 0 _ [ 1 + ] change-nth ] 300 milliseconds 300 milliseconds\r
+    <timer> dup start-timer\r
+    700 milliseconds sleep dup restart-timer\r
+    700 milliseconds sleep stop-timer 500 milliseconds sleep\r
+] unit-test\r
diff --git a/basis/timers/timers.factor b/basis/timers/timers.factor
new file mode 100644 (file)
index 0000000..ab6b4d6
--- /dev/null
@@ -0,0 +1,119 @@
+! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar combinators.short-circuit fry
+heaps init kernel math math.functions math.parser namespaces
+quotations sequences system threads ;
+IN: timers
+
+TUPLE: timer
+    { quot callable initial: [ ] }
+    start-nanos 
+    delay-nanos
+    interval-nanos
+    iteration-start-nanos
+    quotation-running?
+    restart?
+    thread ;
+
+<PRIVATE
+
+GENERIC: >nanoseconds ( obj -- duration/f )
+M: f >nanoseconds ;
+M: real >nanoseconds >integer ;
+M: duration >nanoseconds duration>nanoseconds >integer ;
+
+: set-next-timer-time ( timer -- timer )
+    ! start + delay + ceiling((now - (start + delay)) / interval) * interval
+    nano-count 
+    over start-nanos>> -
+    over delay-nanos>> [ - ] when*
+    over interval-nanos>> / ceiling
+    over interval-nanos>> *
+    over start-nanos>> +
+    over delay-nanos>> [ + ] when*
+    >>iteration-start-nanos ;
+
+: stop-timer? ( timer -- ? )
+    { [ thread>> self eq? not ] [ restart?>> ] } 1|| ;
+
+DEFER: call-timer-loop
+
+: loop-timer ( timer -- )
+    nano-count over
+    [ iteration-start-nanos>> - ] [ interval-nanos>> ] bi <
+    [ set-next-timer-time ] dip
+    [ dup iteration-start-nanos>> ] [ 0 ] if
+    0 or sleep-until call-timer-loop ;
+
+: maybe-loop-timer ( timer -- )
+    dup { [ stop-timer? ] [ interval-nanos>> not ] } 1||
+    [ drop ] [ loop-timer ] if ;
+
+: call-timer-loop ( timer -- )
+    dup stop-timer? [
+        drop
+    ] [
+        [
+            [ t >>quotation-running? drop ]
+            [ quot>> call( -- ) ]
+            [ f >>quotation-running? drop ] tri
+        ] keep
+        maybe-loop-timer
+    ] if ;
+
+: sleep-delay ( timer -- )
+    dup stop-timer? [
+        drop
+    ] [
+        nano-count >>start-nanos
+        delay-nanos>> [ sleep ] when*
+    ] if ;
+
+: timer-loop ( timer -- )
+    [ sleep-delay ]
+    [ nano-count >>iteration-start-nanos call-timer-loop ]
+    [ dup restart?>> [ f >>restart? timer-loop ] [ drop ] if ] tri ;
+
+PRIVATE>
+
+: <timer> ( quot delay-duration/f interval-duration/f -- timer )
+    timer new
+        swap >nanoseconds >>interval-nanos
+        swap >nanoseconds >>delay-nanos
+        swap >>quot ; inline
+
+: start-timer ( timer -- )
+    [
+        '[ _ timer-loop ] "Alarm execution" spawn
+    ] keep thread<< ;
+
+: stop-timer ( timer -- )
+    dup quotation-running?>> [
+        f >>thread drop
+    ] [
+        [ [ interrupt ] when* f ] change-thread drop
+    ] if ;
+
+: restart-timer ( timer -- )
+    t >>restart?
+    dup quotation-running?>> [
+        drop
+    ] [
+        dup thread>> [ nip interrupt ] [ start-timer ] if*
+    ] if ;
+
+<PRIVATE
+
+: (start-timer) ( quot start-duration interval-duration -- timer )
+    <timer> [ start-timer ] keep ;
+
+PRIVATE>
+
+: every ( quot interval-duration -- timer )
+    [ f ] dip (start-timer) ;
+
+: later ( quot delay-duration -- timer )
+    f (start-timer) ;
+
+: delayed-every ( quot duration -- timer )
+    dup (start-timer) ;
index 740abb0feb0e4055885e86ad5f0feb687ce6f299..4ee9869f76b806e6469813e060021170873d571f 100644 (file)
@@ -64,7 +64,7 @@ $nl
 HELP: deploy-threads?
 { $description "Deploy flag. If set, thread support will be included in the final image."
 $nl
-"On by default. Most programs depend on libraries which use threads even if they don't use threads directly; for example, alarms, non-blocking I/O, and the UI are built on top of threads. If after testing your program still works without threads, you can disable this feature to save some space." } ;
+"On by default. Most programs depend on libraries which use threads even if they don't use threads directly; for example, timers, non-blocking I/O, and the UI are built on top of threads. If after testing your program still works without threads, you can disable this feature to save some space." } ;
 
 HELP: deploy-ui?
 { $description "Deploy flag. If set, the Factor UI will be included in the deployed image."
index 44291a96cc5b5193bce15435631fad31f58b39d1..b435f5c8e7dfca4cc89da6a19844cd69f89fcb53 100755 (executable)
@@ -317,7 +317,7 @@ IN: tools.deploy.shaker
         strip-io? [ io-backend , ] when
 
         { } {
-            "alarms"
+            "timers"
             "tools"
             "io.launcher"
             "random"
index 8fd3e53e19230db9ab725828e5666de54998fdc3..e995876f2627a9da3e8d7ce39c8a14796fe522a8 100644 (file)
@@ -5,7 +5,7 @@ io.encodings.utf8 hashtables kernel namespaces sequences
 vocabs.loader vocabs.metadata io combinators calendar accessors
 math.parser io.streams.string ui.tools.operations quotations
 strings arrays prettyprint words vocabs sorting sets classes
-math alien urls splitting ascii combinators.short-circuit alarms
+math alien urls splitting ascii combinators.short-circuit timers
 words.symbol system summary ;
 IN: tools.scaffold
 
@@ -128,7 +128,7 @@ M: bad-developer-name summary
         { "ch" "a character" }
         { "word" word }
         { "array" array }
-        { "alarm" alarm }
+        { "timers" timer }
         { "duration" duration }
         { "path" "a pathname string" }
         { "vocab" "a vocabulary specifier" }
index 4777e42abcaa28e65dbd98482f604be67d302e4d..d50405809fd79e5ff105c1915ccaac0f69bc1474 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alarms arrays assocs calendar colors.constants
+USING: accessors timers arrays assocs calendar colors.constants
 combinators combinators.short-circuit documents
 documents.elements fry grouping kernel locals make math
 math.functions math.order math.ranges math.rectangles
@@ -15,7 +15,7 @@ IN: ui.gadgets.editors
 TUPLE: editor < line-gadget
 caret-color
 caret mark
-focused? blink blink-alarm ;
+focused? blink blink-timer ;
 
 <PRIVATE
 
@@ -60,11 +60,11 @@ SYMBOL: blink-interval
 750 milliseconds blink-interval set-global
 
 : stop-blinking ( editor -- )
-    blink-alarm>> [ stop-alarm ] when* ;
+    blink-timer>> [ stop-timer ] when* ;
 
 : start-blinking ( editor -- )
     t >>blink
-    blink-alarm>> [ restart-alarm ] when* ;
+    blink-timer>> [ restart-timer ] when* ;
 
 : restart-blinking ( editor -- )
     dup focused?>> [
@@ -80,12 +80,12 @@ M: editor graft*
     [ dup mark>> activate-editor-model ]
     [
         [
-            '[ _ blink-caret ] blink-interval get dup <alarm>
-        ] keep blink-alarm<<
+            '[ _ blink-caret ] blink-interval get dup <timer>
+        ] keep blink-timer<<
     ] tri ;
 
 M: editor ungraft*
-    [ [ stop-blinking ] [ f >>blink-alarm drop ] bi ]
+    [ [ stop-blinking ] [ f >>blink-timer drop ] bi ]
     [ dup caret>> deactivate-editor-model ]
     [ dup mark>> deactivate-editor-model ] tri ;
 
index 41b7f69cbe31b1b8a1c5060a3b14c8d8924d943d..658e179301c97d25fee8d7cb2a7297e956f0341e 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs kernel math math.order models
 namespaces make sequences words strings system hashtables math.parser
-math.vectors classes.tuple classes boxes calendar alarms combinators
+math.vectors classes.tuple classes boxes calendar timers combinators
 sets columns fry deques ui.gadgets ui.gadgets.private ascii
 combinators.short-circuit ;
 FROM: namespaces => set ;
@@ -188,15 +188,15 @@ SYMBOL: drag-timer
         [ drag-gesture ]
         300 milliseconds
         100 milliseconds
-        <alarm>
+        <timer>
         [ drag-timer get-global >box ]
-        [ start-alarm ] bi
+        [ start-timer ] bi
     ] when ;
 
 : stop-drag-timer ( -- )
     hand-buttons get-global empty? [
         drag-timer get-global ?box
-        [ stop-alarm ] [ drop ] if
+        [ stop-timer ] [ drop ] if
     ] when ;
 
 : fire-motion ( -- )
index a188df853b5a16c54328f4b036be153ce344e130..d7079c4aaa75278de1bf4b7304fb79f55e30bd78 100644 (file)
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors alien audio classes.struct fry calendar alarms
+USING: accessors alien audio classes.struct fry calendar timers
 combinators combinators.short-circuit destructors generalizations
 kernel literals locals math openal sequences
 sequences.generalizations specialized-arrays strings ;
@@ -70,7 +70,7 @@ TUPLE: audio-engine < disposable
     listener
     { next-source integer }
     clips
-    update-alarm ;
+    update-timer ;
 
 TUPLE: audio-clip < disposable
     { audio-engine audio-engine }
@@ -226,20 +226,20 @@ DEFER: update-audio
 
 : start-audio ( audio-engine -- )
     dup start-audio*
-    dup '[ _ update-audio ] 20 milliseconds every >>update-alarm
+    dup '[ _ update-audio ] 20 milliseconds every >>update-timer
     drop ;
 
 : stop-audio ( audio-engine -- )
     dup al-sources>> [
         {
             [ make-engine-current ]
-            [ update-alarm>> [ stop-alarm ] when* ]
+            [ update-timer>> [ stop-timer ] when* ]
             [ clips>> clone [ dispose ] each ]
             [ al-sources>> free-sources ]
             [
                 f >>al-sources
                 f >>clips
-                f >>update-alarm
+                f >>update-timer
                 drop
             ]
             [ al-context>> alcSuspendContext ]
index 0791a226d465edc06770b301308c2c0b575b8269..419f31d73bf532bc07d5cda23eef8402aecc6662 100644 (file)
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors alarms audio audio.engine audio.loader calendar
+USING: accessors timers audio audio.engine audio.loader calendar
 destructors io kernel locals math math.functions math.ranges specialized-arrays
 sequences random math.vectors ;
 FROM: alien.c-types => short ;
@@ -41,10 +41,10 @@ M: noise-generator dispose
         ] when
 
         engine update-audio
-    ] 20 milliseconds every :> alarm
+    ] 20 milliseconds every :> timer
     "Press Enter to stop the test." print
     readln drop
-    alarm stop-alarm
+    timer stop-timer
     engine dispose ;
 
 MAIN: audio-engine-test
index ab65369ea1eeaddd0147e7400cab1d58b2ef1f21..3f909c7781e8292794e3c8bc0f7fe50a1994afe4 100644 (file)
@@ -1,7 +1,7 @@
 USING: ui ui.gadgets sequences kernel arrays math colors
 colors.constants ui.render ui.pens.polygon ui.pens.solid math.vectors
 accessors fry ui.gadgets.packs game.input ui.gadgets.labels
-ui.gadgets.borders alarms calendar locals strings ui.gadgets.buttons
+ui.gadgets.borders timers calendar locals strings ui.gadgets.buttons
 combinators math.parser assocs threads ;
 IN: game.input.demos.joysticks
 
@@ -73,7 +73,7 @@ CONSTANT: pov-polygons
     COLOR: red   <indicator-gadget> [ >>indicator   ] [ add-gadget ] bi
     dup [ 0.0 0.0 0.0 move-axis ] [ f move-pov ] bi ;
 
-TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
+TUPLE: joystick-demo-gadget < pack axis raxis controller buttons timer ;
 
 : add-gadget-with-border ( parent child -- parent )
     { 2 2 } <border> COLOR: gray <solid> >>boundary add-gadget ;
@@ -108,7 +108,7 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
 
 : kill-update-axes ( gadget -- )
     COLOR: gray <solid> >>interior
-    [ [ stop-alarm ] when* f ] change-alarm
+    [ [ stop-timer ] when* f ] change-timer
     relayout-1 ;
 
 : (update-axes) ( gadget controller-state -- )
@@ -125,11 +125,11 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
     [ (update-axes) ] [ kill-update-axes ] if* ;
 
 M: joystick-demo-gadget graft*
-    dup '[ _ update-axes ] FREQUENCY every >>alarm
+    dup '[ _ update-axes ] FREQUENCY every >>timer
     drop ;
 
 M: joystick-demo-gadget ungraft*
-    alarm>> [ stop-alarm ] when* ;
+    timer>> [ stop-timer ] when* ;
 
 : joystick-window ( controller -- )
     [ <joystick-demo-gadget> ] [ product-string ] bi
index 363c7c801c867bebfaa7c4516ee478052aea5865..c8d8e0bc53d397c181f2201a341a5717ff906046 100644 (file)
@@ -1,6 +1,6 @@
 USING: game.input game.input.scancodes
 kernel ui.gadgets ui.gadgets.buttons sequences accessors
-words arrays assocs math calendar fry alarms ui
+words arrays assocs math calendar fry timers ui
 ui.gadgets.borders ui.gestures literals ;
 IN: game.input.demos.key-caps
 
@@ -134,7 +134,7 @@ CONSTANT: key-locations H{
 CONSTANT: KEYBOARD-SIZE { 230 65 }
 CONSTANT: FREQUENCY $[ 1/30 seconds ]
 
-TUPLE: key-caps-gadget < gadget keys alarm ;
+TUPLE: key-caps-gadget < gadget keys timer ;
 
 : make-key-gadget ( scancode dim array -- )
     [ 
@@ -163,11 +163,11 @@ M: key-caps-gadget pref-dim* drop KEYBOARD-SIZE ;
 
 M: key-caps-gadget graft*
     open-game-input
-    dup '[ _ update-key-caps-state ] FREQUENCY every >>alarm
+    dup '[ _ update-key-caps-state ] FREQUENCY every >>timer
     drop ;
 
 M: key-caps-gadget ungraft*
-    alarm>> [ stop-alarm ] when*
+    timer>> [ stop-timer ] when*
     close-game-input ;
 
 M: key-caps-gadget handle-gesture
index a26a52226e8b97df1ec33ad2b13df0daa53366e2..48f9ca83eaded0eaeb97ecbc746167f8c0250e80 100644 (file)
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors alarms alien.c-types calendar classes.struct
+USING: accessors timers alien.c-types calendar classes.struct
 continuations destructors fry kernel math math.order memory
 namespaces sequences specialized-vectors system
 tools.memory ui ui.gadgets.worlds vm vocabs.loader arrays
@@ -14,7 +14,7 @@ TUPLE: game-loop
     { running? boolean }
     { tick# integer }
     { frame# integer }
-    alarm
+    timer
     benchmark-data ;
 
 STRUCT: game-loop-benchmark
@@ -110,12 +110,12 @@ PRIVATE>
     [
         [ '[ _ game-tick ] f ]
         [ tick-interval-nanos>> nanoseconds ] bi
-        <alarm>
-    ] keep [ alarm<< ] [ drop start-alarm ] 2bi ;
+        <timer>
+    ] keep [ timer<< ] [ drop start-timer ] 2bi ;
 
 : stop-loop ( loop -- )
     f >>running?
-    alarm>> stop-alarm ;
+    timer>> stop-timer ;
 
 : <game-loop*> ( tick-interval-nanos tick-delegate draw-delegate -- loop )
     nano-count f 0 0 f
index 950b34a8d79d80782b3cc7d3a1946f6f5901f14d..02337276e61e9ab0d013d49f451d3474ffc2d8da 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry irc.client irc.client.chats kernel namespaces
 sequences threads io.launcher io splitting
-make mason.common mason.updates calendar math alarms
+make mason.common mason.updates calendar math timers
 io.encodings.8-bit.latin1 debugger ;
 IN: irc.gitbot
 
index 471c86cbfdb6477be7ef155203297b7ab328cd0b..fd04d3a15da087218f91d823900c7f3f7bb283bf 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alarms bit-arrays calendar game.input io
+USING: accessors timers bit-arrays calendar game.input io
 io.binary io.encodings.binary io.files kernel literals math
 namespaces system threads ;
 IN: key-logger
@@ -28,7 +28,7 @@ SYMBOL: key-logger
     ] unless ;
 
 : stop-key-logger ( -- )
-    key-logger get-global [ stop-alarm ] when*
+    key-logger get-global [ stop-timer ] when*
     f key-logger set-global
     close-game-input ;
 
index 5d97284551e01cc92dcf0891705718688d65d8a5..f0e086343e22dc0ebdeb5e1b493fbbb4cf230010 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alarms arrays calendar combinators
+USING: accessors timers arrays calendar combinators
 combinators.smart continuations debugger http.client fry
 init io.streams.string kernel locals math math.parser db
 namespaces sequences site-watcher.db site-watcher.email ;
@@ -48,4 +48,4 @@ PRIVATE>
     ] unless ;
 
 : stop-site-watcher ( -- )
-    running-site-watcher get [ stop-alarm ] when* ;
+    running-site-watcher get [ stop-timer ] when* ;
index 839d9690c2d6dea2b17f583610438313d20e452c..25802a241103147dd9f2f4e3a3776bcbd22bd544 100644 (file)
@@ -1,10 +1,13 @@
 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alarms arrays calendar kernel make math math.rectangles math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ;
+USING: accessors timers arrays calendar kernel make math math.rectangles
+math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets
+ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures
+ui.render ui ;
 FROM: tetris.game => level>> ;
 IN: tetris
 
-TUPLE: tetris-gadget < gadget { tetris tetris } { alarm } ;
+TUPLE: tetris-gadget < gadget { tetris tetris } { timer } ;
 
 : <tetris-gadget> ( tetris -- gadget )
     tetris-gadget new swap >>tetris ;
@@ -52,10 +55,10 @@ tetris-gadget H{
     [ tetris>> ?update ] [ relayout-1 ] bi ;
 
 M: tetris-gadget graft* ( gadget -- )
-    [ [ tick ] curry 100 milliseconds every ] keep alarm<< ;
+    [ [ tick ] curry 100 milliseconds every ] keep timer<< ;
 
 M: tetris-gadget ungraft* ( gadget -- )
-    [ stop-alarm f ] change-alarm drop ;
+    [ stop-timer f ] change-timer drop ;
 
 : tetris-window ( -- ) 
     [
index a003c8b618b4768f6f3a44da2ef0b2d1427bb860..a2beb513ab2b54900bb5c259a563a186bcacb87f 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences sorting math math.order
-calendar alarms logging concurrency.combinators namespaces
+calendar timers logging concurrency.combinators namespaces
 db.types db.tuples db fry locals hashtables
 syndication urls xml.writer validators
 html.forms