canvas/app/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Affection

import SDL (($=))
import qualified SDL

import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLU

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.Debug 3 3
            }
          }
        )
      ]
    , initScreenMode = SDL.FullscreenDesktop
    , preLoop = preLoopImpl
    , eventLoop = mapM_ handle
    , updateLoop = updateLoopImpl
    , drawLoop = drawLoopImpl
    , loadState = loadStateImpl
    , cleanUp = (\_ -> return ())
    , canvasSize = Nothing
    }

preLoopImpl :: Affection UserData ()
preLoopImpl = liftIO $ do
  void $ SDL.setMouseLocationMode SDL.RelativeLocation
  -- GL.depthFunc $= Just GL.Less
  GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Nearest)
  GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
  GL.texture GL.Texture2D $= GL.Enabled
  -- GL.frontFace $= GL.CW
  GL.viewport $= (GL.Position 0 0, GL.Size 1920 1080)

loadStateImpl :: IO UserData
loadStateImpl = do

  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 sto sdo)) = rassets
  liftIO $ do
    mapM_
      (\ident -> do
        CR.init
          (svo :: VertexObjects Sprite)
          (sso :: ShaderObjects Sprite)
          (sto M.! ident)
          (head (sdo M.! ident))
        mapM_ 
          (draw
            (svo :: VertexObjects Sprite)
            (sso :: ShaderObjects Sprite)
            )
          (sdo M.! ident)
        clean
          (head (sdo M.! ident))
        )
      (M.keys sdo)