]> gitweb.factorcode.org Git - factor.git/commitdiff
Update code base for new alarms api
authorDoug Coleman <doug.coleman@gmail.com>
Sat, 22 May 2010 01:42:12 +0000 (20:42 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sat, 22 May 2010 01:42:12 +0000 (20:42 -0500)
12 files changed:
basis/concurrency/conditions/conditions.factor
basis/io/timeouts/timeouts.factor
basis/models/delay/delay.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/loop/loop.factor
extra/joystick-demo/joystick-demo.factor
extra/key-caps/key-caps.factor
extra/site-watcher/site-watcher.factor
extra/tetris/tetris.factor

index 2fb75226eb2e44272ffdbf82fc6e164204c57302..9353317f0bc758d9ed10c1e4c6162781282b9472 100644 (file)
@@ -28,7 +28,7 @@ ERROR: wait-timeout ;
 : wait ( queue timeout status -- )\r
     over [\r
         [ queue-timeout ] dip suspend\r
-        [ wait-timeout ] [ cancel-alarm ] if\r
+        [ wait-timeout ] [ stop-alarm ] if\r
     ] [\r
         [ drop queue ] dip suspend drop\r
     ] if ; inline\r
index 8e69983e9c8d5e2983fb2b07da4dd9f33bf65f79..957ba301938033cfd9d8ac2f71257fede331dec0 100644 (file)
@@ -17,7 +17,7 @@ GENERIC: cancel-operation ( obj -- )
     [ '[ _ cancel-operation ] ] dip later ;\r
 \r
 : with-timeout* ( obj timeout quot -- )\r
-    3dup drop queue-timeout [ nip call ] dip cancel-alarm ;\r
+    3dup drop queue-timeout [ nip call ] dip stop-alarm ;\r
     inline\r
 \r
 : with-timeout ( obj quot -- )\r
index a1d4ee9907fa435929ac287bb45b5037d590aa1f..b71a29e4efed64ce18c23c59397878dc089982a5 100644 (file)
@@ -14,14 +14,14 @@ TUPLE: delay < model model timeout alarm ;
         over >>model\r
         [ add-dependency ] keep ;\r
 \r
-: cancel-delay ( delay -- )\r
-    alarm>> [ cancel-alarm ] when* ;\r
+: stop-delay ( delay -- )\r
+    alarm>> [ stop-alarm ] when* ;\r
 \r
 : start-delay ( delay -- )\r
     dup\r
     [ [ f >>alarm update-delay-model ] curry ] [ timeout>> ] bi later\r
     >>alarm drop ;\r
 \r
-M: delay model-changed nip dup cancel-delay start-delay ;\r
+M: delay model-changed nip dup stop-delay start-delay ;\r
 \r
 M: delay model-activated update-delay-model ;\r
index da60d66afff72794d83ee90b6919bf2b23fc036a..f4dcff4cbe605db668ce9b4f67eac1cfe3d36a1f 100644 (file)
@@ -60,7 +60,7 @@ SYMBOL: blink-interval
 750 milliseconds blink-interval set-global
 
 : stop-blinking ( editor -- )
-    [ [ cancel-alarm ] when* f ] change-blink-alarm drop ;
+    [ [ stop-alarm ] when* f ] change-blink-alarm drop ;
 
 : start-blinking ( editor -- )
     [ stop-blinking ] [
index a45c325cc6c114c18b6f135704230a90bcdcbbf6..41b7f69cbe31b1b8a1c5060a3b14c8d8924d943d 100644 (file)
@@ -188,13 +188,15 @@ SYMBOL: drag-timer
         [ drag-gesture ]
         300 milliseconds
         100 milliseconds
-        add-alarm drag-timer get-global >box
+        <alarm>
+        [ drag-timer get-global >box ]
+        [ start-alarm ] bi
     ] when ;
 
 : stop-drag-timer ( -- )
     hand-buttons get-global empty? [
         drag-timer get-global ?box
-        [ cancel-alarm ] [ drop ] if
+        [ stop-alarm ] [ drop ] if
     ] when ;
 
 : fire-motion ( -- )
index 02d53bd5ab77f6ca78b094e6c5533f9d10abaa46..a188df853b5a16c54328f4b036be153ce344e130 100644 (file)
@@ -233,7 +233,7 @@ DEFER: update-audio
     dup al-sources>> [
         {
             [ make-engine-current ]
-            [ update-alarm>> [ cancel-alarm ] when* ]
+            [ update-alarm>> [ stop-alarm ] when* ]
             [ clips>> clone [ dispose ] each ]
             [ al-sources>> free-sources ]
             [
index bbc6c339e9f6b5359735d83d3fb256a676d9bb3a..0791a226d465edc06770b301308c2c0b575b8269 100644 (file)
@@ -44,7 +44,7 @@ M: noise-generator dispose
     ] 20 milliseconds every :> alarm
     "Press Enter to stop the test." print
     readln drop
-    alarm cancel-alarm
+    alarm stop-alarm
     engine dispose ;
 
 MAIN: audio-engine-test
index 93c3a21baf5d72be5555d6f87c8fb910b54528d7..c4c190355bf00d27fe5231c258867054c32dd9f4 100644 (file)
@@ -4,11 +4,10 @@ kernel math math.order namespaces system ui ui.gadgets.worlds ;
 IN: game.loop
 
 TUPLE: game-loop
-    { tick-interval-micros integer read-only }
+    { tick-interval-nanos integer read-only }
     tick-delegate
     draw-delegate
     { last-tick integer }
-    thread 
     { running? boolean }
     { tick-number integer }
     { frame-number integer }
@@ -22,11 +21,11 @@ GENERIC: draw* ( tick-slice delegate -- )
 
 SYMBOL: game-loop
 
-: since-last-tick ( loop -- microseconds )
-    last-tick>> system-micros swap - ;
+: since-last-tick ( loop -- nanos )
+    last-tick>> nano-count swap - ;
 
 : tick-slice ( loop -- slice )
-    [ since-last-tick ] [ tick-interval-micros>> ] bi /f 1.0 min ;
+    [ since-last-tick ] [ tick-interval-nanos>> ] bi /f 1.0 min ;
 
 CONSTANT: MAX-FRAMES-TO-SKIP 5
 
@@ -40,8 +39,8 @@ TUPLE: game-loop-error game-loop error ;
 : game-loop-error ( game-loop error -- )
     [ drop stop-loop ] [ \ game-loop-error boa ?ui-error ] 2bi ;
 
-: fps ( fps -- micros )
-    1,000,000 swap /i ; inline
+: fps ( fps -- nanos )
+    1,000,000,000 swap /i ; inline
 
 <PRIVATE
 
@@ -54,60 +53,60 @@ TUPLE: game-loop-error game-loop error ;
 
 : increment-tick ( loop -- )
     [ 1 + ] change-tick-number
-    dup tick-interval-micros>> [ + ] curry change-last-tick
+    dup tick-interval-nanos>> [ + ] curry change-last-tick
     drop ;
 
 : ?tick ( loop count -- )
-    [ system-micros >>last-tick drop ] [
-        over [ since-last-tick ] [ tick-interval-micros>> ] bi >=
+    [ nano-count >>last-tick drop ] [
+        over [ since-last-tick ] [ tick-interval-nanos>> ] bi >=
         [ [ drop increment-tick ] [ drop tick ] [ 1 - ?tick ] 2tri ]
         [ 2drop ] if
     ] if-zero ;
 
-: benchmark-micros ( loop -- micros )
-    system-micros swap benchmark-time>> - ;
+: benchmark-nanos ( loop -- nanos )
+    nano-count swap benchmark-time>> - ;
 
 PRIVATE>
 
-: reset-loop-benchmark ( loop -- )
-    system-micros >>benchmark-time
+: reset-loop-benchmark ( loop -- loop )
+    nano-count >>benchmark-time
     dup tick-number>> >>benchmark-tick-number
-    dup frame-number>> >>benchmark-frame-number
-    drop ;
+    dup frame-number>> >>benchmark-frame-number ;
 
 : benchmark-ticks-per-second ( loop -- n )
-    [ tick-number>> ] [ benchmark-tick-number>> - ] [ benchmark-micros ] tri /f ;
+    [ tick-number>> ] [ benchmark-tick-number>> - ] [ benchmark-nanos ] tri /f ;
 : benchmark-frames-per-second ( loop -- n )
-    [ frame-number>> ] [ benchmark-frame-number>> - ] [ benchmark-micros ] tri /f ;
+    [ frame-number>> ] [ benchmark-frame-number>> - ] [ benchmark-nanos ] tri /f ;
 
 : (game-tick) ( loop -- )
     dup running?>>
     [ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] bi ]
     [ drop ] if ;
     
-: game-tick ( alarm loop -- )
-    [ alarm<< ] keep
+: game-tick ( loop -- )
     dup game-loop [
         [ (game-tick) ] [ game-loop-error ] recover
     ] with-variable ;
 
 : start-loop ( loop -- )
-    system-micros >>last-tick
+    nano-count >>last-tick
     t >>running?
-    [ reset-loop-benchmark ]
-    [ [ '[ _ game-tick ] ] keep tick-interval-micros>> microseconds every* ]
-    [ thread<< ] tri ;
+    reset-loop-benchmark
+    [
+        [ '[ _ game-tick ] f ]
+        [ tick-interval-nanos>> nanoseconds ] bi
+        <alarm>
+    ] keep [ alarm<< ] [ drop start-alarm ] 2bi ;
 
 : stop-loop ( loop -- )
     f >>running?
-    f >>thread
-    drop ;
+    alarm>> stop-alarm ;
 
-: <game-loop*> ( tick-interval-micros tick-delegate draw-delegate -- loop )
-    system-micros f f 0 0 system-micros 0 0 f
+: <game-loop*> ( tick-interval-nanos tick-delegate draw-delegate -- loop )
+    nano-count f 0 0 nano-count 0 0 f
     game-loop boa ;
 
-: <game-loop> ( tick-interval-micros delegate -- loop )
+: <game-loop> ( tick-interval-nanos delegate -- loop )
     dup <game-loop*> ; inline
 
 M: game-loop dispose
index 8201137f2a0d4c71d1b46bfbeb0e38d428354ce5..6ac7978011f4129243fc9ff8644d7b07f16dc34e 100644 (file)
@@ -108,7 +108,7 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
 
 : kill-update-axes ( gadget -- )
     COLOR: gray <solid> >>interior
-    [ [ cancel-alarm ] when* f ] change-alarm
+    [ [ stop-alarm ] when* f ] change-alarm
     relayout-1 ;
 
 : (update-axes) ( gadget controller-state -- )
@@ -129,7 +129,7 @@ M: joystick-demo-gadget graft*
     drop ;
 
 M: joystick-demo-gadget ungraft*
-    alarm>> [ cancel-alarm ] when* ;
+    alarm>> [ stop-alarm ] when* ;
 
 : joystick-window ( controller -- )
     [ <joystick-demo-gadget> ] [ product-string ] bi
index b236442e9d26afb8a9e3321c612aa84171d8b8ec..8d0c8088043f6edc038fc9c9704f086488e20925 100644 (file)
@@ -167,7 +167,7 @@ M: key-caps-gadget graft*
     drop ;
 
 M: key-caps-gadget ungraft*
-    alarm>> [ cancel-alarm ] when*
+    alarm>> [ stop-alarm ] when*
     close-game-input ;
 
 M: key-caps-gadget handle-gesture
index dcae438679e80c4eacd9e2adbd7e17e0ab1a8899..5d97284551e01cc92dcf0891705718688d65d8a5 100644 (file)
@@ -48,4 +48,4 @@ PRIVATE>
     ] unless ;
 
 : stop-site-watcher ( -- )
-    running-site-watcher get [ cancel-alarm ] when* ;
+    running-site-watcher get [ stop-alarm ] when* ;
index e5d4f408ff388730ac5a88d6a0c8c9885a4994f2..839d9690c2d6dea2b17f583610438313d20e452c 100644 (file)
@@ -55,7 +55,7 @@ M: tetris-gadget graft* ( gadget -- )
     [ [ tick ] curry 100 milliseconds every ] keep alarm<< ;
 
 M: tetris-gadget ungraft* ( gadget -- )
-    [ cancel-alarm f ] change-alarm drop ;
+    [ stop-alarm f ] change-alarm drop ;
 
 : tetris-window ( -- ) 
     [