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:
jgk
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 ([],[])
where
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
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjPict :: Picture
, _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: World -> World
}
@@ -392,7 +392,7 @@ data Projectile
{ _pjPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjPict :: Picture
, _pjDraw :: Projectile -> Picture
, _pjID :: Int
, _pjUpdate :: 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
, _pjStartPos = p
, _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
, _pjUpdate = pjTimer t k
}
@@ -26,7 +26,7 @@ drawCircleAtForCol p t col w = w & projectiles %~
{ _pjPos = p
, _pjStartPos = p
, _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
, _pjUpdate = pjTimer t k
}
@@ -38,7 +38,7 @@ drawLineForCol ps t col w = w & projectiles %~
{ _pjPos = head ps
, _pjStartPos = head ps
, _pjVel = (0,0)
, _pjPict = onLayer PtLayer $ color col $ lineOfThickness 5 ps
, _pjDraw = \_ -> onLayer PtLayer $ color col $ lineOfThickness 5 ps
, _pjID = k
, _pjUpdate = pjTimer t k
}
src/Dodge/Default.hs
+1 -1
View File
@@ -206,7 +206,7 @@ defaultPT = Projectile
{ _pjPos = (0,0)
, _pjStartPos = (0,0)
, _pjVel = (0,0)
, _pjPict = blank
, _pjDraw = \_ -> blank
, _pjID = 0
, _pjUpdate = id
}
src/Dodge/Item/Weapon.hs
+16 -16
View File
@@ -638,7 +638,7 @@ makeShellAt pl i cid pos dir = Shell
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjPict = blank
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = moveShell 50 i cid 0 (rotateV dir (3,0))
, _pjPayload = pl
@@ -656,21 +656,21 @@ moveShell time i cid rot accel w
then doExplode
else w
& 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)
| isJust thingHit = doExplode
| time == 35 = w
& 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
| time >= 20 = w
& 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)
| time > -99 = w
& projectiles . ix i . pjPos %~ (+.+ vel)
& 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 . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
@@ -678,7 +678,7 @@ moveShell time i cid rot accel w
& smokeGen
| time > -200 = w
& 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)
| otherwise = doExplode
where
@@ -828,8 +828,8 @@ moveRemoteBomb itid time pID w
f x | x < -369 = -10
| otherwise = x - 1
updatePicture =
set (projectiles . ix pID.pjPict)
(onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time)
set (projectiles . ix pID . pjDraw)
(\_ -> onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time)
. lowLightDirected
(withAlpha 0.1 red)
newPos
@@ -914,7 +914,7 @@ fireRemoteLauncher cr w = setLocation
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (1,0)
, _pjPict = blank
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = moveRemoteShell 50 i cid itid dir
}
@@ -936,7 +936,7 @@ moveRemoteShell time i cid itid _ w
| time > 40 = if circOnSomeWall oldPos 4 w
then doExplosion w
else over (projectiles . ix i . pjPos) (+.+ vel)
$ set (projectiles . ix i . pjPict) piclow
$ set (projectiles . ix i . pjDraw) (\_ -> piclow)
$ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ setScope
@@ -944,7 +944,7 @@ moveRemoteShell time i cid itid _ w
| time >= 20 = case thingHit of
Just _ -> doExplosion w
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)
$ setScope
@@ -955,7 +955,7 @@ moveRemoteShell time i cid itid _ w
w
Nothing -> over (projectiles . ix i . pjPos) (+.+ vel)
$ 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)
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250
@@ -968,7 +968,7 @@ moveRemoteShell time i cid itid _ w
$ stopSoundFrom (ShellSound i)
w
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)
$ setScope
w
@@ -1014,7 +1014,7 @@ explodeRemoteRocket
-> World
explodeRemoteRocket itid pjid w
= 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)
$ resetName
$ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
@@ -1034,7 +1034,7 @@ throwRemoteBomb cr w = setLocation
{ _pjPos = p
, _pjStartPos = p
, _pjVel = v
, _pjPict = blank
, _pjDraw = \_ -> blank
, _pjID = i
, _pjUpdate = moveRemoteBomb itid 50 i
}
@@ -1062,7 +1062,7 @@ throwRemoteBomb cr w = setLocation
explodeRemoteBomb :: Int -> Int -> Creature -> World -> World
explodeRemoteBomb itid pjid cr w
= 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)
$ resetName
$ resetPict
src/Dodge/Item/Weapon/Grenade.hs
+3 -3
View File
@@ -32,8 +32,8 @@ moveGrenade time dir pID w = case hitWl of
_ -> updatedWorld
where
updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
$ set (projectiles .ix pID.pjPict)
(onLayer PtLayer $ uncurry translate newPos
$ set (projectiles .ix pID. pjDraw)
(\ _ -> onLayer PtLayer $ uncurry translate newPos
$ rotate dir $ grenadePic time)
$ set (projectiles .ix pID.pjUpdate) (moveGrenade (time-1) dir pID) w
pj = _projectiles w IM.! pID
@@ -67,7 +67,7 @@ throwGrenade explosion cr w = setWp $ removePict $ over projectiles addG w
{ _pjPos = p
, _pjStartPos = p
, _pjVel = v
, _pjPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0
, _pjDraw = \_ -> onLayer PtLayer $ uncurry translate p $ grenadePic 0
, _pjID = i
, _pjUpdate = moveGrenade fuseTime dir i
, _pjPayload = explosion
src/Dodge/Item/Weapon/UseEffect.hs
+2 -2
View File
@@ -126,7 +126,7 @@ tractorBeamAt colID i pos dir = Projectile
{ _pjPos = pos
, _pjStartPos = p'
, _pjVel = d
, _pjPict = blank
, _pjDraw = \_ -> blank
, _pjID = 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 colID time i w
| 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 floorItems (IM.map tractFlIt)
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 w = pictures $ concat
[ IM.elems $ _decorations w
, map _pjPict . IM.elems $ _projectiles w
, map (dbArg _pjDraw) . IM.elems $ _projectiles w
, map drawItem . IM.elems $ _floorItems w
, map crDraw . IM.elems $ _creatures w
, map clDraw . reverse . IM.elems $ _clouds w
, map ppDraw . IM.elems $ _pressPlates w
, map btDraw (IM.elems (_buttons w))
, map (\pt -> _ptDraw pt pt) $ _particles w
, map (dbArg _ptDraw) $ _particles w
, map drawWallFloor (wallFloorsToDraw 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' w = case _menuLayers w of
(WaitMessage s i: _)
| i < 1 -> w & doubleArgumentFor _worldEvents
| i < 1 -> w & dbArg _worldEvents
| otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail )
(GameOverMenu : _) -> updateParticles
. updateProjectiles
@@ -60,7 +60,7 @@ update' w = case _menuLayers w of
. zoneCreatures
. updateWalls
. set worldEvents id
. doubleArgumentFor _worldEvents
. dbArg _worldEvents
. updateParticles
. updateProjectiles
. updateLightSources
@@ -83,7 +83,6 @@ update' w = case _menuLayers w of
where
(x,y) = cloudZoneOfPoint $ _clPos cr
cid = _clID cr
doubleArgumentFor f x = f x x
updateCreatureGroups :: World -> World
updateCreatureGroups w = w & creatureGroups %~
src/Dodge/WorldEvent/SpawnParticle.hs
+2 -2
View File
@@ -246,7 +246,7 @@ makeTeslaArcAt i pos dir = Projectile
{ _pjPos = pos
, _pjStartPos = pos
, _pjVel = (0,0)
, _pjPict = onLayer PtLayer $ line [(0,0),(0,0)]
, _pjDraw = \_ -> onLayer PtLayer $ line [(0,0),(0,0)]
, _pjID = i
, _pjUpdate = moveTeslaArc pos dir i
}
@@ -258,7 +258,7 @@ moveTeslaArc
-> World
-> World
moveTeslaArc p d i w =
set (projectiles . ix i . pjPict) pic
set (projectiles . ix i . pjDraw) (\_ -> pic)
$ set (projectiles . ix i . pjUpdate)
(pjTimer 2 i)
$ set randGen g