vulkan-tutorial/examples/example00.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RankNTypes #-}

import Affection
import qualified SDL

import Control.Concurrent.STM

data StateData = StateData
  { sdSubs :: Subsystems
  }

data Subsystems = Subsystems
  { subWindow :: AffectionWindow StateData
  , subMouse :: AffectionMouse StateData
  , subKeyboard :: AffectionKeyboard StateData
  }

main :: IO ()
main = do
  logIO Debug "Starting"
  let conf = AffectionConfig
        { initComponents = All
        , windowTitle = "affection: example00"
        , windowConfig = SDL.defaultWindow
        , initScreenMode = SDL.Windowed
        , canvasSize = Nothing
        , loadState = load
        , preLoop = pre
        , eventLoop = handle
        , updateLoop = update
        , drawLoop = draw
        , cleanUp = clean
        }
  withAffection conf

load :: IO StateData
load = do
  empty1 <- newTVarIO [] -- ([] :: [(UUID, WindowMessage -> Affection StateData ())])
  empty2 <- newTVarIO [] -- ([] :: [(UUID, MouseMessage -> Affection StateData ())])
  empty3 <- newTVarIO [] -- ([] :: [(UUID, KeyboardMessage -> Affection StateData ())])
  return $ StateData $ Subsystems
    (AffectionWindow empty1)
    (AffectionMouse empty2)
    (AffectionKeyboard empty3)

pre :: Affection StateData ()
pre = do
  sd <- getAffection
  _ <- partSubscribe (subKeyboard $ sdSubs sd) exitOnQ
  return ()

exitOnQ :: KeyboardMessage -> Affection StateData ()
exitOnQ (MsgKeyboardEvent _ _ _ _ sym) =
  case SDL.keysymKeycode sym of
    SDL.KeycodeQ -> quit
    otherwise -> return ()

handle :: [SDL.EventPayload] -> Affection StateData ()
handle es = do
  (Subsystems a b c) <- sdSubs <$> getAffection
  _ <- consumeSDLEvents a es
  _ <- consumeSDLEvents b es
  _ <- consumeSDLEvents c es
  return ()

update _ = return ()

draw = return ()

clean _ = return ()