69 lines
1.6 KiB
Haskell
69 lines
1.6 KiB
Haskell
|
module Main where
|
||
|
|
|
||
|
|
import Affection as A
|
||
|
|
|
||
|
|
import qualified SDL
|
||
|
|
|
||
|
|
import NanoVG hiding (V2(..), V3(..))
|
||
|
|
|
||
|
|
import Linear
|
||
|
|
|
||
|
|
-- internal imports
|
||
|
|
|
||
|
|
import Types
|
||
|
|
import StateMachine ()
|
||
|
|
import Init
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
let config = AffectionConfig
|
||
|
|
{ initComponents = All
|
||
|
|
, windowTitle = "Tracer"
|
||
|
|
, windowConfig = SDL.defaultWindow
|
||
|
|
{ SDL.windowInitialSize = V2 1280 720
|
||
|
|
, SDL.windowResizable = True
|
||
|
|
, SDL.windowOpenGL = Just SDL.defaultOpenGL
|
||
|
|
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
|
||
|
|
}
|
||
|
|
}
|
||
|
|
, canvasSize = Nothing
|
||
|
|
, preLoop = pre >> smLoad Menu
|
||
|
|
, eventLoop = handle
|
||
|
|
, updateLoop = update
|
||
|
|
, drawLoop = draw
|
||
|
|
, loadState = load
|
||
|
|
, cleanUp = const (return ())
|
||
|
|
, initScreenMode = SDL.Windowed
|
||
|
|
}
|
||
|
|
withAffection config
|
||
|
|
|
||
|
|
pre :: Affection UserData ()
|
||
|
|
pre = do
|
||
|
|
Subsystems w m <- subsystems <$> getAffection
|
||
|
|
_ <- partSubscribe w (fitViewport (1280/720))
|
||
|
|
_ <- partSubscribe w (exitOnWindowClose)
|
||
|
|
return ()
|
||
|
|
|
||
|
|
update :: Double -> Affection UserData ()
|
||
|
|
update dt = do
|
||
|
|
ud <- getAffection
|
||
|
|
smUpdate (state ud) dt
|
||
|
|
|
||
|
|
draw :: Affection UserData ()
|
||
|
|
draw = do
|
||
|
|
ud <- getAffection
|
||
|
|
liftIO $ beginFrame (nano ud) 1280 720 1
|
||
|
|
smDraw (state ud)
|
||
|
|
liftIO $ endFrame (nano ud)
|
||
|
|
|
||
|
|
handle :: [SDL.EventPayload] -> Affection UserData ()
|
||
|
|
handle evs = do
|
||
|
|
s <- state <$> getAffection
|
||
|
|
smEvent s evs
|
||
|
|
|
||
|
|
exitOnWindowClose :: WindowMessage -> Affection UserData ()
|
||
|
|
exitOnWindowClose (MsgWindowClose _ _) = do
|
||
|
|
liftIO $ logIO A.Debug "Window Closed"
|
||
|
|
quit
|
||
|
|
exitOnWindowClose _ = return ()
|