wiretest.hs

{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
module Main where

import Prelude hiding ((.), id)
import Control.Applicative
import Control.Arrow
import Control.Wire
import qualified Control.Monad as M (when)
import Control.Monad.Loops
import Control.Exception

import Graphics.UI.SDL as SDL

main = bracket_ (SDL.init [InitVideo]) SDL.quit $ do
    screen <- setVideoMode 800 600 0 [DoubleBuf, HWSurface]

    sess <- clockSession

    let loop s w = do
            ev <- unfoldWhileM (/= NoEvent) pollEvent
            (v, w', s') <- stepSessionM_ s ev w
            M.when v $ loop s' w'

    loop sess system

system = proc ev -> do
    quit <- pure False . quitEv <|> pure True -< ev
    returnA -< quit

quitEv = when (elem Quit)