diff options
Diffstat (limited to 'axis.hs')
-rw-r--r-- | axis.hs | 36 |
1 files changed, 36 insertions, 0 deletions
@@ -0,0 +1,36 @@ | |||
1 | import FRP.Netwire hiding (when) | ||
2 | import Prelude hiding ((.), id) | ||
3 | import Data.Time.Clock | ||
4 | import Control.Wire hiding (when) | ||
5 | import Control.Wire.Session | ||
6 | import Control.Monad | ||
7 | import qualified Graphics.UI.SDL as SDL | ||
8 | |||
9 | netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String | ||
10 | netwireIsCool = | ||
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 | |||
25 | main = 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' | ||