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

Unify matrix uniform assignment, move towards uniform block

Browse Source
This commit is contained in:
jgk
2021-06-24 14:38:17 +02:00
parent 2625927f14
commit d534f08064
19 changed files with 70 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+2 -2
View File
@@ -142,8 +142,8 @@ startCr :: Creature
startCr = defaultCreature
{ _crPos = (0,0)
, _crOldPos = (0,0)
, _crDir = (pi/2)
, _crMvDir = (pi/2)
, _crDir = pi/2
, _crMvDir = pi/2
, _crID = 0
, _crPict = basicCrPict black
, _crUpdate = stateUpdate yourControl
src/Dodge/Event.hs
+1 -1
View File
@@ -114,7 +114,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
moveYourAmmoSel :: Int -> World -> World
moveYourAmmoSel i w = case yourItem w ^? wpAmmo . amPjParams of
Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
. wpAmmo . amParamSel %~ (`mod` (length l)) . subtract i
. wpAmmo . amParamSel %~ (`mod` length l) . subtract i
_ -> w
moveYourAmmoParam :: Int -> World -> World
moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pjMaxParam of
src/Dodge/Item/Weapon.hs
+2 -2
View File
@@ -830,7 +830,7 @@ explodeRemoteRocket
-> World
explodeRemoteRocket itid pjid w
= set (projectiles . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (projectiles . ix pjid . pjDraw) (const blank)
$ set (itPoint . itUse) (\_ _ -> id)
$ resetName
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
@@ -850,7 +850,7 @@ throwRemoteBomb cr w = setLocation
{ _pjPos = p
, _pjStartPos = p
, _pjVel = v
, _pjDraw = \_ -> blank
, _pjDraw = const blank
, _pjID = i
, _pjUpdate = \_ -> moveRemoteBomb itid 50 i
}
src/Dodge/Item/Weapon/Booster.hs
+1 -1
View File
@@ -97,7 +97,7 @@ drawBoostShockwave pj = setLayer 1 $ onLayer UPtLayer $ pictures $
r <- safeHead xs
return $ color (snd $ last lpairs) $ uncurry translate hp
$ arc (argV hv - pi/2) (argV hv + pi/2) $ r * magV hv
cols = map (flip withAlpha white) [0,0.05..]
cols = map (`withAlpha` white) [0,0.05..]
lpairs = zip (reverse lps) cols
pvs = _pjPoints pj
t = _pjTimer pj
src/Dodge/Layout.hs
+1 -1
View File
@@ -38,7 +38,7 @@ generateLevelFromRoomList gr w = updateWallZoning
where
plmnts = concatMap _rmPS rs
rs = zipWith addTile zs rs'
zs = map fromIntegral $ randomRs (0,(63::Int)) $ _randGen w
zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
rs' = evalState gr $ _randGen w
-- | connects a collection (tree) of rooms together
src/Dodge/LevelGen.hs
+1 -1
View File
@@ -81,7 +81,7 @@ placeSpot ps w = case _psType ps of
PutDoubleDoor col f a b -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PutAutoDoor a b -> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PutBlock (hp:hps) col ps' -> putBlock (map (shiftPointBy (p,rot)) ps') hp col False hps w
PutBlock _ _ _ -> error "messed up block placement somehow"
PutBlock{} -> error "messed up block placement somehow"
PutBtDoor c bp f a b -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot)
(shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
PutSwitchDoor c bp f a b -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot)
src/Dodge/Render.hs
+9 -14
View File
@@ -21,7 +21,7 @@ import Picture.Tree
import Shader
import Shader.Data
import Shader.Poke
import MatrixHelper
--import MatrixHelper
import Foreign (Word32)
--import Control.Applicative
@@ -59,10 +59,8 @@ doDrawing pdata w = do
--setIsoMatrixUniforms pdata rot camzoom trans wins
setPerpMatrixUniforms pdata rot camzoom trans wins viewFroms
depthFunc $= Just Less
pmat <- (newMatrix RowMajor $ perspectiveMatrix rot camzoom trans wins viewFroms)
:: IO (GLmatrix GLfloat)
-- draw the lightmap. Probably changes the bound framebufferObject
createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms pmat
createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms
(foregroundPics w)
-- -- set the coordinate uniforms ready for drawing elements using world coordinates
@@ -78,11 +76,11 @@ doDrawing pdata w = do
-- draw the walls
depthFunc $= Just Less
if w ^. config . wall_textured
then renderTextureWalls pdata wallPointsCol pmat
else renderBlankWalls pdata wallPointsCol pmat
then renderTextureWalls pdata wallPointsCol
else renderBlankWalls pdata wallPointsCol
-- I believe a more apt name would be setCeilingDepth: stops drawing of objects
-- at points that are behind the extension of walls to the screen edge
_ <- setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
_ <- setWallDepth pdata wallPoints (viewFromx,viewFromy)
-- draw the first layer of pictures
-- these will probably all be opaque
_ <- renderFoldable pdata $ picToLTree (Just 0) pic
@@ -99,7 +97,7 @@ doDrawing pdata w = do
depthMask $= Disabled
-- render transparent walls
-- the ordering between these and transparent clouds perhaps presents a challenge
renderBlankWalls pdata windowPoints pmat
renderBlankWalls pdata windowPoints
depthMask $= Enabled
forM_ (_pictureShaders pdata) $ setPerpMatUniform rot camzoom trans wins viewFroms
@@ -138,13 +136,12 @@ doDrawing pdata w = do
renderBlankWalls
:: RenderData
-> [((Point2,Point2),Point4)] -- ^ List: wall positions and color
-> GLmatrix GLfloat
-- -> GLmatrix GLfloat
-> IO ()
renderBlankWalls pdata wps pmat = do
renderBlankWalls pdata wps = do
n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
bindShaderBuffers [_wallBlankShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat
cullFace $= Just Back
drawShader (_wallBlankShader pdata) n
cullFace $= Nothing
@@ -152,13 +149,11 @@ renderBlankWalls pdata wps pmat = do
renderTextureWalls
:: RenderData
-> [((Point2,Point2),Point4)] -- ^ List: wall positions and color
-> GLmatrix GLfloat
-> IO ()
renderTextureWalls pdata wps pmat = do
renderTextureWalls pdata wps = do
n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps)
bindShaderBuffers [_wallTextureShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat
cullFace $= Just Back
drawShader (_wallTextureShader pdata) n
cullFace $= Nothing
src/Dodge/Room/Foreground.hs
+10 -10
View File
@@ -16,9 +16,9 @@ highDiagonalMesh
-> Float -- ^ vertical distance between lines
-> Picture
highDiagonalMesh pa pb w d = setDepth (-0.2) $ pictures $
(map (flip thickLine 3 . flat2) $ diagonalLinesRect pb pa w d (3*pi/4))
map (flip thickLine 3 . flat2) (diagonalLinesRect pb pa w d (3*pi/4))
++
(map (flip thickLine 3 . flat2) $ diagonalLinesRect pb pc (negate h) d (pi/4))
map (flip thickLine 3 . flat2) (diagonalLinesRect pb pc (negate h) d (pi/4))
where
pc = pb +.+ w *.* normalizeV (vNormal (pb -.- pa))
h = dist pa pb
@@ -42,7 +42,7 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
,intersectSegLine' pa pax p (p +.+ diVec)
,intersectSegLine' pb pbx p (p +.+ diVec)
]
yN = d * 0.5 *.* (normalizeV $ pa -.- pb)
yN = d * 0.5 *.* normalizeV (pa -.- pb)
highPipe :: Point2 -> Point2 -> Picture
highPipe x y = pictures
@@ -60,7 +60,7 @@ girderZ w x y = setDepth (-0.1) $ color red $ pictures $
]
++ map (flip thickLine 3 . flat2) ls
where
n = w *.* (normalizeV $ vNormal $ y -.- x)
n = w *.* normalizeV (vNormal $ y -.- x)
xb = x +.+ n
yb = y +.+ n
xt = x -.- n
@@ -77,27 +77,27 @@ girderV col w x y = setDepth (-0.1) $ color col $ pictures $
++ map (flip thickLine 3 . flat2) as'
++ map (flip thickLine 3 . flat2) bs'
where
n = w *.* (normalizeV $ vNormal $ y -.- x)
n = w *.* normalizeV (vNormal $ y -.- x)
xb = x +.+ n
yb = y +.+ n
xt = x -.- n
yt = y -.- n
ps = divideLineExact (w*2) xb yb
(as,_) = evenOddSplit ps
f a = map (\p -> intersectSegLine' xt yt p (p +.+ (rotateV a n)))
f a = map (\p -> intersectSegLine' xt yt p (p +.+ rotateV a n))
as' = catMaybes $ zipWith (fmap . (,)) as $ f (pi/4) as
bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
girder :: Color -> Float -> Point2 -> Point2 -> Picture
girder col w x y = pictures $
[ setDepth (-0.1) $ color col $ pictures $
(setDepth (-0.1) $ color col $ pictures $
[ thickLine [xt,yt] 3
, thickLine [xb,yb] 3
]
++ map (flip thickLine 3 . flat2) ls
]
++ map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
)
: map (\p -> verticalPipe 1.5 col p 0 (-0.1)) [xb,xt,yb,yt]
where
n = w *.* (normalizeV $ vNormal $ y -.- x)
n = w *.* normalizeV (vNormal $ y -.- x)
xb = x +.+ n
yb = y +.+ n
xt = x -.- n
src/Dodge/WorldEvent/Cloud.hs
+1 -1
View File
@@ -39,7 +39,7 @@ makeThinSmokeAt = makeCloudAt 5 400 (drawCloudWith 4 400 (withAlpha 0.05 black))
makeStartCloudAt :: Point2 -> World -> World
--makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
makeStartCloudAt = makeCloudAt 10 400 (drawCloudWith (2) 800 white)
makeStartCloudAt = makeCloudAt 10 400 (drawCloudWith 2 800 white)
makeSmokeCloudAt :: Point2 -> World -> World
--makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
src/Dodge/WorldEvent/Explosion.hs
+1 -1
View File
@@ -37,7 +37,7 @@ makeTeslaExplosionAt
:: Point2 -- ^ Position
-> World
-> World
makeTeslaExplosionAt pos w = undefined pos w
makeTeslaExplosionAt = undefined
-- soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
-- where
-- xs = randomRs (0, 2*pi) $ _randGen w