Further rework on the engine.

Moved away from forkIO'ing commands, instead there'll be an actor user function that is forkIO'd once. Additionally, start work on all of the new event sinking, esp. keyboard & mouse.
2024-09-11 04:15:32 +03:00 · 2016-09-04 01:20:18 +10:00 · 2016-09-04 01:20:18 +10:00 · 2e05198eda
commit 2e05198eda
parent 844f551e90
22 changed files with 826 additions and 379 deletions
--- a/.gitignore
+++ b/.gitignore
@ -5,3 +5,4 @@ dist
 *.hi
 cabal.sandbox.config
 .cabal-sandbox/
+.stack-work
--- a/examples/hello/Main.hs
+++ b/examples/hello/Main.hs
@ -1,31 +1,37 @@
+import Linear.V2 (V2(V2))
+
 import Helm
+import Helm.Color
+import Helm.Engine.SDL (SDLEngine)
 import Helm.Graphics2D
-import Helm.Render.Cairo (render)

 import qualified Helm.Cmd as Cmd
+import qualified Helm.Mouse as Mouse
 import qualified Helm.Sub as Sub
+import qualified Helm.Engine.SDL as SDL

-data Action = Idle | ChangeDirection (Double, Double)
+data Action = Idle | ChangePosition (Double, Double)
 data Model = Model (Double, Double)

-initial :: (Model, Cmd Action)
+initial :: (Model, Cmd SDLEngine Action)
 initial = (Model (0, 0), Cmd.none)

-update :: Model -> Action -> (Model, Cmd Action)
-update model _ = (model, Cmd.none)
+update :: Model -> Action -> (Model, Cmd SDLEngine Action)
+update model Idle = (model, Cmd.none)
+update model (ChangePosition pos) = (Model pos, Cmd.none)

-subscriptions :: Sub Action
-subscriptions = Sub.none
+subscriptions :: Sub SDLEngine Action
+subscriptions = Mouse.moves (\(V2 x y) -> ChangePosition (fromIntegral x, fromIntegral y))

-view :: Model -> Render ()
-view model = render $ collage 800 600 []
+view :: Model -> Graphics
+view (Model pos) = Graphics2D $ collage 800 600 [move pos $ filled (rgb 1 0 0) $ rect 10 10]

 main = do
-  engine <- startup
+  engine <- SDL.startup

-  run engine $ GameConfig {
-    initialFn       = initial,
-    updateFn        = update,
-    subscriptionsFn = subscriptions,
-    viewFn          = view
-  }
+  run engine GameConfig
+    { initialFn       = initial
+    , updateFn        = update
+    , subscriptionsFn = subscriptions
+    , viewFn          = view
+    }
--- a/helm.cabal
+++ b/helm.cabal
@ -7,7 +7,7 @@ homepage: http://github.com/switchface/helm
 bug-reports: http://github.com/switchface/helm/issues
 license: MIT
 license-file: LICENSE
-tested-with: GHC == 7.10.3
+tested-with: GHC == 8.0.1
 extra-source-files: LICENSE, README.md
 author: Zack Corr
 maintainer: Zack Corr <zack@z0w0.me>
@ -24,21 +24,24 @@ library
  hs-source-dirs: src
  default-language: Haskell2010
  default-extensions: RecordWildCards, NamedFieldPuns
-  ghc-options: -Wall -fno-warn-unused-do-bind
+  ghc-options: -Wall

  exposed-modules:
    Helm
+    Helm.Asset
    Helm.Cmd
    Helm.Color
    Helm.Engine
-    Helm.Game
+    Helm.Engine.SDL
+    Helm.Engine.SDL.Graphics2D
+    Helm.Engine.SDL.Keyboard
+    Helm.Engine.SDL.Mouse
+    Helm.Graphics
    Helm.Graphics2D
    Helm.Graphics2D.Text
    Helm.Graphics2D.Transform
    Helm.Keyboard
    Helm.Mouse
-    Helm.Render
-    Helm.Render.Cairo
    Helm.Sub
    Helm.Time
    Helm.Window
@ -48,7 +51,7 @@ library
    cairo >= 0.13 && < 0.14,
    pango >= 0.13 && < 0.14,
    containers >= 0.5 && < 1,
-    elerea >= 2.7 && < 3,
+    elerea >= 2.8 && < 3,
    sdl2 >= 2 && < 3,
    linear >= 1 && < 2,
    text >= 1.1.1.3 && < 2,
@ -60,12 +63,14 @@ library
    build-depends: ghc-prim

 executable helm-example-hello
+  default-language: Haskell2010
  main-is: Main.hs
  hs-source-dirs: examples/hello

  build-depends:
    base >= 4 && < 5,
-    helm >= 1 && < 2
+    helm >= 1 && < 2,
+    linear >= 1 && < 2

 test-suite helm-tests
  type: exitcode-stdio-1.0
@ -78,7 +83,7 @@ test-suite helm-tests
  build-depends:
    base >= 4 && < 5,
    containers >= 0.5 && < 1,
-    elerea >= 2.7 && < 3,
+    elerea >= 2.8 && < 3,
    sdl2 >= 2 && < 3,
    HUnit >= 1.2 && < 2,
    test-framework >= 0.8 && < 1,
--- a/src/Helm.hs
+++ b/src/Helm.hs
@ -1,129 +1,17 @@
 {-| Contains the main functions for interfacing with the engine. -}
-module Helm (
-  -- * Types
-  Render(..),
-  Engine,
-  EngineConfig(..),
-  Game,
-  GameConfig(..),
-  Cmd(..),
-  Sub(..),
-  -- * Engine
-  startup,
-  startupWith,
-  run
-) where
-
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Exception (finally)
-import Control.Monad (foldM, forM_, void)
-import Control.Monad.Trans.State (evalStateT)
-import FRP.Elerea.Param
-import Linear.V2 (V2(V2))
-
-import SDL.Event
-import SDL.Video (WindowConfig(..))
-import qualified SDL.Init as Init
-import qualified SDL.Video as Video
-import qualified Data.Text as T
-
-import Helm.Cmd (Cmd(..))
-import Helm.Engine
-import Helm.Game
-import Helm.Render (Render(..))
-import Helm.Sub (Sub(..))
-
-{-| Initialises a new engine with default configuration.
-    The engine can then be run later using 'run'. -}
-startup :: IO Engine
-startup = startupWith defaultConfig
-
-{-| Initializes a new engine with some configration. -}
-startupWith :: EngineConfig -> IO Engine
-startupWith config@(EngineConfig { .. }) = do
-  Init.initializeAll
-
-  window <- Video.createWindow (T.pack windowTitle) windowConfig
-  renderer <- Video.createRenderer window (-1) rendererConfig
-
-  Video.showWindow window
-
-  return Engine {
-    window         = window,
-    renderer       = renderer,
-    engineConfig   = config
-  }
-
+module Helm
+  (
+   -- * Types
+   Engine
+  ,GameConfig(..)
+  ,Cmd(..)
+  ,Sub(..)
+  ,Graphics(..)
+   -- * Engine
+  ,run
+  ,loadImage
+  ,loadSound)
  where
