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

Pass projectile object to draw function

Browse Source
This commit is contained in:
justin
2021-05-24 14:21:13 +02:00
parent a15d592951
commit 38682049c4
10 changed files with 36 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+3
View File
@@ -537,3 +537,6 @@ evenOddSplit :: [a] -> ([a],[a])
evenOddSplit = foldr f ([],[]) evenOddSplit = foldr f ([],[])
where where
f a (ls,rs) = (rs, a : ls) f a (ls,rs) = (rs, a : ls)
dbArg :: (a -> a -> b) -> a -> b
dbArg f x = f x x
src/Dodge/Data.hs
+2 -2
View File
@@ -384,7 +384,7 @@ data Projectile
{ _pjPos :: Point2 { _pjPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _pjPict :: Picture , _pjDraw :: Projectile -> Picture
, _pjID :: Int , _pjID :: Int
, _pjUpdate :: World -> World , _pjUpdate :: World -> World
} }
@@ -392,7 +392,7 @@ data Projectile
{ _pjPos :: Point2 { _pjPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _pjPict :: Picture , _pjDraw :: Projectile -> Picture
, _pjID :: Int , _pjID :: Int
, _pjUpdate :: World -> World , _pjUpdate :: World -> World
, _pjPayload :: Point2-> World -> World , _pjPayload :: Point2-> World -> World
src/Dodge/Debug.hs
+3 -3
View File
@@ -14,7 +14,7 @@ drawCircleAtFor p t w = w & projectiles %~
{ _pjPos = p { _pjPos = p
, _pjStartPos = p , _pjStartPos = p
, _pjVel = (0,0) , _pjVel = (0,0)
, _pjPict = onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20 , _pjDraw = \_ -> onLayer PtLayer $ uncurry translate p $ color white $ circleSolid 20
, _pjID = k , _pjID = k
, _pjUpdate = pjTimer t k , _pjUpdate = pjTimer t k
} }
@@ -26,7 +26,7 @@ drawCircleAtForCol p t col w = w & projectiles %~
{ _pjPos = p { _pjPos = p
, _pjStartPos = p , _pjStartPos = p
, _pjVel = (0,0) , _pjVel = (0,0)
, _pjPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20 , _pjDraw = \_ -> onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 20
, _pjID = k , _pjID = k
, _pjUpdate = pjTimer t k , _pjUpdate = pjTimer t k
} }
@@ -38,7 +38,7 @@ drawLineForCol ps t col w = w & projectiles %~
{ _pjPos = head ps { _pjPos = head ps
, _pjStartPos = head ps , _pjStartPos = head ps
, _pjVel = (0,0) , _pjVel = (0,0)
, _pjPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps , _pjDraw = \_ -> onLayer PtLayer $ color col $ lineOfThickness 5 ps
, _pjID = k , _pjID = k
, _pjUpdate = pjTimer t k , _pjUpdate = pjTimer t k
} }
src/Dodge/Default.hs
+1 -1
View File
@@ -206,7 +206,7 @@ defaultPT = Projectile
{ _pjPos = (0,0) { _pjPos = (0,0)
, _pjStartPos = (0,0) , _pjStartPos = (0,0)
, _pjVel = (0,0) , _pjVel = (0,0)
, _pjPict = blank , _pjDraw = \_ -> blank
, _pjID = 0 , _pjID = 0
, _pjUpdate = id , _pjUpdate = id
} }
src/Dodge/Item/Weapon.hs
+16 -16
View File
@@ -638,7 +638,7 @@ makeShellAt pl i cid pos dir = Shell
{ _pjPos = pos { _pjPos = pos
, _pjStartPos = pos , _pjStartPos = pos
, _pjVel = rotateV dir (1,0) , _pjVel = rotateV dir (1,0)
, _pjPict = blank , _pjDraw = \_ -> blank
, _pjID = i , _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (3,0)) , _pjUpdate = moveShell 50 i cid 0 (rotateV dir (3,0))
, _pjPayload = pl , _pjPayload = pl
@@ -656,21 +656,21 @@ moveShell time i cid rot accel w
then doExplode then doExplode
else w else w
& projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ piclow & projectiles . ix i . pjDraw .~ (\_ -> piclow)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel) & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot (rotateV rot accel)
| isJust thingHit = doExplode | isJust thingHit = doExplode
| time == 35 = w | time == 35 = w
& projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid spin accel & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid spin accel
| time >= 20 = w | time >= 20 = w
& projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel) & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel)
| time > -99 = w | time > -99 = w
& projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPos %~ (+.+ vel)
& randGen .~ g & randGen .~ g
& projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel) & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel)
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) & projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
@@ -678,7 +678,7 @@ moveShell time i cid rot accel w
& smokeGen & smokeGen
| time > -200 = w | time > -200 = w
& projectiles . ix i . pjPos %~ (+.+ vel) & projectiles . ix i . pjPos %~ (+.+ vel)
& projectiles . ix i . pjPict .~ pic & projectiles . ix i . pjDraw .~ (\_ -> pic)
& projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel) & projectiles . ix i . pjUpdate .~ moveShell (time-1) i cid rot' (rotateV rot accel)
| otherwise = doExplode | otherwise = doExplode
where where
@@ -828,8 +828,8 @@ moveRemoteBomb itid time pID w
f x | x < -369 = -10 f x | x < -369 = -10
| otherwise = x - 1 | otherwise = x - 1
updatePicture = updatePicture =
set (projectiles . ix pID.pjPict) set (projectiles . ix pID . pjDraw)
(onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) (\_ -> onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time)
. lowLightDirected . lowLightDirected
(withAlpha 0.1 red) (withAlpha 0.1 red)
newPos newPos
@@ -914,7 +914,7 @@ fireRemoteLauncher cr w = setLocation
{ _pjPos = pos { _pjPos = pos
, _pjStartPos = pos , _pjStartPos = pos
, _pjVel = rotateV dir (1,0) , _pjVel = rotateV dir (1,0)
, _pjPict = blank , _pjDraw = \_ -> blank
, _pjID = i , _pjID = i
, _pjUpdate = moveRemoteShell 50 i cid itid dir , _pjUpdate = moveRemoteShell 50 i cid itid dir
} }
@@ -936,7 +936,7 @@ moveRemoteShell time i cid itid _ w
| time > 40 = if circOnSomeWall oldPos 4 w | time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w then doExplosion w
else over (projectiles . ix i . pjPos) (+.+ vel) else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) piclow $ set (projectiles . ix i . pjDraw) (\_ -> piclow)
$ set (projectiles . ix i . pjUpdate) $ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir) (moveRemoteShell (time-1) i cid itid newdir)
$ setScope $ setScope
@@ -944,7 +944,7 @@ moveRemoteShell time i cid itid _ w
| time >= 20 = case thingHit of | time >= 20 = case thingHit of
Just _ -> doExplosion w Just _ -> doExplosion w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) $ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir) (moveRemoteShell (time-1) i cid itid newdir)
$ setScope $ setScope
@@ -955,7 +955,7 @@ moveRemoteShell time i cid itid _ w
w w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set randGen g $ set randGen g
$ set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir)
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
@@ -968,7 +968,7 @@ moveRemoteShell time i cid itid _ w
$ stopSoundFrom (ShellSound i) $ stopSoundFrom (ShellSound i)
w w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel) Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir)
$ setScope $ setScope
w w
@@ -1014,7 +1014,7 @@ explodeRemoteRocket
-> World -> World
explodeRemoteRocket itid pjid w explodeRemoteRocket itid pjid w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid) = set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank $ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (itPoint . itUse) (const id) $ set (itPoint . itUse) (const id)
$ resetName $ resetName
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
@@ -1034,7 +1034,7 @@ throwRemoteBomb cr w = setLocation
{ _pjPos = p { _pjPos = p
, _pjStartPos = p , _pjStartPos = p
, _pjVel = v , _pjVel = v
, _pjPict = blank , _pjDraw = \_ -> blank
, _pjID = i , _pjID = i
, _pjUpdate = moveRemoteBomb itid 50 i , _pjUpdate = moveRemoteBomb itid 50 i
} }
@@ -1062,7 +1062,7 @@ throwRemoteBomb cr w = setLocation
explodeRemoteBomb :: Int -> Int -> Creature -> World -> World explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid cr w explodeRemoteBomb itid pjid cr w
= set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid) = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
$ set (projectiles . ix pjid . pjPict) blank $ set (projectiles . ix pjid . pjDraw) (\_ -> blank)
$ set (creatures . ix cid . crInv . ix j . itUse) (const id) $ set (creatures . ix cid . crInv . ix j . itUse) (const id)
$ resetName $ resetName
$ resetPict $ resetPict
src/Dodge/Item/Weapon/Grenade.hs
+3 -3
View File
@@ -32,8 +32,8 @@ moveGrenade time dir pID w = case hitWl of
_ -> updatedWorld _ -> updatedWorld
where where
updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
$ set (projectiles .ix pID.pjPict) $ set (projectiles .ix pID. pjDraw)
(onLayer PtLayer $ uncurry translate newPos (\ _ -> onLayer PtLayer $ uncurry translate newPos
$ rotate dir $ grenadePic time) $ rotate dir $ grenadePic time)
$ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w $ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w
pj = _projectiles w IM.! pID pj = _projectiles w IM.! pID
@@ -67,7 +67,7 @@ throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
{ _pjPos = p { _pjPos = p
, _pjStartPos = p , _pjStartPos = p
, _pjVel = v , _pjVel = v
, _pjPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 , _pjDraw = \_ -> onLayer PtLayer $ uncurry translate p $ grenadePic 0
, _pjID = i , _pjID = i
, _pjUpdate = moveGrenade fuseTime dir i , _pjUpdate = moveGrenade fuseTime dir i
, _pjPayload = explosion , _pjPayload = explosion
src/Dodge/Item/Weapon/UseEffect.hs
+2 -2
View File
@@ -126,7 +126,7 @@ tractorBeamAt colID i pos dir = Projectile
{ _pjPos = pos { _pjPos = pos
, _pjStartPos = p' , _pjStartPos = p'
, _pjVel = d , _pjVel = d
, _pjPict = blank , _pjDraw = \_ -> blank
, _pjID = i , _pjID = i
, _pjUpdate = updateTractor colID 10 i , _pjUpdate = updateTractor colID 10 i
} }
@@ -139,7 +139,7 @@ The interaction of this with objects, walls etc needs more thought. -}
updateTractor :: Int -> Int -> Int -> World -> World updateTractor :: Int -> Int -> Int -> World -> World
updateTractor colID time i w updateTractor colID time i w
| time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i) | time > 0 = set (projectiles . ix i . pjUpdate) (updateTractor colID (time-1) i)
$ set (projectiles . ix i . pjPict) pic $ set (projectiles . ix i . pjDraw) (\_ -> pic)
$ over creatures (IM.map tractCr) $ over creatures (IM.map tractCr)
$ over floorItems (IM.map tractFlIt) $ over floorItems (IM.map tractFlIt)
w w
src/Dodge/Render/Picture.hs
+2 -2
View File
@@ -16,13 +16,13 @@ import qualified Data.IntMap.Strict as IM
worldPictures :: World -> Picture worldPictures :: World -> Picture
worldPictures w = pictures $ concat worldPictures w = pictures $ concat
[ IM.elems $ _decorations w [ IM.elems $ _decorations w
, map _pjPict . IM.elems $ _projectiles w , map (dbArg _pjDraw) . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems w , map drawItem . IM.elems $ _floorItems w
, map crDraw . IM.elems $ _creatures w , map crDraw . IM.elems $ _creatures w
, map clDraw . reverse . IM.elems $ _clouds w , map clDraw . reverse . IM.elems $ _clouds w
, map ppDraw . IM.elems $ _pressPlates w , map ppDraw . IM.elems $ _pressPlates w
, map btDraw (IM.elems (_buttons w)) , map btDraw (IM.elems (_buttons w))
, map (\pt -> _ptDraw pt pt) $ _particles w , map (dbArg _ptDraw) $ _particles w
, map drawWallFloor (wallFloorsToDraw w) , map drawWallFloor (wallFloorsToDraw w)
, testPic w , testPic w
] ]
src/Dodge/Update.hs
+2 -3
View File
@@ -42,7 +42,7 @@ For most menus the only way to change the world is using event handling. -}
update' :: World -> World update' :: World -> World
update' w = case _menuLayers w of update' w = case _menuLayers w of
(WaitMessage s i: _) (WaitMessage s i: _)
| i < 1 -> w & doubleArgumentFor _worldEvents | i < 1 -> w & dbArg _worldEvents
| otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail ) | otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail )
(GameOverMenu : _) -> updateParticles (GameOverMenu : _) -> updateParticles
. updateProjectiles . updateProjectiles
@@ -60,7 +60,7 @@ update' w = case _menuLayers w of
. zoneCreatures . zoneCreatures
. updateWalls . updateWalls
. set worldEvents id . set worldEvents id
. doubleArgumentFor _worldEvents . dbArg _worldEvents
. updateParticles . updateParticles
. updateProjectiles . updateProjectiles
. updateLightSources . updateLightSources
@@ -83,7 +83,6 @@ update' w = case _menuLayers w of
where where
(x,y) = cloudZoneOfPoint $ _clPos cr (x,y) = cloudZoneOfPoint $ _clPos cr
cid = _clID cr cid = _clID cr
doubleArgumentFor f x = f x x
updateCreatureGroups :: World -> World updateCreatureGroups :: World -> World
updateCreatureGroups w = w & creatureGroups %~ updateCreatureGroups w = w & creatureGroups %~
src/Dodge/WorldEvent/SpawnParticle.hs
+2 -2
View File
@@ -246,7 +246,7 @@ makeTeslaArcAt i pos dir = Projectile
{ _pjPos = pos { _pjPos = pos
, _pjStartPos = pos , _pjStartPos = pos
, _pjVel = (0,0) , _pjVel = (0,0)
, _pjPict = onLayer PtLayer $ line [(0,0),(0,0)] , _pjDraw = \_ -> onLayer PtLayer $ line [(0,0),(0,0)]
, _pjID = i , _pjID = i
, _pjUpdate = moveTeslaArc pos dir i , _pjUpdate = moveTeslaArc pos dir i
} }
@@ -258,7 +258,7 @@ moveTeslaArc
-> World -> World
-> World -> World
moveTeslaArc p d i w = moveTeslaArc p d i w =
set (projectiles . ix i . pjPict) pic set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate) $ set (projectiles . ix i . pjUpdate)
(pjTimer 2 i) (pjTimer 2 i)
$ set randGen g $ set randGen g