canvas/app/Main.hs

74 lines
1.5 KiB
Haskell
Raw Normal View History

2020-02-07 04:50:19 +00:00
{-# LANGUAGE OverloadedStrings #-}
2020-02-01 15:09:09 +00:00
module Main where
2020-02-05 06:21:39 +00:00
import Affection
2020-02-07 04:50:19 +00:00
import SDL (($=))
import qualified SDL
import qualified Rendering.Graphics.OpenGL as GL
import Codec.Picture
import Control.Monad (void)
import Control.Concurrent.STM
import qualified Data.Map.Strict as M
2020-02-05 06:21:39 +00:00
-- internal imports
import Types
2020-02-01 15:09:09 +00:00
main :: IO ()
2020-02-07 04:50:19 +00:00
main =
withAffection AffectionConfig
{ initComponents = All
, windowTitle = "canvas"
, windowConfigs =
[ ( 0
, SDL.DefaultWindow
{ SDL.windowInitialSize = SDL.V2 1600 900
, SDL.windowGraphicsContext = SL.OpenGLContext SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 3 3
}
}
)
]
, initScreenMode = SDL.FullscreenDesktop
, preLoop = return ()
, eventLoop = MapM_ handle
, updateLoop = updateLoop
, drawLoop = drawLoop
, loadState = loadState
, cleanUp = (\_ -> return ())
, canvasSize = Nothing
}
loadState :: IO UserData
loadState = do
void $ SDL.setMouseLocationMode SDL.RelativeLocation
GL.depthFunc $= Just GL.Less
subs <- Subsystms
<$> (SubWindow <$> newTVarIO [])
<*> (SubMouse <$> newTVarIO [])
rawImg <- readImage "assets/img/lynx.jpg"
let img = case eRawImg of
Left err -> error err
Right dynImg -> convertRGBA8 dynImg
return UserData
{ udSubsystems = subs
, udAssetSprites = M.singleton "lynx" (Sprite (V2 0 0) img)
}
handle = return ()
updateLoop = return ()
drawLoop = do
ud@(UserData subs sprites) <- getAffection
draw