bork

[clean-tests.git] / stimer / test.icl

diff --git a/stimer/test.icl b/stimer/test.icl
new file mode 100644 (file)
index 0000000..3bc5d32
--- /dev/null
+++ b/stimer/test.icl
@@ -0,0 +1,29 @@
+module test
+
+import StdFunc => qualified return
+import Data.Func
+import System.Time
+import iTasks
+import iTasks.Internal.IWorld
+
+Start w = flip startEngine w
+       $ foreverSt 0 \i->
+                   waitForSTimer 0.1
+               -|| viewInformation () [] (toString i +++ "th waitForSTimer")
+               >>| treturn (i+1)
+
+waitForSTimer :: Real -> Task ()
+waitForSTimer secondsToWait
+= get currentTimespec
+       >>= \ts->watch (sdsFocus {start=ts,interval=realToTs secondsToWait} iworldTimespec)
+       >>* [OnValue (ifValue (\t->t > ts+realToTs secondsToWait) \_->treturn ())]
+where
+       realToTs :: Real -> Timespec
+       realToTs t =
+               {tv_sec = floor t
+               ,tv_nsec = toInt $ (t - toReal (floor t)) * 1E9
+               }
+       floor :: Real -> Int
+       floor x 
+               | toReal (toInt x) == x = (toInt x)
+               | otherwise = toInt (x - 0.5)