Reorganise shaders

src/Dodge/Rendering.hs

@@ -71,9 +71,7 @@ worldPictures w
                         , afterPtPicts'
                         , wlPicts'
                         , wlPicts
---                        , wallShadows
                         , smokeShadows
---                        , itLabels
                         , ppLabels
                         , btLabels
                         , testPic w
@@ -87,11 +85,10 @@ worldPictures w
           ppPicts       = map ppDraw (IM.elems (_pressPlates w))
           crPicts       = map crDraw $ IM.elems $ _creatures w
           clPicts       = map clDraw $ IM.elems $ _clouds w
-          wallShadows   = map (drawWallShadow w) $ wallShadowsToDraw w
           smokeShadows  = map (drawSmokeShadow w) $ _smoke w
-          wlPicts       = map drawWall (wallsToDraw w)
+          wlPicts       = map drawWallFloor (wallFloorsToDraw w)
-          wlPicts'      = map (drawWall' w) (wallsToDraw w)
+          wlPicts'      = map (drawWall w) (wallShadowsToDraw w)
-          itFloorPicts  = map (drawItem) (IM.elems (_floorItems w))
+          itFloorPicts  = map drawItem (IM.elems (_floorItems w))
           yourPos = _crPos $ you w
           yourRot = _crDir $ you w
           yourRad = _crRad $ you w
@@ -199,8 +196,8 @@ mapWall wl =
           (x:y:_) = _wlLine wl
           c = _wlColor wl
 
-wallsToDraw :: World -> [Wall]
+wallFloorsToDraw :: World -> [Wall]
-wallsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
+wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
     where onScreen wall = lineOnScreen w (_wlLine wall)
           isVisible wl | wl ^? blVisible == Just False = False
                        | otherwise = onScreen wl
@@ -245,11 +242,10 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
         trap' p' = line [pa' p', pb' p', pbo' p', pao' p',pa' p']
         semiCirc' p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r'
         
-drawWall :: Wall -> Drawing
+drawWallFloor :: Wall -> Drawing
-drawWall (Wall {_wlIsSeeThrough = False, _wlLine = ps, _wlColor = c}) 
+drawWallFloor (Wall {_wlIsSeeThrough = False, _wlLine = ps, _wlColor = c}) 
         = onLayerL [levLayer WlLayer, 2] $ color c $ polygon $ ps
-drawWall wl = case _wlDraw wl of
+drawWallFloor wl = case _wlDraw wl of
---        Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon $ _wlLine wl
         Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon [x,x +.+ n2,y +.+ n2, y]
         Just d -> d wl
     where 
@@ -261,7 +257,6 @@ drawWall wl = case _wlDraw wl of
         layer2 | _wlIsSeeThrough wl = 0
                | isJust $ wl ^? doorMech = 1
                | otherwise = 2
---          wallOrdering wl = (not $ _wlIsSeeThrough wl, not $ isJust $ wl ^? doorMech)
 
 errorNormalizeVDR :: Point2 -> Point2
 errorNormalizeVDR (0,0) = error $ "problem with function: errorNormalizeVDR in DodgeRendering"
@@ -312,8 +307,8 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
     where sp = screenPolygon w
           sps = zip sp (tail sp ++ [head sp])
 
-drawWall' :: World -> Wall -> Drawing
+drawWall :: World -> Wall -> Drawing
-drawWall' w wall
+drawWall w wall
     | isRHS sightFrom x y = blank
     | otherwise = colorAndLayer $ polygon $ points
     where 
@@ -341,33 +336,6 @@ drawWall' w wall
         wallBase | _wlIsSeeThrough wall = polygon $ _wlLine wall
                  | otherwise = blank
 
