canvas/app/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Affection

import SDL (($=))
import qualified SDL

import qualified Graphics.Rendering.OpenGL as GL

import Codec.Picture

import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)

import Control.Concurrent.STM

import qualified Data.Map.Strict as M

-- internal imports

import Types
import Types.Sprite
import Renderer
import Classes.Renderable as CR

main :: IO ()
main =
  withAffection AffectionConfig
    { initComponents = All
    , windowTitle = "canvas"
    , windowConfigs =
      [ ( 0
        , SDL.defaultWindow
          { SDL.windowInitialSize = SDL.V2 1600 900
          , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
            { SDL.glProfile = SDL.Core SDL.Normal 3 3
            }
          }
        )
      ]
    , initScreenMode = SDL.FullscreenDesktop
    , preLoop = return ()
    , eventLoop = mapM_ handle
    , updateLoop = updateLoopImpl
    , drawLoop = drawLoopImpl
    , loadState = loadStateImpl
    , cleanUp = (\_ -> return ())
    , canvasSize = Nothing
    }

loadStateImpl :: IO UserData
loadStateImpl = do
  void $ SDL.setMouseLocationMode SDL.RelativeLocation
  GL.depthFunc $= Just GL.Less

  subs <- Subsystems
    <$> (SubWindow <$> newTVarIO [])
    <*> (SubMouse <$> newTVarIO [])
  
  spriteDetails <- loadSprites

  return UserData
    { udSubsystems = subs
    , udRenderAssets = RenderAssets
      { assetSprites = spriteDetails
      }
    }

handle event = return ()

updateLoopImpl dt = return ()

drawLoopImpl = do
  ud@(UserData subs rassets) <- getAffection
  let (RenderAssets sDetails@(AssetDetails svo sso sdo)) = rassets
  liftIO $ do
    CR.init
      (svo :: VertexObjects Sprite)
      (sso :: ShaderObjects Sprite)
      (head $ M.elems sdo)
    mapM_ (draw (svo :: VertexObjects Sprite) (sso :: ShaderObjects Sprite)) (M.elems sdo)
    clean (head $ M.elems sdo)