-    (w, h) = windowDimensions
-    rendererConfig = Video.RendererConfig Video.AcceleratedVSyncRenderer False
-    windowConfig = Video.defaultWindow {
-      windowInitialSize = V2 (fromIntegral w) (fromIntegral h),
-      windowMode = if windowIsFullscreen then Video.Fullscreen else Video.Windowed,
-      windowResizable = windowIsResizable
-    }

-prepare :: GameConfig m a -> IO (Game m a)
-prepare config = do
-  smp <- start $ signalGen $ subscriptionsFn config
-  queue <- newTQueueIO
-
-  return Game {
-    gameConfig  = config,
-    gameModel   = fst $ initialFn config,
-    actionSmp   = smp,
-    actionQueue = queue
-  }
-
-  where
-    signalGen (Sub gen) = gen
-
-dequeueCmds :: Game m a -> IO [a]
-dequeueCmds game = atomically dequeue
-  where
-    dequeue = do
-      x <- tryReadTQueue (actionQueue game)
-
-      case x of
-        Nothing -> return []
-        Just action -> do
-          xs <- dequeue
-
-          return $ action : xs
-
-queueCmd :: Engine -> Game m a -> Cmd a -> IO ()
-queueCmd engine game (Cmd monad) = void $ forkIO $ do
-  actions <- evalStateT monad engine
-
-  atomically $ forM_ actions (writeTQueue $ actionQueue game)
-
-run :: Engine -> GameConfig m a -> IO ()
-run engine config = do
-  game <- prepare config
-
-  queueCmd engine game $ snd $ initialFn config
-  tick engine game `finally` Init.quit
-
-tick :: Engine -> Game m a -> IO ()
-tick engine game = do
-  actions <- (++) <$> actionSmp game engine <*> dequeueCmds game
-  stepped <- foldM (step engine game) (gameModel game) actions
-
-  render engine game stepped
-  tick engine $ game { gameModel = stepped }
-
-step :: Engine -> Game m a -> m -> a -> IO m
-step engine game model action = do
-  queueCmd engine game $ snd result
-
-  return $ fst result
-
-  where
-    result = (updateFn $ gameConfig game) model action
-
-render :: Engine -> Game m a -> m -> IO ()
-render engine game model = evalStateT monad engine >> return ()
-  where
-    Game { gameConfig = GameConfig { viewFn } } = game
-    Render monad = viewFn model
+import Helm.Engine (Cmd(..), Sub(..), GameConfig(..), Engine(run, loadImage, loadSound))
+import Helm.Graphics
--- a/src/Helm/.#Engine.hs
+++ b/src/Helm/.#Engine.hs
@ -0,0 +1 @@
+zack@zarch.9208:1472817273
--- a/src/Helm/Asset.hs
+++ b/src/Helm/Asset.hs
@ -0,0 +1,9 @@
+{-| Contains the types for loading game assets, e.g. images, audio, etc. -}
+module Helm.Asset (
+  -- * Types
+  Image(..),
+  Sound(..)
+) where
+
+newtype Image = Image ()
+newtype Sound = Sound ()
--- a/src/Helm/Cmd.hs
+++ b/src/Helm/Cmd.hs
@ -1,4 +1,4 @@
-{-| Contains the command type and related utilities. -}
+{-| Contains the command related utilities. -}
 module Helm.Cmd (
  -- * Types
  Cmd(..),
@ -9,22 +9,19 @@ module Helm.Cmd (
 ) where

 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.State (StateT)

-import Helm.Engine (Engine)
+import Helm.Engine (Engine, Cmd(..))

-data Cmd a = Cmd (StateT Engine IO [a])
-
-batch :: [Cmd a] -> Cmd a
+batch :: Engine e => [Cmd e a] -> Cmd e a
 batch cmds = Cmd $ do
-  lists <- sequence $ map (\(Cmd monad) -> monad) cmds
+  lists <- mapM (\(Cmd m) -> m) cmds

  return $ concat lists

-none :: Cmd a
+none :: Engine e => Cmd e a
 none = Cmd $ return []

-execute :: IO a -> (a -> b) -> Cmd b
+execute :: Engine e => IO a -> (a -> b) -> Cmd e b
 execute monad f = Cmd $ do
  result <- f <$> lift monad

--- a/src/Helm/Engine.hs
+++ b/src/Helm/Engine.hs
@ -1,36 +1,296 @@
+{-| Contains the core engine types and typeclasses. -}
 module Helm.Engine (
-  -- * Types
-  EngineConfig(..),
+  -- * Typeclasses
  Engine(..),
-  -- * Setup
-  defaultConfig
+  -- * Types
+  Cmd(..),
+  GameConfig(..),
+  Sub(..),
+  MouseButton(..),
+  Key(..)
 ) where

-import qualified SDL.Video as Video
+import Control.Monad.Trans.State (StateT)
+import FRP.Elerea.Param (SignalGen, Signal)
+import Linear.V2 (V2)

-{-| A data structure describing how to run the engine. -}
-data EngineConfig = EngineConfig {
-  windowDimensions   :: (Int, Int),
-  windowIsFullscreen :: Bool,
-  windowIsResizable  :: Bool,
-  windowTitle        :: String,
-  windowQuitOnClose  :: Bool
+import Helm.Asset
+import Helm.Graphics (Graphics)
+
+class Engine e where
+  loadImage  :: e -> IO Image
+  loadSound  :: e -> IO Sound
+  run        :: e -> GameConfig e m a -> IO ()
+
+  windowSize :: e -> IO (V2 Int)
+
+  mouseMoveSignal :: e -> SignalGen e (Signal [V2 Int])
+  mouseDownSignal :: e -> SignalGen e (Signal [(MouseButton, V2 Int)])
+  mouseUpSignal :: e -> SignalGen e (Signal [(MouseButton, V2 Int)])
+  mouseClickSignal :: e -> SignalGen e (Signal [(MouseButton, V2 Int)])
+  keyboardDownSignal :: e -> SignalGen e (Signal [Key])
+  keyboardUpSignal :: e -> SignalGen e (Signal [Key])
+  keyboardPressSignal :: e -> SignalGen e (Signal [Key])
+  windowResizeSignal :: e -> SignalGen e (Signal [V2 Int])
+
+data Cmd e a = Cmd (StateT e IO [a])
+
+data Sub e a = Sub (SignalGen e (Signal [a]))
+
+{-| A data structure describing how to run a game. -}
+data GameConfig e m a = GameConfig {
+  initialFn          :: (m, Cmd e a),
+  updateFn           :: m -> a -> (m, Cmd e a),
+  subscriptionsFn    :: Sub e a,
+  viewFn             :: m -> Graphics
 }

-{-| A data structure describing the game engine's state. -}
-data Engine = Engine {
-  window         :: Video.Window,
-  renderer       :: Video.Renderer,
-  engineConfig   :: EngineConfig
-}
+-- Mostly matches the SDL structure, except we don't care about extra buttons (for now).
+data MouseButton
+  = LeftButton
+  | MiddleButton
+  | RightButton
+  | X1Button
+  | X2Button
+  | UnknownButton
+  deriving (Eq, Ord, Read, Show)

-{-| Creates the default configuration for the engine. You should change the
-    values where necessary. -}
-defaultConfig :: EngineConfig
-defaultConfig = EngineConfig {
-  windowDimensions = (800, 600),
-  windowIsFullscreen = False,
-  windowIsResizable = True,
-  windowTitle = "",
-  windowQuitOnClose = True
-}
+-- Matches the SDL structure, but with clearer constructor names.
+data Key
+  = ReturnKey
+  | EscapeKey
+  | BackspaceKey
+  | TabKey
+  | SpaceKey
+  | ExclaimKey
+  | QuoteDblKey
+  | HashKey
+  | PercentKey
+  | DollarKey
+  | AmpersandKey
+  | QuoteKey
+  | LeftParenKey
+  | RightParenKey
+  | AsteriskKey
+  | PlusKey
+  | CommaKey
+  | MinusKey
+  | PeriodKey
+  | SlashKey
+  | Number0Key
+  | Number1Key
+  | Number2Key
+  | Number3Key
+  | Number4Key
+  | Number5Key
+  | Number6Key
+  | Number7Key
+  | Number8Key
+  | Number9Key
+  | ColonKey
+  | SemicolonKey
+  | LessKey
+  | EqualsKey
+  | GreaterKey
+  | QuestionKey
+  | AtKey
+  | LeftBracketKey
+  | BackslashKey
+  | RightBracketKey
+  | CaretKey
+  | UnderscoreKey
+  | BackquoteKey
+  | AKey
+  | BKey
+  | CKey
+  | DKey
+  | EKey
+  | FKey
+  | GKey
+  | HKey
+  | IKey
+  | JKey
+  | KKey
+  | LKey
+  | MKey
+  | NKey
+  | OKey
+  | PKey
+  | QKey
+  | RKey
+  | SKey
+  | TKey
+  | UKey
+  | VKey
+  | WKey
+  | XKey
+  | YKey
+  | ZKey
+  | CapsLockKey
+  | F1Key
+  | F2Key
+  | F3Key
+  | F4Key
+  | F5Key
+  | F6Key
+  | F7Key
+  | F8Key
+  | F9Key
+  | F10Key
+  | F11Key
+  | F12Key
+  | PrintScreenKey
+  | ScrollLockKey
+  | PauseKey
+  | InsertKey
+  | HomeKey
+  | PageUpKey
+  | DeleteKey
+  | EndKey
+  | PageDownKey
+  | RightKey
+  | LeftKey
+  | DownKey
+  | UpKey
+  | NumLockClearKey
+  | KeypadDivideKey
+  | KeypadMultiplyKey
+  | KeypadMinusKey
+  | KeypadPlusKey
+  | KeypadEnterKey
+  | Keypad1Key
+  | Keypad2Key
+  | Keypad3Key
+  | Keypad4Key
+  | Keypad5Key
+  | Keypad6Key
+  | Keypad7Key
+  | Keypad8Key
+  | Keypad9Key
+  | Keypad0Key
+  | KeypadPeriodKey
+  | ApplicationKey
+  | PowerKey
+  | KeypadEqualsKey
+  | F13Key
+  | F14Key
+  | F15Key
+  | F16Key
+  | F17Key
+  | F18Key
+  | F19Key
+  | F20Key
+  | F21Key
+  | F22Key
+  | F23Key
+  | F24Key
+  | ExecuteKey
+  | HelpKey
+  | MenuKey
+  | SelectKey
+  | StopKey
+  | AgainKey
+  | UndoKey
+  | CutKey
+  | CopyKey
+  | PasteKey
+  | FindKey
+  | MuteKey
+  | VolumeUpKey
+  | VolumeDownKey
+  | KeypadCommaKey
+  | KeypadEqualsAS400Key
+  | AltEraseKey
+  | SysReqKey
+  | CancelKey
+  | ClearKey
+  | PriorKey
+  | Return2Key
+  | SeparatorKey
+  | OutKey
+  | OperKey
+  | ClearAgainKey
+  | CrSelKey
+  | ExSelKey
+  | Keypad00Key
+  | Keypad000Key
+  | ThousandsSeparatorKey
+  | DecimalSeparatorKey
+  | CurrencyUnitKey
+  | CurrencySubunitKey
+  | KeypadLeftParenKey
+  | KeypadRightParenKey
+  | KeypadLeftBraceKey
+  | KeypadRightBraceKey
+  | KeypadTabKey
+  | KeypadBackspaceKey
+  | KeypadAKey
+  | KeypadBKey
+  | KeypadCKey
+  | KeypadDKey
+  | KeypadEKey
+  | KeypadFKey
+  | KeypadXorKey
+  | KeypadPowerKey
+  | KeypadPercentKey
+  | KeypadLessKey
+  | KeypadGreaterKey
+  | KeypadAmpersandKey
+  | KeypadDblAmpersandKey
+  | KeypadVerticalBarKey
+  | KeypadDblVerticalBarKey
+  | KeypadColonKey
+  | KeypadHashKey
+  | KeypadSpaceKey
+  | KeypadAtKey
+  | KeypadExclamKey
+  | KeypadMemStoreKey
+  | KeypadMemRecallKey
+  | KeypadMemClearKey
+  | KeypadMemAddKey
+  | KeypadMemSubtractKey
+  | KeypadMemMultiplyKey
+  | KeypadMemDivideKey
+  | KeypadPlusMinusKey
+  | KeypadClearKey
+  | KeypadClearEntryKey
+  | KeypadBinaryKey
+  | KeypadOctalKey
+  | KeypadDecimalKey
+  | KeypadHexadecimalKey
+  | LeftCtrlKey
+  | LeftShiftKey
+  | LeftAltKey
+  | LeftGUIKey
+  | RightCtrlKey
+  | RightShiftKey
+  | RightAltKey
+  | RightGUIKey
+  | ModeKey
+  | AudioNextKey
+  | AudioPrevKey
+  | AudioStopKey
+  | AudioPlayKey
+  | AudioMuteKey
+  | MediaSelectKey
+  | WWWKey
+  | MailKey
+  | CalculatorKey
+  | ComputerKey
+  | ACSearchKey
+  | ACHomeKey
+  | ACBackKey
+  | ACForwardKey
+  | ACStopKey
+  | ACRefreshKey
+  | ACBookmarksKey
+  | BrightnessDownKey
+  | BrightnessUpKey
+  | DisplaySwitchKey
+  | KeyboardIllumToggleKey
+  | KeyboardIllumDownKey
+  | KeyboardIllumUpKey
+  | EjectKey
+  | SleepKey
+  | UnknownKey
+  deriving (Eq, Ord, Read, Show)
--- a/src/Helm/Engine/SDL.hs
+++ b/src/Helm/Engine/SDL.hs
@ -0,0 +1,296 @@
+{-| Contains the SDL implementation of Helm. -}
+module Helm.Engine.SDL
+  (
+   -- * Types
+   SDLEngine
+  ,SDLEngineConfig(..)
+  ,
+   -- * Utilities
+   defaultConfig
+  ,startup
+  ,startupWith)
+  where
+
+import           Control.Exception (finally)
+import           Control.Monad (foldM, void)
+import           Control.Monad.Trans.State.Lazy (evalStateT)
+import           Data.Int (Int32)
+import qualified Data.Text as T
+import           Data.Word (Word32)
+import           Debug.Trace (traceShow)
+
+import           FRP.Elerea.Param
+import           Linear.Affine (Point(P))
+import           Linear.V2 (V2(V2))
+import           SDL.Video (WindowConfig(..))
+import qualified SDL
+import qualified SDL.Event as Event
+import qualified SDL.Init as Init
+import qualified SDL.Time as Time
+import qualified SDL.Video as Video
+import qualified SDL.Video.Renderer as Renderer
+
+import           Helm.Asset
+import           Helm.Engine (GameConfig(..), Cmd(..), Sub(..),
+                              Engine(..), Key, MouseButton)
+import           Helm.Graphics (Graphics(..))
+import           Helm.Graphics2D (Element)
+import           Helm.Engine.SDL.Keyboard (mapKey)
+import           Helm.Engine.SDL.Mouse (mapMouseButton)
+import qualified Helm.Engine.SDL.Graphics2D as Graphics2D
+
+{-| A data structure describing how to run the engine. -}
+data SDLEngineConfig = SDLEngineConfig
+  { windowDimensions :: (Int, Int)
+  , windowIsFullscreen :: Bool
+  , windowIsResizable :: Bool
+  , windowTitle :: String
+  }
+
+{-| A data structure describing the game engine's state. -}
+data SDLEngine = SDLEngine
+  { window :: Video.Window
+  , renderer :: Video.Renderer
+  , engineConfig :: SDLEngineConfig
+  , lastMousePress :: Maybe (Word32, V2 Int32)
+
+  , mouseMoveEventSignal :: SignalGen SDLEngine (Signal [V2 Int])
+  , mouseMoveEventSink :: V2 Int -> IO ()
+  , mouseDownEventSignal :: SignalGen SDLEngine (Signal [(MouseButton, V2 Int)])
+  , mouseDownEventSink :: (MouseButton, V2 Int) -> IO ()
+  , mouseUpEventSignal :: SignalGen SDLEngine (Signal [(MouseButton, V2 Int)])
+  , mouseUpEventSink :: (MouseButton, V2 Int) -> IO ()
+  , mouseClickEventSignal :: SignalGen SDLEngine (Signal [(MouseButton, V2 Int)])
+  , mouseClickEventSink :: (MouseButton, V2 Int) -> IO ()
+
+  , keyboardDownEventSignal :: SignalGen SDLEngine (Signal [Key])
+  , keyboardDownEventSink :: Key -> IO ()
+  , keyboardUpEventSignal :: SignalGen SDLEngine (Signal [Key])
+  , keyboardUpEventSink :: Key -> IO ()
+  , keyboardPressEventSignal :: SignalGen SDLEngine (Signal [Key])
+  , keyboardPressEventSink :: Key -> IO ()
+
+  , windowResizeEventSignal :: SignalGen SDLEngine (Signal [V2 Int])
+  , windowResizeEventSink :: V2 Int -> IO ()
+  }
+
+{-| A data structure describing a game's state (that is running under an engine). -}
+data SDLGame m a = SDLGame
+  { gameConfig :: GameConfig SDLEngine m a
+  , gameModel :: m
+  , running :: Bool
+  , actionSmp :: SDLEngine -> IO [a]
+  }
+
+instance Engine SDLEngine where
+  loadImage _ = return $ Image ()
+  loadSound _ = return $ Sound ()
+
+  mouseMoveSignal = mouseMoveEventSignal
+  mouseDownSignal = mouseDownEventSignal
+  mouseUpSignal = mouseUpEventSignal
+  mouseClickSignal = mouseClickEventSignal
+
+  keyboardDownSignal = keyboardDownEventSignal
+  keyboardUpSignal = keyboardUpEventSignal
+  keyboardPressSignal = keyboardPressEventSignal
+
+  windowResizeSignal = windowResizeEventSignal
+
+  windowSize SDLEngine { window } =
+    fmap (fmap fromIntegral) . SDL.get $ Video.windowSize window
+
+  run engine config =
+    void $ (prepare engine config >>= step engine) `finally` Init.quit
+
+{-| Creates the default configuration for the engine. You should change the
+    values where necessary. -}
+defaultConfig :: SDLEngineConfig
+defaultConfig = SDLEngineConfig
+  { windowDimensions = (800, 600)
+  , windowIsFullscreen = False
+  , windowIsResizable = True
+  , windowTitle = "Helm"
+  }
+
+{-| Initialises a new engine with default configuration.
+    The engine can then be run later using 'run'. -}
+startup :: IO SDLEngine
+startup = startupWith defaultConfig
+
+{-| Initializes a new engine with some configration. -}
+startupWith :: SDLEngineConfig -> IO SDLEngine
+startupWith config@SDLEngineConfig{..} = do
+  Init.initializeAll
+
+  window <- Video.createWindow (T.pack windowTitle) windowConfig
+  renderer <- Video.createRenderer window (-1) rendererConfig
+
+  mouseMoveEvent <- externalMulti
+  mouseDownEvent <- externalMulti
+  mouseUpEvent <- externalMulti
+  mouseClickEvent <- externalMulti
+  keyboardDownEvent <- externalMulti
+  keyboardUpEvent <- externalMulti
+  keyboardPressEvent <- externalMulti
+  windowResizeEvent <- externalMulti
+
+  Video.showWindow window
+
+  return SDLEngine
+    { window = window
+    , renderer = renderer
+    , engineConfig = config
+    , lastMousePress = Nothing
+
+    , mouseMoveEventSignal = fst mouseMoveEvent
+    , mouseMoveEventSink = snd mouseMoveEvent
+    , mouseDownEventSignal = fst mouseDownEvent
+    , mouseDownEventSink = snd mouseDownEvent
+    , mouseUpEventSignal = fst mouseUpEvent
+    , mouseUpEventSink = snd mouseUpEvent
+    , mouseClickEventSignal = fst mouseClickEvent
+    , mouseClickEventSink = snd mouseClickEvent
+
+    , keyboardDownEventSignal = fst keyboardDownEvent
+    , keyboardDownEventSink = snd keyboardDownEvent
+    , keyboardUpEventSignal = fst keyboardUpEvent
+    , keyboardUpEventSink = snd keyboardUpEvent
+    , keyboardPressEventSignal = fst keyboardPressEvent
+    , keyboardPressEventSink = snd keyboardPressEvent
+
+    , windowResizeEventSignal = fst windowResizeEvent
+    , windowResizeEventSink = snd windowResizeEvent
+    }
+  where
+    (w,h) = windowDimensions
+    rendererConfig = Video.RendererConfig Video.AcceleratedVSyncRenderer False
+    windowConfig = Video.defaultWindow
+      { windowInitialSize = V2 (fromIntegral w) (fromIntegral h)
+      , windowMode = if windowIsFullscreen
+                     then Video.Fullscreen
+                     else Video.Windowed
+      , windowResizable = windowIsResizable
+      }
+
+step :: SDLEngine -> SDLGame m a -> IO (SDLGame m a)
+step engine game@SDLGame{actionSmp,gameModel,gameConfig = GameConfig{viewFn}} = do
+  sunkGame <- sinkEvents engine game
+
+  if running sunkGame
+  then do
+    actions <- actionSmp engine
+    model <- foldM (stepModel engine game) gameModel actions
+
+    render engine $ viewFn model
+    step engine $ sunkGame { gameModel = model }
+  else return sunkGame
+
+stepModel :: SDLEngine -> SDLGame m a -> m -> a -> IO m
+stepModel engine game@SDLGame { gameConfig = GameConfig { updateFn } } model action =
+  evalStateT monad engine >>= foldM (stepModel engine game) model
+
+  where
+    (model, Cmd monad) = updateFn model action
+
+prepare :: SDLEngine -> GameConfig SDLEngine m a -> IO (SDLGame m a)
+prepare engine config@GameConfig { initialFn, subscriptionsFn = Sub gen } = do
+  {- The call to 'embed' here is a little bit hacky, but seems necessary
+     to get this working. This is because 'start' actually computes the signal
+     gen passed to it, and all of our signal gens try to fetch
+     the 'input' value within the top layer signal gen (rather than in the
+     contained signal). But we haven't sampled with the input value yet, so it'll
+     be undefined unless we 'embed'. -}
+  smp <- start $ embed (return engine) gen
+
+  return SDLGame
+    { gameConfig = config
+    , gameModel = fst initialFn
+    , running = True
+    , actionSmp = smp
+    }
+
+render :: SDLEngine -> Graphics -> IO ()
+render engine (Graphics2D element) = render2d engine element
+
+render2d :: SDLEngine -> Element -> IO ()
+render2d SDLEngine{window,renderer} element = do
+  dims <- SDL.get $ Video.windowSize window
+  texture <- Renderer.createTexture renderer mode access dims
+
+  Graphics2D.render texture dims element
+  Renderer.clear renderer
+  Renderer.copy renderer texture Nothing Nothing
+  Renderer.destroyTexture texture
+  Renderer.present renderer
+
+  where
+    mode = Renderer.ARGB8888
+    access = Renderer.TextureAccessStreaming
+
+sinkEvents :: SDLEngine -> SDLGame m a -> IO (SDLGame m a)
+sinkEvents engine game = do
+  mayhaps <- Event.pumpEvents >> Event.pollEvent
+
+  case mayhaps of
+      -- Handle the quit event exclusively first to simplify our code
+      Just Event.Event { eventPayload = Event.QuitEvent } ->
+        return game { running = False }
+
+      Just Event.Event { .. } ->
+        sinkEvent engine eventPayload >> sinkEvents engine game
+
+      Nothing -> return game
+
+depoint :: Point f a -> (f a)
+depoint (P x) = x
+
+sinkEvent :: SDLEngine -> Event.EventPayload -> IO SDLEngine
+sinkEvent engine (Event.WindowResizedEvent Event.WindowResizedEventData { .. }) = do
+  windowResizeEventSink engine $ fromIntegral <$> windowResizedEventSize
+
+  return engine
+
+sinkEvent engine (Event.MouseMotionEvent Event.MouseMotionEventData { .. }) = do
+  mouseMoveEventSink engine $ fromIntegral <$> depoint mouseMotionEventPos
+
+  return engine
+
+sinkEvent engine (Event.MouseButtonEvent Event.MouseButtonEventData { .. }) = do
+  case mouseButtonEventMotion of
+    Event.Pressed -> do
+      ticks <- Time.ticks
+      mouseDownEventSink engine tup
+
+      return engine { lastMousePress = Just (ticks, pos) }
+
+    Event.Released -> do
+      mouseUpEventSink engine tup
+
+      {- Weirdly enough, SDL provides a value that says how many clicks there
+         were, but this value is always set to one even if it's just a regular
+         mouse up event. Note that here we're defining a click as a mouse up
+         event being in a very close proximity to a previous mouse down event.
+         We manually calculate whether this was a click or not. -}
+      case lastMousePress of
+        Just (lastTicks, (V2 lastX lastY)) -> do
+          ticks <- Time.ticks
+
+          traceShow (ticks - lastTicks) (return ())
+
+          if ticks - lastTicks < clickMs && (abs (lastX - x) <= clickRadius && abs (lastY - y) <= clickRadius)
+          then traceShow "clickeroo" (mouseClickEventSink engine tup)
+          else return ()
+
+        Nothing -> return ()
+
+      return engine
+
+  where
+    SDLEngine { lastMousePress } = engine
+    clickMs = 500  -- How long between mouse down/up to recognise clicks
+    clickRadius = 1  -- The pixel radius to be considered a click.
+    pos@(V2 x y) = depoint mouseButtonEventPos
+    tup = (mapMouseButton mouseButtonEventButton, fromIntegral <$> pos)
+
+sinkEvent engine _ = return engine
--- a/src/Helm/Engine/SDL/Graphics2D.hs
+++ b/src/Helm/Engine/SDL/Graphics2D.hs
@ -1,53 +1,35 @@
-module Helm.Render.Cairo (
-  -- * Rendering
-  render
-) where
-
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.State (get)
+{-| Contains the SDL implementation 2D graphics rendering implementation (uses Cairo). -}
+module Helm.Engine.SDL.Graphics2D (render) where

 import Data.Foldable (forM_)
-import qualified Data.Text as T
-import Linear.V2 (V2(V2))
-import Linear.V3 (V3(V3))
+import Foreign.C.Types (CInt)
 import Foreign.Ptr (castPtr)

-import Helm.Engine (Engine(..))
-import Helm.Render (Render(..))
+import Graphics.Rendering.Cairo.Matrix (Matrix(..))
+import Linear.V2 (V2(V2))
+import Linear.V3 (V3(V3))
+
 import Helm.Color (Color(..), Gradient(..))
 import Helm.Graphics2D

-import Graphics.Rendering.Cairo.Matrix (Matrix(..))
+import qualified Data.Text as T
 import qualified Graphics.Rendering.Cairo as Cairo
 import qualified Graphics.Rendering.Pango as Pango
-
-import qualified SDL
-import qualified SDL.Video as Video
 import qualified SDL.Video.Renderer as Renderer

-render :: Element -> Render ()
-render element = Render $ do
-  Engine { window, renderer } <- get
+render :: Renderer.Texture -> V2 CInt -> Element -> IO ()
+render texture (V2 w h) element = do
+  (pixels, pitch) <- Renderer.lockTexture texture Nothing

-  lift $ do
-    dims@(V2 w h) <- SDL.get $ Video.windowSize window
+  Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatARGB32 (fromIntegral w) (fromIntegral h) (fromIntegral pitch) $ \surface ->
+    Cairo.renderWith surface $ do
+      Cairo.setSourceRGB 0 0 0
+      Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)
+      Cairo.fill

-    texture <- Renderer.createTexture renderer Renderer.ARGB8888 Renderer.TextureAccessStreaming dims
-    (pixels, pitch) <- Renderer.lockTexture texture Nothing
+      renderElement element

-    Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatARGB32 (fromIntegral w) (fromIntegral h) (fromIntegral pitch) $ \surface ->
-      Cairo.renderWith surface $ do
-        Cairo.setSourceRGB 0 0 0
-        Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)
-        Cairo.fill
-
-        renderElement element
-
-    Renderer.unlockTexture texture
-    Renderer.clear renderer
-    Renderer.copy renderer texture Nothing Nothing
-    Renderer.destroyTexture texture
-    Renderer.present renderer
+  Renderer.unlockTexture texture

 renderElement :: Element -> Cairo.Render ()
 renderElement (CollageElement w h center forms) = do
@ -60,10 +42,9 @@ renderElement (CollageElement w h center forms) = do

  Cairo.restore

-renderElement (ImageElement (sx, sy) sw sh src stretch) = do
-  return ()
+renderElement (ImageElement (sx, sy) sw sh src stretch) = return ()

-renderElement (TextElement (Text { textColor = (Color r g b a), .. })) = do
+renderElement (TextElement Text { textColor = (Color r g b a), .. }) = do
    Cairo.save

    layout <- Pango.createLayout textUTF8
@ -75,7 +56,7 @@ renderElement (TextElement (Text { textColor = (Color r g b a), .. })) = do
      , Pango.AttrSize   { paStart = i, paEnd = j, paSize = textHeight }
      ]

-    Pango.PangoRectangle x y w h <- fmap snd $ Cairo.liftIO $ Pango.layoutGetExtents layout
+    Pango.PangoRectangle x y w h <- fmap snd . Cairo.liftIO $ Pango.layoutGetExtents layout

    Cairo.translate ((-w / 2) -x) ((-h / 2) - y)
    Cairo.setSourceRGBA r g b a
@ -129,7 +110,7 @@ setLineJoin join = case join of
    to render with a line style and then strokes afterwards. Assumes
    that all drawing paths have already been setup before being called. -}
 setLineStyle :: LineStyle -> Cairo.Render ()
-setLineStyle (LineStyle { lineColor = Color r g b a, .. }) = do
+setLineStyle LineStyle { lineColor = Color r g b a, .. } = do
  Cairo.setSourceRGBA r g b a
  setLineCap lineCap
  setLineJoin lineJoin
@ -145,22 +126,21 @@ setFillStyle (Solid (Color r g b a)) = do
  Cairo.setSourceRGBA r g b a
  Cairo.fill

-setFillStyle (Texture src) = do
-  return ()
+setFillStyle (Texture src) = return ()

 setFillStyle (Gradient (Linear (sx, sy) (ex, ey) points)) =
-  Cairo.withLinearPattern sx sy ex ey $ \pattern ->
-    setGradientFill pattern points
+  Cairo.withLinearPattern sx sy ex ey $ \ptn ->
+    setGradientFill ptn points

 setFillStyle (Gradient (Radial (sx, sy) sr (ex, ey) er points)) =
-  Cairo.withRadialPattern sx sy sr ex ey er $ \pattern ->
-    setGradientFill pattern points
+  Cairo.withRadialPattern sx sy sr ex ey er $ \ptn ->
+    setGradientFill ptn points

 {-| A utility function that adds color stops to a pattern and then fills it. -}
 setGradientFill :: Cairo.Pattern -> [(Double, Color)] -> Cairo.Render ()
-setGradientFill pattern points = do
-  Cairo.setSource pattern
-  mapM_ (\(o, Color r g b a) -> Cairo.patternAddColorStopRGBA pattern o r g b a) points
+setGradientFill ptn points = do
+  Cairo.setSource ptn
+  mapM_ (\(o, Color r g b a) -> Cairo.patternAddColorStopRGBA ptn o r g b a) points
  Cairo.fill

 {-| A utility that renders a form. -}
--- a/src/Helm/Engine/SDL/Keyboard.hs
+++ b/src/Helm/Engine/SDL/Keyboard.hs
@ -0,0 +1,11 @@
+{-| Contains the SDL keyboard mappings. -}
+module Helm.Engine.SDL.Keyboard
+  (mapKey)
+  where
+
+import qualified SDL.Input.Keyboard.Codes as Codes
+import Helm.Engine (Key(..))
+
+mapKey :: Codes.Keycode -> Key
+mapKey Codes.KeycodeReturn = ReturnKey
+mapKey _ = UnknownKey
--- a/src/Helm/Engine/SDL/Mouse.hs
+++ b/src/Helm/Engine/SDL/Mouse.hs
@ -0,0 +1,14 @@
+{-| Contains the SDL mouse button mappings. -}
+module Helm.Engine.SDL.Mouse (mapMouseButton) where
+
+import qualified SDL.Event as Event
+
+import Helm.Engine (MouseButton(..))
+
+mapMouseButton :: Event.MouseButton -> MouseButton
+mapMouseButton Event.ButtonLeft = LeftButton
+mapMouseButton Event.ButtonMiddle = MiddleButton
+mapMouseButton Event.ButtonRight = RightButton
+mapMouseButton Event.ButtonX1 = X1Button
+mapMouseButton Event.ButtonX2 = X2Button
+mapMouseButton _ = UnknownButton
--- a/src/Helm/Game.hs
+++ b/src/Helm/Game.hs
@ -1,28 +0,0 @@
-module Helm.Game (
-  -- * Types
-  GameConfig(..),
-  Game(..)
-) where
-
-import Control.Concurrent.STM (TQueue)
-
-import Helm.Cmd (Cmd)
-import Helm.Engine (Engine)
-import Helm.Render (Render)
-import Helm.Sub (Sub)
-
-{-| Describes how to run a game. -}
-data GameConfig m a = GameConfig {
-  initialFn          :: (m, Cmd a),
-  updateFn           :: m -> a -> (m, Cmd a),
-  subscriptionsFn    :: Sub a,
-  viewFn             :: m -> Render ()
-}
-
-{-| Describes a game's state. -}
-data Game m a = Game {
-  gameConfig       :: GameConfig m a,
-  gameModel        :: m,
-  actionSmp        :: Engine -> IO [a],
-  actionQueue      :: TQueue a
-}
--- a/src/Helm/Graphics.hs
+++ b/src/Helm/Graphics.hs
@ -0,0 +1,9 @@
+{-| Contains the graphics type. -}
+module Helm.Graphics (
+  -- * Types
+  Graphics(..)
+) where
+
+import Helm.Graphics2D (Element)
+
+data Graphics = Graphics2D Element
--- a/src/Helm/Graphics2D.hs
+++ b/src/Helm/Graphics2D.hs
@ -263,7 +263,7 @@ data Path = Path [(Double, Double)] deriving (Show, Eq, Ord, Read)

 {-| Creates a path for a collection of points. -}
 path :: [(Double, Double)] -> Path
-path points = Path points
+path = Path

 {-| Creates a path from a line segment, i.e. a start and end point. -}
 segment :: (Double, Double) -> (Double, Double) -> Path
--- a/src/Helm/Graphics2D/Transform.hs
+++ b/src/Helm/Graphics2D/Transform.hs
@ -26,7 +26,7 @@ instance Num Transform where
  fromInteger n = Transform $ V3 (V3 (fromInteger n) 0 0) (V3 (fromInteger n) 0 0) (V3 0 0 1)

 identity :: Transform
-identity = Transform $ Matrix.identity
+identity = Transform Matrix.identity

 matrix :: Double -> Double -> Double -> Double -> Double -> Double -> Transform
 matrix a b c d x y = Transform $ V3 (V3 a b x) (V3 c d y) (V3 0 0 1)
--- a/src/Helm/Keyboard.hs
+++ b/src/Helm/Keyboard.hs
@ -1,19 +1,26 @@
 {-| Contains subscriptions to events from the keyboard. -}
-module Helm.Keyboard (
-  -- * Subscriptions
-  presses,
-  downs,
-  ups
-) where
+module Helm.Keyboard
+  (
+    -- * Types
+    Key(..)
+    -- * Subscriptions
+  , presses
+  , downs
+  , ups
+  ) where

-import SDL.Input.Keyboard.Codes (Keycode)
-import Helm (Sub(..))
+import FRP.Elerea.Param (input, snapshot)

-presses :: (Keycode -> a) -> Sub a
-presses _ = Sub $ return $ return []
+import Helm.Engine (Engine(..), Sub(..), Key(..))

-downs :: (Keycode -> a) -> Sub a
+presses :: Engine e => (Key -> a) -> Sub e a
+presses f = Sub $  do
+  engine <- input >>= snapshot
+
+  fmap (fmap f) <$> keyboardPressSignal engine
+
+downs :: Engine e => (Key -> a) -> Sub e a
 downs _ = Sub $ return $ return []

-ups :: (Keycode -> a) -> Sub a
+ups :: Engine e => (Key -> a) -> Sub e a
 ups _ = Sub $ return $ return []
--- a/src/Helm/Mouse.hs
+++ b/src/Helm/Mouse.hs
@ -1,37 +1,43 @@
 {-| Contains subscriptions to events from the mouse. -}
 module Helm.Mouse
-(
-  -- * Subscriptions
-  moves,
-  clicks,
-  downs,
-  ups,
-  buttonClicks,
-  buttonDowns,
-  buttonUps
-) where
+  (
+    -- * Types
+    MouseButton(..)
+    -- * Subscriptions
+  , moves
+  , clicks
+  , downs
+  , ups
+  , buttonClicks
+  , buttonDowns
+  , buttonUps
+  ) where

+import FRP.Elerea.Param (input, snapshot)
 import Linear.V2 (V2(V2))
-import Helm (Sub(..))
-import SDL.Input.Mouse (MouseButton(ButtonLeft))

-moves :: (V2 Int -> a) -> Sub a
-moves _ = Sub $ return $ return []
+import Helm.Engine (Sub(..), Engine(..), MouseButton(..))

-buttonClicks :: MouseButton -> (V2 Int -> a) -> Sub a
+moves :: Engine e => (V2 Int -> a) -> Sub e a
+moves f = Sub $ do
+  engine <- input >>= snapshot
+
+  fmap (fmap f) <$> mouseMoveSignal engine
+
+buttonClicks :: Engine e => MouseButton -> (V2 Int -> a) -> Sub e a
 buttonClicks _ _ = Sub $ return $ return []

-buttonDowns :: MouseButton -> (V2 Int -> a) -> Sub a
+buttonDowns :: Engine e => MouseButton -> (V2 Int -> a) -> Sub e a
 buttonDowns _ _ = Sub $ return $ return []

-buttonUps :: MouseButton -> (V2 Int -> a) -> Sub a
+buttonUps :: Engine e => MouseButton -> (V2 Int -> a) -> Sub e a
 buttonUps _ _ = Sub $ return $ return []

-clicks :: (V2 Int -> a) -> Sub a
-clicks = buttonClicks ButtonLeft
+clicks :: Engine e => (V2 Int -> a) -> Sub e a
+clicks = buttonClicks LeftButton

-downs :: (V2 Int -> a) -> Sub a
-downs = buttonDowns ButtonLeft
+downs :: Engine e => (V2 Int -> a) -> Sub e a
+downs = buttonDowns LeftButton

-ups :: (V2 Int -> a) -> Sub a
-ups = buttonUps ButtonLeft
+ups :: Engine e => (V2 Int -> a) -> Sub e a
+ups = buttonUps LeftButton
--- a/src/Helm/Render.hs
+++ b/src/Helm/Render.hs
@ -1,16 +0,0 @@
-module Helm.Render (
-  -- * Types
-  Render(..),
-  -- * Utilities
-  none
-) where
-
-import Control.Monad.Trans.State (StateT)
-
-import Helm.Engine (Engine)
-
-data Render a = Render (StateT Engine IO a)
-
-{-| Render nothing to the screen. -}
-none :: Render ()
-none = Render $ return ()
--- a/src/Helm/Sub.hs
+++ b/src/Helm/Sub.hs
@ -1,26 +1,23 @@
-{-| Contains the subscription type and related utilities. -}
-module Helm.Sub (
-  -- * Types
-  Sub(..),
-  -- * Utilities
-  batch,
-  none
-) where
+{-| Contains the subscription related utilities. -}
+module Helm.Sub
+  (
+    -- * Types
+    Sub(..)
+    -- * Utilities
+  , batch
+  , none
+  ) where

-import FRP.Elerea.Param (SignalGen, Signal)
+import Helm.Engine (Engine, Sub(..))

-import Helm.Engine (Engine)
-
-data Sub a = Sub (SignalGen Engine (Signal [a]))
-
-batch :: [Sub a] -> Sub a
+batch :: Engine e => [Sub e a] -> Sub e a
 batch subs = Sub $ do
-  signals <- sequence $ map (\(Sub gen) -> gen) subs
+  signals <- mapM (\(Sub gen) -> gen) subs

  return $ do
    lists <- sequence signals

    return $ concat lists

-none :: Sub a
-none = Sub $ return $ return []
+none :: Engine e => Sub e a
+none = Sub . return $ return []
--- a/src/Helm/Time.hs
+++ b/src/Helm/Time.hs
@ -1,24 +1,25 @@
 {-| Contains functions for composing units of time and
    subscriptions to events from the game clock. -}
-module Helm.Time (
-  -- * Types
-  Time,
-  -- * Units
-  millisecond,
-  second,
-  minute,
-  hour,
-  inMilliseconds,
-  inSeconds,
-  inMinutes,
-  inHours,
-  -- * Commands
-  now,
-  -- * Subscriptions
-  every,
-) where
+module Helm.Time
+  (
+    -- * Types
+    Time
+    -- * Units
+  , millisecond
+  , second
+  , minute
+  , hour
+  , inMilliseconds
+  , inSeconds
+  , inMinutes
+  , inHours
+    -- * Commands
+  , now
+    -- * Subscriptions
+  , every
+  ) where

-import Helm (Cmd(..), Sub(..))
+import Helm.Engine (Cmd(..), Sub(..), Engine(..))

 {-| A type describing an amount of time in an arbitary unit. Use the time
    composing/converting functions to manipulate time values. -}
@ -56,8 +57,8 @@ inMinutes n = n / minute
 inHours :: Time -> Double
 inHours n = n / hour

-now :: Cmd Time
+now :: Engine e => Cmd e Time
 now = Cmd $ return []

-every :: Time -> (Time -> a) -> Sub a
+every :: Engine e => Time -> (Time -> a) -> Sub e a
 every _ _ = Sub $ return $ return []
--- a/src/Helm/Window.hs
+++ b/src/Helm/Window.hs
@ -1,42 +1,45 @@
 {-| Contains signals that sample input from the game window. -}
-module Helm.Window (
-  -- * Commands
-  size,
-  width,
-  height,
-  -- * Subscriptions
-  resizes
-) where
+module Helm.Window
+  (
+    -- * Commands
+    size
+  , width
+  , height
+    -- * Subscriptions
+  , resizes
+  ) where

 import Control.Monad.State (get)
-import Helm.Cmd (Cmd(..))
-import Helm.Engine (Engine(..))
-import Helm.Sub (Sub(..))
+import Control.Monad.IO.Class (liftIO)
+
+import FRP.Elerea.Param (input, snapshot)
 import Linear.V2 (V2(V2))

-import qualified SDL
-import qualified SDL.Video as Video
+import Helm.Engine (Engine(..), Cmd(..), Sub(..))

-size :: Cmd (V2 Int)
+size :: Engine e => Cmd e (V2 Int)
 size = Cmd $ do
-  Engine { window } <- get
-  V2 x y <- SDL.get $ Video.windowSize window
+  engine <- get
+  V2 x y <- liftIO $ windowSize engine

  return [V2 (fromIntegral x) (fromIntegral y)]

-width :: Cmd Int
+width :: Engine e => Cmd e Int
 width = Cmd $ do
-  Engine { window } <- get
-  V2 x _ <- SDL.get $ Video.windowSize window
+  engine <- get
+  V2 x _ <- liftIO $ windowSize engine

  return [fromIntegral x]

-height :: Cmd Int
+height :: Engine e => Cmd e Int
 height = Cmd $ do
-  Engine { window } <- get
-  V2 _ y <- SDL.get $ Video.windowSize window
+  engine <- get
+  V2 _ y <- liftIO $ windowSize engine

  return [fromIntegral y]

-resizes :: (V2 Int -> a) -> Sub a
-resizes _ = Sub $ return $ return []
+resizes :: Engine e => (V2 Int -> a) -> Sub e a
+resizes f = Sub $ do
+  engine <- input >>= snapshot
+
+  fmap (fmap f) <$> windowResizeSignal engine