pituicat/src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Affection

import qualified Data.Text as T

import qualified SDL

import qualified Graphics.Rendering.OpenGL as GL

import Control.Concurrent.STM

import qualified Data.Map.Strict as M

import Data.Maybe (isJust)

import Linear

-- internal imports

import StateMachine
import Types
import Classes
import Scenes.Test

instance Affectionate GameData where
  preLoop = preLoad
  handleEvents = handle
  update = Main.update
  draw = Main.draw
  loadState = Main.init
  cleanUp _ = return ()
  hasNextStep = liftIO . atomically . readTVar . gameRunning

main :: IO ()
main = do
  let config = AffectionConfig
        { initComponents = All
        , windowTitle = "Pituicat"
        , windowConfigs =
          [ ( 0
            , SDL.defaultWindow
              { SDL.windowInitialSize = V2 800 600
              , SDL.windowResizable = True
              , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
                { SDL.glProfile = SDL.Core SDL.Normal 3 3
                }
              }
            , SDL.Windowed
            )
          ]
        } :: AffectionConfig GameData
  withAffection config

preLoad :: GameData -> Affection ()
preLoad gd =
  liftIO $ do
    scene <- liftIO $ (initScene :: IO Test)
    atomically $ putTMVar (gameScene gd) (Stage scene)

handle :: GameData -> [SDL.EventPayload] -> Affection ()
handle gd evs = do
  state <- liftIO (atomically $ readTVar $ gameState gd)
  smEvent state gd evs

update :: GameData -> Double -> Affection ()
update gd dt = do
  state <- liftIO $ atomically $ readTVar $ gameState gd
  isStagePresent <- liftIO $ atomically $ isEmptyTMVar $ gameScene gd
  if isStagePresent
  then do
    hasLoadThreadId <- isJust <$> (liftIO $ atomically $ readTVar $ gameLoadThread gd)
    (Stage sceneContainer) <- liftIO $ atomically $ readTMVar $ gameScene gd
    sceneLoaded <- isSceneLoaded sceneContainer
    if not sceneLoaded && not hasLoadThreadId
    then
      smLoad state gd
    else
      smUpdate state gd dt
  else
    return ()

draw :: GameData -> Affection ()
draw gd = do
  state <- liftIO (atomically $ readTVar $ gameState gd)
  smDraw state gd

init :: IO GameData
init = GameData
  <$> newEmptyTMVarIO
  <*> newTVarIO Loading
  <*> newTMVarIO (0, "Ohai!")
  <*> (Subsystems
    <$> (SubWindow <$> newTVarIO [])
    <*> (SubMouse <$> newTVarIO [])
    <*> (SubKeyboard <$> newTVarIO [])
    <*> (SubTranslator <$> newTVarIO [])
    )
  <*> newTVarIO (M.fromList [])
  <*> newTVarIO True
  <*> newTVarIO Nothing