summaryrefslogtreecommitdiff
path: root/axis.hs
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2014-01-13 22:46:03 -0500
committerAndrew Cady <d@jerkface.net>2014-01-13 22:46:03 -0500
commit9c0f90e501f407d21d497829fa2fd727fe0c1039 (patch)
treedbd7c25474f521b155b2e3d4a16c99c784a65a2d /axis.hs
Initial commit.
Diffstat (limited to 'axis.hs')
-rw-r--r--axis.hs36
1 files changed, 36 insertions, 0 deletions
diff --git a/axis.hs b/axis.hs
new file mode 100644
index 0000000..b59a6f6
--- /dev/null
+++ b/axis.hs
@@ -0,0 +1,36 @@
1import FRP.Netwire hiding (when)
2import Prelude hiding ((.), id)
3import Data.Time.Clock
4import Control.Wire hiding (when)
5import Control.Wire.Session
6import Control.Monad
7import qualified Graphics.UI.SDL as SDL
8
9netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String
10netwireIsCool =
11 for 2.5 . pure "Once upon a time..." -->
12 for 3 . pure "... games were completely imperative..." -->
13 for 2 . pure "... but then..." -->
14 for 10 . (pure "Netwire 5! " <> anim) -->
15 netwireIsCool
16
17 where
18 anim =
19 holdFor 0.5 . periodic 1 . pure "Hoo..." <|>
20 pure "...ray!"
21
22--main :: IO ()
23--main = testWire clockSession_ netwireIsCool
24
25main = SDL.withInit [SDL.InitVideo, SDL.InitTimer, SDL.InitJoystick] $ do
26 loop clockSession_ netwireIsCool ""
27 where
28 loop s w x = do
29 (ds, s') <- stepSession s
30 (ex, w') <- stepWire w ds (Right x)
31 let x' = either (const "") id ex
32 Control.Monad.when (x /= x' && x /= "") $ putStrLn x
33 let framerate = 30
34 let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds)
35 SDL.delay (delay)
36 loop s' w' x'