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.GL as GLRaw
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

import Foreign (nullPtr, plusPtr)

-- internal imports

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

cattyness = 1000

main :: IO ()
main =
  withAffection AffectionConfig
    { initComponents = All
    , windowTitle = "canvas"
    , windowConfigs =
      [ ( 0
        , SDL.defaultWindow
          { SDL.windowInitialSize = SDL.V2 1920 1080
          , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
            { SDL.glProfile = SDL.Core SDL.Normal 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 cattyness

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

handle event = return ()

updateLoopImpl dt = do
  liftIO $ putStrLn (show $ 1 / dt)
  return ()

drawLoopImpl = do
  -- liftIO $ putStrLn "I'm in your draw"
  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)
        GL.drawArraysInstanced GL.Triangles 0 6 (fromIntegral cattyness)
        -- GL.drawElementsInstanced GL.Triangles 6 GL.UnsignedInt (nullPtr `plusPtr` 1) 9999
        -- GLRaw.glDrawElementsInstanced GLRaw.GL_TRIANGLES 6 GLRaw.GL_UNSIGNED_INT nullPtr 9999
        clean
          (head (sdo M.! ident))
        )
      (M.keys sdo)