Unify matrix uniform assignment, move towards uniform block

2021-06-24 14:38:17 +02:00
parent 2625927f14
commit d534f08064
19 changed files with 70 additions and 91 deletions
@@ -86,7 +86,7 @@ data Picture
    | Line Int [Point2]
    | LineCol Int [(Point2,RGBA)]
    | Pictures [Picture]
-    | OverPic (Point3 -> Point3) Float (Point4 -> Point4) Picture
+    | OverPic (Point3 -> Point3) (Point4 -> Point4) Picture
    | OnLayer Int Picture

 blank :: Picture
@@ -27,9 +27,8 @@ setWallDepth
    :: RenderData
    -> [(Point2,Point2)]    -- ^ Wall points
    -> (Float,Float)        -- ^ View from point
-    -> GLmatrix GLfloat
    -> IO Word32
-setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do
+setWallDepth pdata wallPoints (viewFromx,viewFromy) = do
    startTicks <- SDL.ticks
    colorMask $= Color4 Disabled Disabled Disabled Disabled
    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
@@ -62,10 +61,9 @@ createLightMap
    -> [(Point2,Point2)]    -- Wall pairs
    -> [Point4]             -- Lights
    -> (Float,Float)        -- View from position
-    -> GLmatrix GLfloat     -- perspective matrix
    -> Picture              -- foreground pictures
    -> IO ()
-createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _ = do
+createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) _ = do

 -- get viewport size so we can reset it later
    (vppos,vpsize) <- get viewport
@@ -79,9 +77,9 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
    bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 -- set uniforms for shader that draws lights
-    currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
-    uniform (_shaderMatrixUniform $ _lightingWallShader pdata)
-            $= pmat
+--    currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
+--    uniform (_shaderMatrixUniform $ _lightingWallShader pdata)
+--            $= pmat
 -- clear buffer to full alpha and furthest depth
    clearColor $= Color4 0 0 0 1
    clearDepth $= 1
@@ -92,7 +90,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
    currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
    uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
            $= Vector2 viewFromx viewFromy  
-    uniform (_shaderMatrixUniform $ _lightingOccludeShader pdata) $= pmat
+--    uniform (_shaderMatrixUniform $ _lightingOccludeShader pdata) $= pmat
    cullFace $= Just Back
    drawShader (_lightingOccludeShader pdata) nWalls

@@ -215,12 +213,16 @@ setPerpMatrixUniforms
    -> (Float,Float)    -- ^ ViewFrom
    -> IO ()
 setPerpMatrixUniforms pdata rot czoom trans wins vfs = mapM_ (setPerpMatUniform rot czoom trans wins vfs)
-    $ ( (_lightingFloorShader pdata) 
-        : (_backgroundShader pdata) 
-        : (_textureShader pdata)
-        : (_textureArrayShader pdata)
-        : (_pictureShaders pdata)
-        )
+    ( _lightingFloorShader pdata
+    : _lightingWallShader pdata
+    : _lightingOccludeShader pdata
+    : _backgroundShader pdata
+    : _textureShader pdata
+    : _textureArrayShader pdata
+    : _wallBlankShader pdata
+    : _wallTextureShader pdata
+    : _pictureShaders pdata
+    )

 renderShader
    :: Foldable f
@@ -30,7 +30,6 @@ picToLTree mx (BezierQuad i vs) = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map ze
  where 
    (ps,cols,offps,rads) = unzip4 vs
    rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
-                                      
 picToLTree mx (Circle i colC colE r) = filtB mx i $ LLeaf $ RenderEllipse 
    [( (-r, r,0), colC)
    ,( (-r,-r,0), colE)
@@ -53,24 +52,21 @@ picToLTree mx (Line i ps)
 picToLTree mx (LineCol i vs) 
    = filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
  where (ps,cs) = unzip vs
-picToLTree mx (Text i s) 
-    = filtB mx i $ LLeaf $ RenderText $ stringToList s
+picToLTree mx (Text i s) = filtB mx i $ LLeaf $ RenderText $ stringToList s
 picToLTree _ Blank = LBranches []
 picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
-picToLTree j (OverPic f r f'' (OverPic g s g'' pic)) 
-    = picToLTree j $ OverPic (f . g) (r + s) (f'' . g'') pic
-picToLTree j (OverPic f r f'' (Pictures ps)) 
-    = LBranches (map (picToLTree j . OverPic f r f'') ps)
-picToLTree j (OverPic f r f'' pic) 
-    = overPos f . overRot r . overCol f'' <$> picToLTree j pic
+picToLTree j (OverPic f f' (OverPic g g' pic)) = picToLTree j $ OverPic (f . g) (f' . g') pic
+picToLTree j (OverPic f f' (Pictures ps)) = LBranches (map (picToLTree j . OverPic f f') ps)
+picToLTree j (OverPic f f' pic) = overPos f . overCol f' <$> picToLTree j pic
 picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic
                                    | otherwise = LBranches []
 picToLTree Nothing  (OnLayer _ pic) = picToLTree Nothing pic

 filtB :: Maybe Int -> Int -> LTree RenderType -> LTree RenderType
 {-# INLINE filtB #-}
-filtB mx i t | Just i == mx || isNothing mx = t
-             | otherwise                     = LBranches []
+filtB mx i t 
+    | Just i == mx || isNothing mx = t
+    | otherwise                    = LBranches []

 doubleLine :: [a] -> [a]
 {-# INLINE doubleLine #-}
@@ -91,10 +87,6 @@ overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
 overPos f (RenderArc vs)  = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs
 overPos _ _ = undefined

-overRot :: Float -> RenderType -> RenderType
-{-# INLINE overRot #-}
-overRot _ ren = ren
-
 overCol :: (Point4 -> Point4) -> RenderType -> RenderType
 {-# INLINE overCol #-}
 overCol f (RenderPoly vs)     = RenderPoly    $ map (second f) vs
@@ -102,12 +94,12 @@ overCol f (RenderLine vs)     = RenderLine    $ map (second f) vs
 overCol f (RenderEllipse vs)  = RenderEllipse $ map (second f) vs
 overCol f (RenderText vs)     = RenderText    $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol f (RenderBezQ vs)     = RenderBezQ    $ map (\(a,b,c) -> (a,f b,c)) vs
-overCol f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (a,f b,c)) vs
+overCol f (RenderArc vs)      = RenderArc     $ map (\(a,b,c) -> (a,f b,c)) vs
 overCol _ _ = undefined

 stringToList :: String -> [(Point3,Point4,Point2)]
 {-# INLINE stringToList #-}
-stringToList s = concat $ zipWith (\x -> map (f x))
+stringToList s = concat $ zipWith (map . f)
    [0,0.9*dimText..]
    $ map charToTuple s
  where
@@ -133,12 +125,3 @@ charToTuple c =
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
 translate3 a b (x,y,z) = (x+a,y+b,z)
-{- Scale a 3D vector in the x and y directions. -}
--scale3 :: Float -> Float -> Point3 -> Point3
--{-# INLINE scale3 #-}
--scale3 a b (x,y,z) = (x*a,y*b,z)
--{- Rotate a 3D vector in the x-y plane. -}
--rotate3 :: Float -> Point3 -> Point3
--{-# INLINE rotate3 #-}
--rotate3 a (x,y,z) = (x',y',z)
--    where (x',y') = rotateV a (x,y)