Work towards doing transformations using uniforms
This commit is contained in:
+71
-93
@@ -93,6 +93,36 @@ charToTuple :: Char -> (Point3,Point4,Point2)
|
||||
charToTuple c = ((0,0,0),white,(offset,100))
|
||||
where offset = fromIntegral (fromEnum c) - 32
|
||||
|
||||
picToList :: Int -> Picture -> [RenderType]
|
||||
--{-# INLINE picToList #-}
|
||||
picToList x (Polygon i ps)
|
||||
| i == x = [RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black]
|
||||
| otherwise = []
|
||||
picToList x (PolygonCol i vs)
|
||||
| i /= x = []
|
||||
| otherwise =
|
||||
let (ps,cs) = unzip vs
|
||||
in [RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs]
|
||||
picToList x (Circle i r)
|
||||
| i == x = [RenderCirc $ ((0,0,0),black,r)]
|
||||
| otherwise = []
|
||||
picToList x (ThickArc i startA endA rad wdth)
|
||||
| i == x = [RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))]
|
||||
| otherwise = []
|
||||
picToList x (Line i ps)
|
||||
| i == x = [RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white]
|
||||
| otherwise = []
|
||||
picToList x (Text i s)
|
||||
| i == x = [RenderText $ stringToList s]
|
||||
| otherwise = []
|
||||
picToList j Blank = []
|
||||
picToList j (Scale x y pic) = fmap (scaleRen x y) $ picToList j pic
|
||||
picToList j (Translate x y pic) = fmap (translateRen x y) $ picToList j pic
|
||||
picToList j (Rotate a pic) = fmap (rotateRen a) $ picToList j pic
|
||||
picToList j (SetDepth a pic) = fmap (setDepthRen a) $ picToList j pic
|
||||
picToList j (Color c pic) = fmap (colorRen c) $ picToList j pic
|
||||
picToList j (Pictures pics) = concatMap (picToList j) pics
|
||||
|
||||
--picToFTree :: Picture -> IM.IntMap (FTree RenderType)
|
||||
--{-# INLINE picToFTree #-}
|
||||
--picToFTree (Polygon i ps) = IM.singleton i $ FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
@@ -113,7 +143,7 @@ charToTuple c = ((0,0,0),white,(offset,100))
|
||||
--picToFTree (Pictures pics) = fmap FBranches $ IM.unionsWith (++) $ map (fmap return . picToFTree) pics
|
||||
|
||||
picToFTree :: Int -> Picture -> FTree RenderType
|
||||
{-# INLINE picToFTree #-}
|
||||
--{-# INLINE picToFTree #-}
|
||||
picToFTree x (Polygon i ps)
|
||||
| i == x = FLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
| otherwise = FLeaf RenderBlank
|
||||
@@ -135,13 +165,18 @@ picToFTree x (Text i s)
|
||||
| i == x = FLeaf $ RenderText $ stringToList s
|
||||
| otherwise = FLeaf RenderBlank
|
||||
picToFTree j Blank = FLeaf RenderBlank
|
||||
picToFTree j (Scale x y pic) = FBranch (scaleRen x y) $ picToFTree j pic
|
||||
picToFTree j (Translate x y pic) = FBranch (translateRen x y) $ picToFTree j pic
|
||||
picToFTree j (Rotate a pic) = FBranch (rotateRen a) $ picToFTree j pic
|
||||
picToFTree j (SetDepth a pic) = FBranch (setDepthRen a) $ picToFTree j pic
|
||||
picToFTree j (Color c pic) = FBranch (colorRen c) $ picToFTree j pic
|
||||
picToFTree j (Scale x y pic) = collapseBranch (scaleRen x y) $ picToFTree j pic
|
||||
picToFTree j (Translate x y pic) = collapseBranch (translateRen x y) $ picToFTree j pic
|
||||
picToFTree j (Rotate a pic) = collapseBranch (rotateRen a) $ picToFTree j pic
|
||||
picToFTree j (SetDepth a pic) = collapseBranch (setDepthRen a) $ picToFTree j pic
|
||||
picToFTree j (Color c pic) = collapseBranch (colorRen c) $ picToFTree j pic
|
||||
picToFTree j (Pictures pics) = FBranches $ map (picToFTree j) pics
|
||||
|
||||
collapseBranch :: (RenderType -> RenderType) -> FTree RenderType -> FTree RenderType
|
||||
collapseBranch f (FBranch g t) = FBranch (f . g) t
|
||||
collapseBranch f (FBranches ts) = FBranches $ map (collapseBranch f) ts
|
||||
collapseBranch f t = FBranch f t
|
||||
|
||||
doubleLine :: [Point2] -> [Point2]
|
||||
doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)
|
||||
doubleLine _ = []
|
||||
@@ -276,6 +311,21 @@ renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
-- set common uniforms
|
||||
forM_ [_basicShader pdata
|
||||
,_textShader pdata
|
||||
,_circShader pdata
|
||||
,_arcShader pdata
|
||||
,_fadeCircleShader pdata
|
||||
,_backShader pdata
|
||||
,_wallShadowShader pdata
|
||||
] $ \shad -> do
|
||||
currentProgram $= Just (fst shad)
|
||||
uniform (snd shad !! 0) $= Vector2 winx winy
|
||||
uniform (snd shad !! 1) $= zoom
|
||||
uniform (snd shad !! 2) $= rot
|
||||
uniform (snd shad !! 3) $= Vector2 tranx trany
|
||||
|
||||
-- draw lightmap
|
||||
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
|
||||
let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
|
||||
@@ -289,97 +339,32 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
forM_ lightPoints $ \(x,y,r,lum) -> do
|
||||
cullFace $= Just Front
|
||||
clear [DepthBuffer]
|
||||
currentProgram $= Just (_wallShadowShader pdata)
|
||||
currentProgram $= Just (fst $ _wallShadowShader pdata)
|
||||
bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
|
||||
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
|
||||
uniform (_wssLightPos pdata) $= Vector2 (x) (y)
|
||||
blendFunc $= (Zero,One)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral $ length wallPoints)
|
||||
cullFace $= Nothing
|
||||
currentProgram $= Just (_fadeCircleShader pdata)
|
||||
currentProgram $= Just (fst $ _fadeCircleShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _fadeCircVAO pdata)
|
||||
let fadeCircPtr = (\(_,ptr,_) -> ptr) $ head $ _vaoBufferTargets $ _fadeCircVAO pdata
|
||||
pokeFourOff fadeCircPtr 0 (x,y,r,lum)
|
||||
bindArrayBuffers (1) $ _vaoBufferTargets $ _fadeCircVAO pdata
|
||||
uniform (_fcsWinUni pdata) $= Vector2 winx winy
|
||||
uniform (_fcsZoomUni pdata) $= zoom
|
||||
-- to refactor: put these uniforms in a ubo
|
||||
blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
-- draw picture
|
||||
-- set drawing for on top
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
clear [DepthBuffer]
|
||||
|
||||
-- draw layer 0
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) (picToFTree 0 pic)
|
||||
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) (picToList 0 pic)
|
||||
-- reset blend so that light map doesn't apply
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 1 pic
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToList 1 pic
|
||||
-- set drawing for on top
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToFTree 2 pic
|
||||
--
|
||||
---- poke necessary data
|
||||
-- (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
|
||||
---- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)
|
||||
-- <- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata)
|
||||
-- (threePtrsVAO $ _textVAO pdata)
|
||||
-- (threePtrsVAO $ _circVAO pdata)
|
||||
-- (twoPtrsVAO $ _lineVAO pdata)
|
||||
-- (threePtrsVAO $ _arcVAO pdata)
|
||||
-- ) $ (picToFTree 0 pic)
|
||||
--
|
||||
-- depthFunc $= Just Less
|
||||
--
|
||||
-- currentProgram $= Just (_backShader pdata)
|
||||
-- bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
|
||||
-- let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
|
||||
-- backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
|
||||
-- pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
|
||||
-- pokeTwoOff backPtr2 0 (winx,winy)
|
||||
-- bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
|
||||
-- textureBinding Texture2D $= Just (_textures pdata !! 1)
|
||||
-- drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
--
|
||||
---- draw triangles
|
||||
-- currentProgram $= Just (_basicShader pdata)
|
||||
-- bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
|
||||
-- bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
|
||||
-- drawArrays Triangles 0 (fromIntegral $ nTriVs)
|
||||
---- draw circles
|
||||
-- currentProgram $= Just (_circShader pdata)
|
||||
-- uniform (_uniWinSize pdata) $= Vector2 winx winy
|
||||
-- uniform (_csZoomUni pdata) $= zoom
|
||||
-- bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
|
||||
-- bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
|
||||
-- drawArrays Points 0 (fromIntegral $ numCircVs)
|
||||
---- draw arcs
|
||||
-- currentProgram $= Just (_arcShader pdata)
|
||||
-- uniform (_asWinUni pdata) $= Vector2 winx winy
|
||||
-- uniform (_asZoomUni pdata) $= zoom
|
||||
-- bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
|
||||
-- bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
|
||||
-- drawArrays Points 0 (fromIntegral $ nArcVs)
|
||||
--
|
||||
---- reset blend so that light map doesn't apply
|
||||
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
--
|
||||
---- draw lines
|
||||
-- currentProgram $= Just (_basicShader pdata)
|
||||
-- bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
|
||||
-- bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata
|
||||
-- drawArrays Lines 0 (fromIntegral $ nLineVs)
|
||||
---- draw text
|
||||
-- currentProgram $= Just (_textShader pdata)
|
||||
-- bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
|
||||
-- bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
|
||||
-- textureBinding Texture2D $= Just (_textures pdata !! 0)
|
||||
-- drawArrays Points 0 (fromIntegral $ nTextVs)
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) $ picToList 2 pic
|
||||
|
||||
|
||||
bufferOffset :: Integral a => a -> Ptr b
|
||||
@@ -388,8 +373,9 @@ bufferOffset = plusPtr nullPtr . fromIntegral
|
||||
|
||||
-- the following code draws a picture tree
|
||||
-- it does not set nor change the blend function or depth buffer
|
||||
renderTree :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
-> FTree RenderType -> IO ()
|
||||
-- nor does it set uniforms
|
||||
renderTree :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
-> f RenderType -> IO ()
|
||||
renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
|
||||
-- poke necessary data
|
||||
@@ -404,7 +390,7 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
|
||||
depthFunc $= Just Less
|
||||
|
||||
currentProgram $= Just (_backShader pdata)
|
||||
currentProgram $= Just (fst $ _backShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
|
||||
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
|
||||
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
|
||||
@@ -415,37 +401,29 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
-- draw triangles
|
||||
currentProgram $= Just (_basicShader pdata)
|
||||
currentProgram $= Just (fst $ _basicShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
|
||||
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
|
||||
drawArrays Triangles 0 (fromIntegral $ nTriVs)
|
||||
-- draw circles
|
||||
currentProgram $= Just (_circShader pdata)
|
||||
uniform (_uniWinSize pdata) $= Vector2 winx winy
|
||||
uniform (_csZoomUni pdata) $= zoom
|
||||
currentProgram $= Just (fst $ _circShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
|
||||
bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
|
||||
drawArrays Points 0 (fromIntegral $ numCircVs)
|
||||
-- draw arcs
|
||||
currentProgram $= Just (_arcShader pdata)
|
||||
uniform (_asWinUni pdata) $= Vector2 winx winy
|
||||
uniform (_asZoomUni pdata) $= zoom
|
||||
-- assumes that the uniforms are set
|
||||
currentProgram $= Just (fst $ _arcShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
|
||||
bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
|
||||
drawArrays Points 0 (fromIntegral $ nArcVs)
|
||||
|
||||
-- reset blend so that light map doesn't apply
|
||||
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
|
||||
-- draw lines
|
||||
currentProgram $= Just (_basicShader pdata)
|
||||
currentProgram $= Just (fst $ _basicShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
|
||||
bindArrayBuffers nLineVs $ _vaoBufferTargets $ _lineVAO pdata
|
||||
drawArrays Lines 0 (fromIntegral $ nLineVs)
|
||||
-- draw text
|
||||
currentProgram $= Just (_textShader pdata)
|
||||
currentProgram $= Just (fst $ _textShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
|
||||
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
|
||||
textureBinding Texture2D $= Just (_textures pdata !! 0)
|
||||
|
||||
Reference in New Issue
Block a user