pituicat/src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Affection

import qualified Data.Text as T

import qualified SDL

import Control.Concurrent.STM

import qualified Data.Map.Strict as M

import Linear

-- internal imports

import StateMachine
import Types

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
    let projection = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
        view = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
        model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)

    vertexArrayObject <- GL.genObjectName
    va <- newVertexArray
    atomically $ (writeTVar (gameScene gd) =<< (initScene :: IO Test))
  

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 <- atomically $ isEmptyTMVar $ gamescene gd
  if isStagePresent
  then
    stage <- liftIO $ atomically $ readTVar $ gameScene gd
    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