Fix autodoor wall rendering

This commit is contained in:
2021-03-21 13:10:07 +01:00
parent 4dc1f8e6bf
commit 19fa3c1667
4 changed files with 16 additions and 44 deletions
-1
View File
@@ -553,7 +553,6 @@ data Wall
, _wlDraw :: Maybe (Wall -> Drawing) , _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool , _wlSeen :: Bool
, _wlIsSeeThrough :: Bool , _wlIsSeeThrough :: Bool
, _wlCastShadow :: Bool
} }
| Door | Door
{ _wlLine :: [Point2] , _wlID :: Int { _wlLine :: [Point2] , _wlID :: Int
+10 -27
View File
@@ -24,15 +24,15 @@ autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
is = [i..] is = [i..]
mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall] mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr]) mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
xs xs
[ True -- [ True
, False -- , False
, True -- , True
, True -- , True
, False -- , False
, True -- , True
] -- ]
[ [pld,hwd,hw,pl] [ [pld,hwd,hw,pl]
, [hwd,hwu] , [hwd,hwu]
, [hwu,plu,pl,hw] , [hwu,plu,pl,hw]
@@ -68,24 +68,8 @@ mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
| otherwise = dm w | otherwise = dm w
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1 where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
drawAutoDoor :: Wall -> Drawing autoDoorPane :: [Point2] -> Int -> [Point2] -> [Point2] -> Wall
drawAutoDoor wl = onLayerL [levLayer WlLayer, layer2] autoDoorPane trigL n closedPos openPos = AutoDoor
$ pictures [color c $ polygon [x,x +.+ n2,y +.+ n2, y]
,color (dark c) $ line [x,y]
]
where
(x:y:_) = _wlLine wl
c = _wlColor wl
nm = errorNormalizeV 543 (y -.- x)
t = 5 *.* nm
n = vNormal t
n2 = 3 *.* n
layer2 | _wlIsSeeThrough wl = 0
| isJust $ wl ^? doorMech = 1
| otherwise = 2
autoDoorPane :: [Point2] -> Int -> Bool -> [Point2] -> [Point2] -> Wall
autoDoorPane trigL n castShad closedPos openPos = AutoDoor
{ _wlLine = closedPos { _wlLine = closedPos
, _wlID = n , _wlID = n
, _doorMech = dm , _doorMech = dm
@@ -93,7 +77,6 @@ autoDoorPane trigL n castShad closedPos openPos = AutoDoor
, _wlDraw = Nothing , _wlDraw = Nothing
, _wlSeen = False , _wlSeen = False
, _wlIsSeeThrough = False , _wlIsSeeThrough = False
, _wlCastShadow = castShad
} }
where where
a = closedPos !! 0 a = closedPos !! 0
-1
View File
@@ -35,7 +35,6 @@ basicAutoDoor = AutoDoor { _wlLine = [(0,0),(50,0)]
, _wlDraw = Nothing , _wlDraw = Nothing
, _wlSeen = False , _wlSeen = False
, _wlIsSeeThrough = False , _wlIsSeeThrough = False
, _wlCastShadow = True
} }
basicDoor = Door { _wlLine = [(0,0),(50,0)] basicDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlID = 0 , _wlID = 0
+6 -15
View File
@@ -7,15 +7,13 @@ module Picture.Preload
where where
import Picture.Data import Picture.Data
import Shader
import Geometry (Point2,Point3,Point4)
import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth) import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
import Control.Lens import Control.Lens
import Foreign import Foreign
import Shader
import Geometry (Point2,Point3,Point4)
import qualified Control.Foldl as F import qualified Control.Foldl as F
@@ -34,7 +32,6 @@ makeLenses ''RenderData
preloadRender :: IO RenderData preloadRender :: IO RenderData
preloadRender = do preloadRender = do
-- compile shader programs
-- lighting shaders -- lighting shaders
lsShad <- makeShader "lighting/lightmapCircle" [vert,geom,frag] [(0,4)] Points lsShad <- makeShader "lighting/lightmapCircle" [vert,geom,frag] [(0,4)] Points
(return . return . flat4) (return . return . flat4)
@@ -63,17 +60,16 @@ preloadRender = do
,[[ 1,-1],[1,0]] ,[[ 1,-1],[1,0]]
] ]
) )
n <- F.foldM (pokeShader fsShad) [()] n <- F.foldM (pokeShader fsShad) [()] -- fix fullscreen vertex positions now
-- background shader -- background shader
bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
"data/texture/smudgedDirt.png" "data/texture/smudgedDirt.png"
-- input a list of (attribute location, attrib length) pairs
-- these will have buffers and pointers created
backgroundvao <- setupVAO [(0,4),(1,2)]
-- framebuffer for lighting
(fbo,fboTO) <- setupFramebuffer (fbo,fboTO) <- setupFramebuffer
-- reset to default framebuffer, ready for drawing direct to screen
bindFramebuffer Framebuffer $= defaultFramebufferObject bindFramebuffer Framebuffer $= defaultFramebufferObject
return $ RenderData return $ RenderData
@@ -119,6 +115,7 @@ cleanUpRenderPreload pd = do
freeShaderPointers $ _lightSourceShader pd freeShaderPointers $ _lightSourceShader pd
freeShaderPointers $ _wallShadowShader pd freeShaderPointers $ _wallShadowShader pd
freeShaderPointers $ _backgroundShader pd freeShaderPointers $ _backgroundShader pd
freeShaderPointers $ _fullscreenShader pd
{-# INLINE pokeBezQStrat #-} {-# INLINE pokeBezQStrat #-}
pokeBezQStrat :: RenderType -> [[[Float]]] pokeBezQStrat :: RenderType -> [[[Float]]]
@@ -144,9 +141,6 @@ pokeLineStrat _ = []
pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
pokeEllStrat _ = [] pokeEllStrat _ = []
bufferOffset :: Integral a => a -> Ptr b
bufferOffset = plusPtr nullPtr . fromIntegral
vert = VertexShader vert = VertexShader
geom = GeometryShader geom = GeometryShader
frag = FragmentShader frag = FragmentShader
@@ -154,9 +148,6 @@ frag = FragmentShader
pokeWPStrat :: (Point2,Point2) -> [[[Float]]] pokeWPStrat :: (Point2,Point2) -> [[[Float]]]
pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]] pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]]
pokeLightWallStrat :: Point3 -> [[[Float]]]
pokeLightWallStrat (x,y,z) = [[[x,y,z]]]
pokeBGStrat :: a -> [[[Float]]] pokeBGStrat :: a -> [[[Float]]]
pokeBGStrat = const [] pokeBGStrat = const []