canvas/app/Main.hs

{-# 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