pituicat/src/Scenes/Test/Load.hs

128 lines
2.9 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Scenes.Test.Load where
import qualified Graphics.Rendering.OpenGL as GL
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import Control.Concurrent.STM
import Control.Monad (void)
import Linear
-- internal imports
import Types
import Classes
import Graphics
import Map
import Scenes.Test.Types
import Scenes.Test.Util
load
:: Test
-> TMVar Progress
-> IO ()
load level progress = do
atomically $ do
void $ takeTMVar progress
putTMVar progress (0, "Loading test level...")
loadedMap <- constructMap testLevelDesc 0
atomically $ putTMVar (testMap level) loadedMap
void $ atomically $ do
void $ takeTMVar progress
putTMVar progress (0.5, "Loaded test level map!")
void $ atomically $ swapTVar (testLoaded level) True
vertexArray <- newVertexArray
bind vertexArray
vertexBuffer <- newVertexBuffer 1024
bind vertexBuffer
--let vertices = VS.fromList (createQuad (V2 (400 - 16) (300 - 16)) 0)
--write vertexBuffer 0 vertices
indexBuffer <- newIndexBuffer 1024
bind indexBuffer
-- let indices = VS.fromList [0, 1, 2, 2, 3, 0]
-- write indexBuffer 0 indices
addBuffer (undefined :: Vertex) vertexBuffer
(_, tex) <- newTexture "res/pituicat/pituicat.png" 1
bind tex
shader <- newShader
[ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
, ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
]
let projection = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
view = mkTransformationMat
(identity :: M33 GL.GLfloat)
(V3 (400 - sx) (300 - sy) 0)
model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
startpos@(V2 sx sy) = V2 100 1948
pituicat = Pituicat
(realToFrac <$> startpos)
(V2 0 0)
(V2 0 0)
(V2 0 0)
(V2 0 0)
100
tex
False
Nothing
ViewRight
[]
False
oil = PowerUp
(realToFrac <$> (startpos + V2 200 0))
(V2 0 0)
(V2 0 0)
5000
tex
(EffectHolder 5 SpeedUp)
bind shader
setUniform shader "u_mvp" (projection !*! view !*! model)
setUniformList
shader
"u_textures"
(map
textureSlot
[ (tileMapTexture $ mapTileMap loadedMap)
, tex
]
)
unbind vertexArray
unbind vertexBuffer
unbind indexBuffer
unbind tex
unbind shader
atomically $ do
putTMVar (testGraphics level)
(GLAssets vertexArray vertexBuffer indexBuffer shader [tex])
writeTVar (testPlayer level) (Just pituicat)
writeTVar (testCast level)
(V.fromList [Cast (oil {puPos = puPos oil + V2 200 0})])
writeTVar (testPowerups level) (V.fromList [oil])
writeTVar (testLoaded level) True
writeTVar (testMatrices level) (PVM projection view model)
void $ atomically $ do
void $ takeTMVar progress
putTMVar progress (1, "Loaded graphics!")