120 lines
4.1 KiB
Haskell
120 lines
4.1 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
--{-# LANGUAGE Strict #-}
|
|
module Picture.Preload
|
|
( RenderData (..)
|
|
, preloadRender
|
|
, cleanUpRenderPreload
|
|
)
|
|
where
|
|
|
|
import Picture.Data
|
|
|
|
import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
|
|
|
|
import Control.Lens
|
|
|
|
import Foreign
|
|
import Shader
|
|
|
|
import Geometry (Point2)
|
|
|
|
data RenderData = RenderData
|
|
{ _lightSourceShader :: FullShader (Float,Float,Float,Float)
|
|
, _wallShadowShader :: FullShader (Point2,Point2,Point2,Point2)
|
|
, _backgroundShader :: FullShader (Point2,Point2,Point2,Point2)
|
|
, _listShaders :: [FullShader RenderType]
|
|
, _dummyVBO :: BufferObject
|
|
, _dummyPtr :: Ptr Float
|
|
}
|
|
|
|
makeLenses ''RenderData
|
|
|
|
preloadRender :: IO RenderData
|
|
preloadRender = do
|
|
-- compile shader programs
|
|
lsShad <- makeShader "lightmapCircle" [vert,geom,frag] [(0,4)] Points (return . return . flat4)
|
|
-- fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]
|
|
|
|
bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
|
|
"data/texture/smudgedDirt.png"
|
|
|
|
wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPStrat
|
|
["lightPos"]
|
|
|
|
bslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat
|
|
lslist <- makeShader "basic" [vert,frag] [(0,3),(1,4)] Lines pokeLineStrat
|
|
aslist <- makeShader "arc" [vert,geom,frag] [(0,3),(1,4),(2,4)] Points pokeArcStrat
|
|
eslist <- makeShader "ellipse" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeEllStrat
|
|
cslist <- makeTextureShader "character" [vert,geom,frag]
|
|
[(0,3),(1,4),(2,3)] Points pokeCharStrat
|
|
"data/texture/charMap.png"
|
|
|
|
bezierQuadShader
|
|
<- makeShader "bezierQuad" [vert,geom,frag] [(0,3),(1,4),(2,3)] Triangles pokeBezQStrat
|
|
|
|
--the following vbo is set up to contain one fixed vertex
|
|
dummyvbo <- genObjectName
|
|
dummyptr <- mallocArray numDrawableElements
|
|
pokeArray dummyptr [0..2000]
|
|
bindBuffer ArrayBuffer $= Just dummyvbo
|
|
bufferData ArrayBuffer $= (fromIntegral floatSize, dummyptr, StaticDraw)
|
|
|
|
-- input a list of (attribute location, attrib length) pairs
|
|
-- these will have buffers and pointers created
|
|
backgroundvao <- setupVAO [(0,4),(1,2)]
|
|
|
|
return $ RenderData
|
|
{ _listShaders = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
|
|
, _dummyVBO = dummyvbo
|
|
, _dummyPtr = dummyptr
|
|
, _lightSourceShader = lsShad
|
|
, _wallShadowShader = wsShad
|
|
, _backgroundShader = bgShad
|
|
}
|
|
|
|
|
|
--------------------end preloadRender
|
|
cleanUpRenderPreload :: RenderData -> IO ()
|
|
cleanUpRenderPreload pd = do
|
|
mapM_ freeShaderPointers $ _listShaders pd
|
|
freeShaderPointers $ _lightSourceShader pd
|
|
freeShaderPointers $ _wallShadowShader pd
|
|
freeShaderPointers $ _backgroundShader pd
|
|
free $ _dummyPtr pd
|
|
|
|
{-# INLINE pokeBezQStrat #-}
|
|
pokeBezQStrat :: RenderType -> [[[Float]]]
|
|
pokeBezQStrat (RenderBezQ vs) = fmap (\((x,y,z),(r,g,b,a),(s,t,v)) -> [[x,y,z],[r,g,b,a],[s,t,v]]) vs
|
|
pokeBezQStrat _ = []
|
|
|
|
{-# INLINE pokeTriStrat #-}
|
|
pokeTriStrat :: RenderType -> [[[Float]]]
|
|
pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
|
|
pokeTriStrat _ = []
|
|
|
|
pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs
|
|
pokeCharStrat _ = []
|
|
|
|
pokeArcStrat (RenderArc (a,b,c)) = [flat3 (flat3 a, flat4 b, flat4 c)]
|
|
pokeArcStrat _ = []
|
|
|
|
pokeLineStrat (RenderLine vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
|
|
pokeLineStrat _ = []
|
|
|
|
pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
|
|
pokeEllStrat _ = []
|
|
|
|
bufferOffset :: Integral a => a -> Ptr b
|
|
bufferOffset = plusPtr nullPtr . fromIntegral
|
|
|
|
vert = VertexShader
|
|
geom = GeometryShader
|
|
frag = FragmentShader
|
|
|
|
pokeWPStrat :: (Point2,Point2,Point2,Point2) -> [[[Float]]]
|
|
pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w],[a,b,c,d]]]
|
|
|
|
pokeBGStrat :: a -> [[[Float]]]
|
|
pokeBGStrat = const []
|
|
|