small platformer game
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

88 lines
2.1 KiB

{-# 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 = do
liftIO $ atomically $ writeTVar (gameState gd) Loading
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)
progressMeter <- liftIO $ atomically (fst <$> readTMVar (gameStateLoadProgress gd))
if progressMeter < 0
then do
-- liftIO (atomically (putTMVar (gameStateLoadProgress gd) (0, "Ohai!")))
smLoad state gd
else
smUpdate state gd dt
draw :: GameData -> Affection ()
draw gd = do
state <- liftIO (atomically $ readTVar $ gameState gd)
smDraw state gd
init :: IO GameData
init = GameData
<$> newTVarIO Loading
<*> newTMVarIO (-1, "Ohai!")
<*> newTMVarIO EmptyData
<*> (Subsystems
<$> (SubWindow <$> newTVarIO [])
<*> (SubMouse <$> newTVarIO [])
<*> (SubKeyboard <$> newTVarIO [])
<*> (SubTranslator <$> newTVarIO [])
)
<*> newTVarIO (M.fromList [])
<*> newTVarIO True