haskelloids/src/Main.hs

87 lines
2.4 KiB
Haskell
Raw Normal View History

2017-01-03 18:36:01 +00:00
{-# LANGUAGE OverloadedStrings #-}
2016-12-26 21:26:25 +00:00
module Main where
2017-12-19 05:49:41 +00:00
import Affection as A
2017-12-16 10:55:30 +00:00
import SDL (($=))
2016-12-27 22:25:58 +00:00
import qualified SDL
2017-12-19 20:53:07 +00:00
import qualified Graphics.Rendering.OpenGL as GL
2016-12-27 22:25:58 +00:00
2017-12-16 10:55:30 +00:00
import qualified Data.Map as M
2016-12-27 22:25:58 +00:00
2017-12-16 10:55:30 +00:00
import Linear as L
2016-12-27 22:25:58 +00:00
2017-12-19 21:36:42 +00:00
import NanoVG hiding (V2(..), V4(..))
2017-12-19 05:49:41 +00:00
2017-12-20 23:56:16 +00:00
import Control.Monad (when)
2017-12-19 05:49:41 +00:00
import Control.Monad.IO.Class (liftIO)
2016-12-31 16:01:24 +00:00
-- internal imports
import Types
import Commons
2017-12-16 10:55:30 +00:00
import StateMachine ()
import Init
2016-12-31 16:01:24 +00:00
2016-12-26 21:26:25 +00:00
main :: IO ()
2017-12-16 10:55:30 +00:00
main = do
2017-12-19 05:49:41 +00:00
logIO A.Debug "Starting"
2017-12-16 10:55:30 +00:00
withAffection AffectionConfig
{ initComponents = All
, windowTitle = "Haskelloids"
2017-12-16 18:06:36 +00:00
, windowConfig = SDL.defaultWindow
2017-12-16 10:55:30 +00:00
{ SDL.windowOpenGL = Just SDL.defaultOpenGL
2017-12-20 23:56:16 +00:00
{ SDL.glProfile = SDL.Core SDL.Normal 3 2
-- , SDL.glColorPrecision = V4 0 8 8 8
2017-12-16 10:55:30 +00:00
}
}
, initScreenMode = SDL.Windowed
, canvasSize = Nothing
, loadState = load
2017-12-19 20:53:07 +00:00
, preLoop = pre >> smLoad Menu
2017-12-16 10:55:30 +00:00
, eventLoop = handle
, updateLoop = update
, drawLoop = draw
2017-12-16 18:06:36 +00:00
, cleanUp = (\_ -> return ())
2017-12-16 10:55:30 +00:00
}
2016-12-27 22:25:58 +00:00
2017-12-19 20:53:07 +00:00
pre :: Affection UserData ()
pre = do
subs <- subsystems <$> getAffection
liftIO $ logIO A.Debug "Setting global resize event listener"
_ <- partSubscribe (subWindow subs) $ \msg -> case msg of
MsgWindowResize _ _ (V2 w h) -> do
2017-12-20 01:00:28 +00:00
liftIO $ logIO A.Debug "Window has been resized"
2017-12-19 20:53:07 +00:00
let nw = floor $ fromIntegral h * (800/600)
dw = floor $ (fromIntegral w - fromIntegral nw) / 2
GL.viewport $= (GL.Position dw 0, GL.Size nw h)
_ -> return ()
2017-12-20 23:56:16 +00:00
_ <- partSubscribe (subKeyboard subs) $ \kbdev ->
when (msgKbdKeyMotion kbdev == SDL.Pressed) $
case SDL.keysymKeycode (msgKbdKeysym kbdev) of
SDL.KeycodeF -> do
dt <- getDelta
liftIO $ logIO A.Debug $ "FPS: " ++ show (1/dt)
_ -> return ()
2017-12-19 20:53:07 +00:00
return ()
2016-12-27 22:25:58 +00:00
update :: Double -> Affection UserData ()
update sec = do
2017-11-04 17:13:28 +00:00
ud <- getAffection
smUpdate (state ud) sec
2016-12-27 22:25:58 +00:00
2017-12-16 18:06:36 +00:00
handle :: [SDL.EventPayload] -> Affection UserData ()
2017-12-16 10:55:30 +00:00
handle e = do
2017-12-19 16:30:44 +00:00
(Subsystems w k) <- subsystems <$> getAffection
_ <- consumeSDLEvents w =<< consumeSDLEvents k e
return ()
2016-12-28 11:19:45 +00:00
2016-12-27 22:25:58 +00:00
draw :: Affection UserData ()
draw = do
2017-12-19 05:49:41 +00:00
ud <- getAffection
2017-12-20 23:56:16 +00:00
-- window <- drawWindow <$> get
-- pf <- liftIO $ SDL.getWindowPixelFormat window
-- liftIO $ logIO A.Debug $ "Window pixel format: " ++ show pf
liftIO $ beginFrame (nano ud) 800 600 1
2017-12-19 05:49:41 +00:00
smDraw (state ud)
liftIO $ endFrame (nano ud)