justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fix arc rendering bug (make vertex attribs correct size)

Browse Source
This commit is contained in:
jgk
2021-03-12 01:22:10 +01:00
parent e8e3dd8f50
commit 9bdc6fddd7
21 changed files with 63 additions and 347 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rooms.hs
+1 -1
View File
@@ -546,7 +546,7 @@ deadEndRoom = Room
]
, _rmLinks = lnks
, _rmPath = []
, _rmPS = []
, _rmPS = [PS (0,-10) 0 basicLS]
, _rmBound = rectNSWE 20 (-20) (-30) 30
}
where lnks = [((0,30) ,0)
src/Dodge/Weapons.hs
+3 -3
View File
@@ -2194,15 +2194,15 @@ flameShield = basicEquipment
}
frontArmour = basicEquipment
{ _itIdentity = FrontArmour
, _itName = "FRONTARMOUR"
, _itName = "FARMOUR"
, _itMaxStack = 1
, _itAmount = 1
, _itFloorPict = onLayer FlItLayer $ translate 0 (-5)
$ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
$ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
]
, _itEquipPict = (\cr _ -> onLayer CrLayer
$ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
$ pictures [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
]
)
src/Picture/Preload.hs
+55 -50
View File
@@ -1,6 +1,10 @@
{-# LANGUAGE TemplateHaskell #-}
--{-# LANGUAGE Strict #-}
module Picture.Preload
( RenderData (..)
, preloadRender
, cleanUpRenderPreload
)
where
import Picture.Data
@@ -25,6 +29,57 @@ data RenderData = RenderData
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"
--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]
, _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 pokeTriStrat #-}
pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
pokeTriStrat _ = []
@@ -53,53 +108,3 @@ pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w],[a,b,c,d]]]
pokeBGStrat :: a -> [[[Float]]]
pokeBGStrat = const []
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,3)] 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"
--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]
, _dummyVBO = dummyvbo
, _dummyPtr = dummyptr
, _lightSourceShader = lsShad
, _wallShadowShader = wsShad
, _backgroundShader = bgShad
}
vaoPointers :: VAO -> [Ptr Float]
vaoPointers = (\(_,ps,_) -> ps) . unzip3 . _vaoBufferTargets
cleanUpRenderPreload :: RenderData -> IO ()
cleanUpRenderPreload pd = do
mapM_ freeShaderPointers $ _listShaders pd
freeShaderPointers $ _lightSourceShader pd
freeShaderPointers $ _wallShadowShader pd
freeShaderPointers $ _backgroundShader pd
free $ _dummyPtr pd
src/Picture/Tree.hs
-26
View File
@@ -57,14 +57,6 @@ polyToTris :: [s] -> [s]
polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
polyToTris _ = []
tripFirst :: (a -> a') -> (a,b,c) -> (a',b,c)
{-# INLINE tripFirst #-}
tripFirst f (x,y,z) = (f x,y,z)
tripSecond :: (b -> b') -> (a,b,c) -> (a,b',c)
{-# INLINE tripSecond #-}
tripSecond f (x,y,z) = (x,f y,z)
scaleT :: (Float,Float) -> (Point3,Point4,Point3) -> (Point3,Point4,Point3)
{-# INLINE scaleT #-}
scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y))
@@ -95,24 +87,6 @@ overSca :: (Point2 -> Point2) -> RenderType -> RenderType
overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,1))) vs
overSca f p = p
scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType
{-# INLINE scaleRen #-}
scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT (x,y)) vs
scaleRen x y rt = overPos (scale3 x y) rt
{-# INLINE translateRen #-}
translateRen x y = overPos $ translate3 x y
rotateRen,setDepthRen :: Float -> RenderType -> RenderType
{-# INLINE rotateRen #-}
rotateRen a (RenderArc (p,c,(as,ae,r,w))) = overPos (rotate3 a) $ RenderArc (p,c,(f as,f ae,r,w))
--where f b = normalizeAngle $ a + b
where f b = a + b
rotateRen a pic = overPos (rotate3 a) pic
{-# INLINE setDepthRen #-}
setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d)
{-# INLINE colorRen #-}
colorRen :: RGBA -> RenderType -> RenderType
colorRen c = overCol $ const c
stringToList :: String -> [(Point3,Point4,Point3)]
{-# INLINE stringToList #-}
stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c))