-drawWallShadow :: World -> Wall -> Drawing
-drawWallShadow w wall
-    | isRHS sightFrom x y = blank
-    | otherwise = colorAndLayer $ polygon $ points
-    where 
-        colorAndLayer | _wlIsSeeThrough wall = setLayer 2
-                                                . onLayerL [levLayer ShadowLayer] 
-                                                . color (withAlpha 0.2 $ _wlColor wall)
-                      | otherwise = setLayer 1 
-                                        . onLayerL [levLayer ShadowLayer,2]
-                                        . color black
-        (x:y:_) = _wlLine wall 
-        ps = linePointsBetween x y
-        ds = map (\p -> safeNormalizeV (p -.- sightFrom)) ps
-        p's = zipWith (\d x -> (15 *.* d) +.+ x) ds ps
-        sightFrom = _cameraCenter w
-        corns = screenPolygon w
-        borders = filter g $ zip corns (tail corns ++ [head corns])
-        g (a,b) = isLHS a b sightFrom
-        borderps = mapMaybe f borders ++ mapMaybe f' borders ++ shadowedCorners
-        coneTop = nub $ concatMap (\(a,b) -> [a,b]) $ borders
-        shadowedCorners = filter isShadowed coneTop
-        isShadowed p = isLHS sightFrom x p && isRHS sightFrom y p
-        f (bpa,bpb) = intersectSegLineFrom' bpa bpb x (head p's)
-        f' (bpa,bpb) = intersectSegLineFrom' bpa bpb y (last p's)
-        points = orderPolygon (borderps ++ p's)
-
 linePointsBetween :: Point2 -> Point2 -> [Point2]
 linePointsBetween p p' | d > 99 = map (\m -> p +.+ fromIntegral m *.* p'') [0..n-1] ++ [p']
                        | otherwise = [p,p']

src/Picture/Preload.hs

@@ -26,7 +26,7 @@ data RenderData = RenderData
     , _wallLightShader   :: FullShader (Point2,Point2)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader  :: FullShader ()
-    , _wallShader :: FullShader (Point3,Point4)
+--    , _wallShader :: FullShader (Point3,Point4)
     , _listShaders :: [FullShader RenderType]
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
@@ -39,32 +39,31 @@ makeLenses ''RenderData
 preloadRender :: IO RenderData
 preloadRender = do
 -- compile shader programs
-    lsShad <- makeShader "lightmapCircle" [vert,geom,frag] [(0,4)] Points (return . return . flat4)
+    lsShad <- makeShader "lighting/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)] Points pokeWPStrat
+    wsShad <- makeShaderCustomUnis "lighting/wallShadow" [vert,geom,frag] [(0,4)] Points pokeWPStrat
                 ["lightPos","perpMat","facesToDraw"]
 
     wlLightShad 
-         <- makeShaderCustomUnis "lightmapWall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
+         <- makeShaderCustomUnis "lighting/lightmapWall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
                     ["lightPos","perpMat","radLum"]
 
-    wlShad <- makeShader "wall" [vert,frag] [(0,3),(1,4)] TriangleStrip pokeWlStrat
+--    wlShad <- makeShader "wall" [vert,frag] [(0,3),(1,4)] TriangleStrip pokeWlStrat
 
-    bslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
+    bslist <- makeShader "twoD/basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
-    lslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
+    lslist <- makeShader "twoD/basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
-    aslist <- makeShader "arc"     [vert,geom,frag] [(0,3),(1,4),(2,4)] Points    pokeArcStrat
+    aslist <- makeShader "twoD/arc"     [vert,geom,frag] [(0,3),(1,4),(2,4)] Points    pokeArcStrat
-    eslist <- makeShader "ellipse" [vert,geom,frag] [(0,3),(1,4)]       Triangles pokeEllStrat
+    eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [(0,3),(1,4)]       Triangles pokeEllStrat
-    cslist <- makeTextureShader "character" [vert,geom,frag] 
+    bezierQuadShader <- makeShader 
+                      "twoD/bezierQuad" [vert,frag] [(0,3),(1,4),(2,4)]    TriangleStrip pokeBezQStrat
+    cslist <- makeTextureShader "twoD/character" [vert,geom,frag] 
                                 [(0,3),(1,4),(2,3)] Points pokeCharStrat
                                 "data/texture/charMap.png"
 
-    bezierQuadShader
-           <- makeShader "bezierQuad" [vert,frag] [(0,3),(1,4),(2,4)]    TriangleStrip pokeBezQStrat
-
     fsShad <- makeShader "fullscreen" [vert,frag] [(0,2),(1,2)] TriangleStrip 
                                 (const [[[-1, 1],[0,1]]
                                        ,[[ 1, 1],[1,1]]
@@ -97,7 +96,6 @@ preloadRender = do
         , _lightSourceShader = lsShad
         , _wallShadowShader  = wsShad
         , _wallLightShader   = wlLightShad
-        , _wallShader        = wlShad
         , _backgroundShader  = bgShad
         , _fullscreenShader  = fsShad
         , _spareFBO = fbo
@@ -150,9 +148,6 @@ pokeTriStrat :: RenderType -> [[[Float]]]
 pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
 pokeTriStrat _ = []
 
-pokeWlStrat :: (Point3,Point4) -> [[[Float]]]
-pokeWlStrat ((x,y,z),(r,g,b,a)) = [[[x,y,z],[r,g,b,a]]]
-
 pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs
 pokeCharStrat _ = []
 

src/Picture/Render.hs

@@ -48,7 +48,6 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
         ( (extractProgAndUnis $ _lightSourceShader pdata) 
         : (extractProgAndUnis $ _wallShadowShader pdata) 
         : (extractProgAndUnis $ _wallLightShader pdata) 
-        : (extractProgAndUnis $ _wallShader pdata) 
         : (extractProgAndUnis $ _backgroundShader pdata) 
         : (map extractProgAndUnis $ _listShaders pdata)
         )