blob: b59a6f6518c058d59e771aaf06284009382e1ba8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
import FRP.Netwire hiding (when)
import Prelude hiding ((.), id)
import Data.Time.Clock
import Control.Wire hiding (when)
import Control.Wire.Session
import Control.Monad
import qualified Graphics.UI.SDL as SDL
netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String
netwireIsCool =
for 2.5 . pure "Once upon a time..." -->
for 3 . pure "... games were completely imperative..." -->
for 2 . pure "... but then..." -->
for 10 . (pure "Netwire 5! " <> anim) -->
netwireIsCool
where
anim =
holdFor 0.5 . periodic 1 . pure "Hoo..." <|>
pure "...ray!"
--main :: IO ()
--main = testWire clockSession_ netwireIsCool
main = SDL.withInit [SDL.InitVideo, SDL.InitTimer, SDL.InitJoystick] $ do
loop clockSession_ netwireIsCool ""
where
loop s w x = do
(ds, s') <- stepSession s
(ex, w') <- stepWire w ds (Right x)
let x' = either (const "") id ex
Control.Monad.when (x /= x' && x /= "") $ putStrLn x
let framerate = 30
let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds)
SDL.delay (delay)
loop s' w' x'
|
