summaryrefslogtreecommitdiff
path: root/axis.hs
blob: 7513163429bac0f66746e474fa84c25788c67e32 (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
37
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
import AlsaSeq
import qualified Data.Set as Set

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 = SDL.withInit [SDL.InitVideo, SDL.InitTimer, SDL.InitJoystick] $
  withAlsaInit $ \h public private q publicAddr privateAddr -> do
  putStrLn "Initialized."
  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'