73 lines
1.5 KiB
Haskell
73 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Main where
|
|
|
|
import Affection
|
|
|
|
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
|
|
|
|
-- internal imports
|
|
|
|
import Types
|
|
|
|
main :: IO ()
|
|
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
|