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

Separate out concrete part of world

Browse Source
This commit is contained in:
justin
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Barreloid.hs
+3 -3
View File
@@ -18,8 +18,8 @@ updateBarreloid cr = case cr ^?! crType . barrelType of
-- should generate the sparks externally using new random generators
updateExpBarrel :: Creature -> World -> World
updateExpBarrel cr w
| _crHP cr > 0 = foldr ($) (hiss w & creatures . at (_crID cr) .~ newCr) pierceSparks
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & creatures . at (_crID cr) .~ Nothing
| _crHP cr > 0 = foldr ($) (hiss w & cWorld . creatures . at (_crID cr) .~ newCr) pierceSparks
| otherwise = makeExplosionAt (_crPos cr) $ stopSounds w & cWorld . creatures . at (_crID cr) .~ Nothing
where
g = _randGen w
damages = _csDamage $ _crState cr
@@ -40,7 +40,7 @@ updateExpBarrel cr w
updateBarrel :: Creature -> World -> World
updateBarrel cr
| _crHP cr > 0 = doDamage cr
| otherwise = creatures . at (_crID cr) .~ Nothing
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
damToExpBarrel :: [Damage] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
src/Dodge/Base/Collide.hs
+7 -7
View File
@@ -161,7 +161,7 @@ allVisibleWalls :: World -> [(Point2,Wall)]
{-# INLINE allVisibleWalls #-}
allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20
where
vPos = _cameraViewFrom w
vPos = _cameraViewFrom $ _cWorld w
--allVisibleWalls :: World -> StreamOf (Point2,Wall)
--{-# INLINE allVisibleWalls #-}
@@ -242,7 +242,7 @@ circOnAnyCr :: Point2 -> Float -> World -> Bool
{-# INLINE circOnAnyCr #-}
circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
where
f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? creatures . ix cid) || bl
f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . creatures . ix cid) || bl
{- | More general collision tests follow -}
@@ -274,22 +274,22 @@ canSee :: Int -> Int -> World -> Bool
{-# INLINE canSee #-}
canSee i j w = hasLOS p1 p2 w
where
p1 = _crPos (_creatures w IM.! i)
p2 = _crPos (_creatures w IM.! j)
p1 = _crPos (_creatures (_cWorld w) IM.! i)
p2 = _crPos (_creatures (_cWorld w) IM.! j) -- unsafe
canSeeIndirect :: Int -> Int -> World -> Bool
{-# INLINE canSeeIndirect #-}
canSeeIndirect i j w = hasLOSIndirect ipos jpos w
where
ipos = _crPos (_creatures w IM.! i)
jpos = _crPos (_creatures w IM.! j)
ipos = _crPos (_creatures (_cWorld w) IM.! i)
jpos = _crPos (_creatures (_cWorld w) IM.! j)
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
where
hitCr = IS.foldr f False $ crsNearSeg sp ep w
f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
(w ^? creatures . ix cid)
(w ^? cWorld . creatures . ix cid)
|| bl
hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w
src/Dodge/Base/Coordinate.hs
+12 -12
View File
@@ -7,31 +7,31 @@ import Geometry
worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
where
doTranslate p = p -.- _cameraCenter w
doZoom p = _cameraZoom w *.* p
doRotate p = rotateV (negate $ _cameraRot w) p
doTranslate p = p -.- _cameraCenter (_cWorld w)
doZoom p = _cameraZoom (_cWorld w) *.* p
doRotate p = rotateV (negate $ _cameraRot (_cWorld w)) p
{- | Transform world coordinates to scaled screen coordinates.
- These have to be scaled according to the size of the window to get actual screen positions.
- This allows for line thicknesses etc to correspond to pixel sizes.-}
worldPosToScreen :: World -> Point2 -> Point2
worldPosToScreen w
= rotateV (negate $ _cameraRot w)
. (_cameraZoom w *.*)
. (-.- _cameraCenter w)
= rotateV (negate $ _cameraRot (_cWorld w))
. (_cameraZoom (_cWorld w) *.*)
. (-.- _cameraCenter (_cWorld w))
{- | Transform coordinates from the map position to screen
coordinates. -}
cartePosToScreen :: Configuration -> World -> Point2 -> Point2
cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
where
doTranslate p = p -.- _carteCenter (_hud w)
doZoom p = _carteZoom (_hud w) *.* p
doRotate p = rotateV (negate $ _carteRot (_hud w)) p
doTranslate p = p -.- _carteCenter (_hud (_cWorld w))
doZoom p = _carteZoom (_hud (_cWorld w)) *.* p
doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) p
crToMousePosOffset :: Creature -> World -> (Point2,Float)
crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr,0)
{- | The mouse position in world coordinates. -}
mouseWorldPos :: World -> Point2
mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
mouseWorldPos w = _cameraCenter (_cWorld w) +.+ (1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos (_cWorld w))
{- | The mouse position in map coordinates -}
mouseCartePos :: World -> Point2
mouseCartePos w = _carteCenter (_hud w) +.+ (1/_carteZoom (_hud w))
*.* rotateV (_carteRot (_hud w)) (_mousePos w)
mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+ (1/_carteZoom (_hud (_cWorld w)))
*.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos (_cWorld w))
src/Dodge/Base/Window.hs
+5 -5
View File
@@ -15,10 +15,10 @@ screenPolygon :: Configuration -> World -> [Point2]
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
-- [tr,tl,bl,br]
where
scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
scRot = rotateV (_cameraRot (_cWorld w))
scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
| otherwise = p
scTran p = p +.+ _cameraCenter w
scTran p = p +.+ _cameraCenter (_cWorld w)
-- tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w))
-- tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w))
-- br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w))
@@ -35,9 +35,9 @@ screenPolygonBord xbord ybord cfig w = [tr,tl,bl,br]
where
hw = halfWidth cfig - xbord
hh = halfHeight cfig - ybord
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
| otherwise = p
theTransform = (+.+ _cameraCenter w) . rotateV (_cameraRot w) . scZoom
theTransform = (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) . scZoom
tr = theTransform (V2 hw hh )
tl = theTransform (V2 (-hw) hh )
br = theTransform (V2 hw (-hh))
src/Dodge/Base/You.hs
+1 -1
View File
@@ -5,7 +5,7 @@ import qualified IntMapHelp as IM
--import Control.Lens
you :: World -> Creature
you w = _creatures w IM.! _yourID w
you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w)
yourItem :: World -> Maybe Item
yourItem w = _crInv (you w) IM.!? crSel (you w)
src/Dodge/Beam.hs
+4 -4
View File
@@ -27,20 +27,20 @@ flameBeamCombine (p,(a,b,_),(x,y,_))
lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
lasBeamCombine (p,(a,b,_),(x,y,_))
= lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
= cWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
splitBeamCombine (p,(a,b,_),(x,y,_))
= (lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
. (lasers .:~ lasRayAt yellow 11 1 p (dir-0.5*pi))
= (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
. (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir-0.5*pi))
where
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-> World -> World
teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
= w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip
= w' & pointToItem (_itemPositions (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
where
itid = fromJust $ _bmOrigin bm
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
src/Dodge/Block.hs
+14 -14
View File
@@ -28,14 +28,14 @@ splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardC
(weakenMatS bm) (_blPos bl)
where
bm = fromMaybe Stone $ do
wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
(wlid,_) <- IS.minView wlids
w ^? walls . ix wlid . wlMaterial
w ^? cWorld . walls . ix wlid . wlMaterial
unshadowBlock :: Int -> World -> World
unshadowBlock wlid w = case w ^? walls . ix wlid of
unshadowBlock wlid w = case w ^? cWorld . walls . ix wlid of
Just wl -> w
& walls . ix wlid . wlUnshadowed .~ True
& cWorld . walls . ix wlid . wlUnshadowed .~ True
& insertWallInZones (wl & wlUnshadowed .~ True)
Nothing -> w
@@ -50,13 +50,13 @@ destroyBlock bl w = w
& makeBlockDebris bl
& deleteWallIDs wlids
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
& blocks %~ IM.delete (_blID bl)
& cWorld . blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
where
wlids = _blWallIDs bl
awl = _walls w IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids
awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
-- this does not handle eg doors blocking the path as well
@@ -67,20 +67,20 @@ maybeClearPath :: World -> (Int,Int,PathEdge) -> World
maybeClearPath w (x,y,pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w
= w
| otherwise = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y)
| otherwise = w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles .~ mempty) . FGL.delEdge (x,y)
destroyDoor :: Door -> World -> World
destroyDoor dr w = w
& doDrWdWd (_drDeath dr) dr
& deleteWallIDs wlids
& doors %~ IM.delete (_drID dr)
& cWorld . doors %~ IM.delete (_drID dr)
& flip (foldr (wlDustAt awl)) (map (pos +.+) ps)
& stopPushing (_drPushes dr)
& destroyMounts (_drMounts dr)
where
wlids = _drWallIDs dr
awl = _walls w IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids
awl = _walls (_cWorld w) IM.! IS.findMin wlids
pos = fst . _wlLine $ _walls (_cWorld w) IM.! IS.findMin wlids
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
destroyMounts :: [MountedObject] -> World -> World
@@ -89,11 +89,11 @@ destroyMounts mos w = foldr destroyMount w mos
destroyMount :: MountedObject -> World -> World
destroyMount mo = case mo of
MountedLS lsid -> destroyLS lsid
MountedProp prid -> props . at prid .~ Nothing
MountedProp prid -> cWorld . props . at prid .~ Nothing
stopPushing :: Maybe Int -> World -> World
stopPushing mdrid w = fromMaybe w $ do
drid <- mdrid
dr <- w ^? doors . ix drid
return $ w & doors . ix drid . drMech .~ DrWdId
dr <- w ^? cWorld . doors . ix drid
return $ w & cWorld . doors . ix drid . drMech .~ DrWdId
& stopPushing (_drPushes dr)
src/Dodge/Block/Debris.hs
+6 -6
View File
@@ -20,9 +20,9 @@ makeDoorDebris dr w = w & makeDebris mt col p
where
p = uncurry midPoint (_drPos dr)
(mt,col) = fromMaybe (Stone,greyN 0.5) $ do
wlids <- w ^? doors . ix (_drID dr) . drWallIDs
wlids <- w ^? cWorld . doors . ix (_drID dr) . drWallIDs
(wlid,_) <- IS.minView wlids
wl <- w ^? walls . ix wlid
wl <- w ^? cWorld . walls . ix wlid
return (_wlMaterial wl,_wlColor wl)
makeBlockDebris :: Block -> World -> World
@@ -32,9 +32,9 @@ makeBlockDebris bl w = foldr (makeDebris mt col) w ps
dsize = debrisSize mt
ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_blFootprint bl)
(mt,col) = fromMaybe (Stone,greyN 0.5) $ do
wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
(wlid,_) <- IS.minView wlids
wl <- w ^? walls . ix wlid
wl <- w ^? cWorld . walls . ix wlid
return (_wlMaterial wl,_wlColor wl)
makeDebrisToHeight :: Float -> Material -> Color -> Point2 -> World -> World
@@ -46,7 +46,7 @@ makeDebris = makeDebrisDirected 1 2 (2*pi) 0
makeDebrisDirectedHeight :: Float -> Float -> Float -> Float -> Float -> Material
-> Color -> Point2 -> World -> World
makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
& flip (foldl' (flip $ plNew props prID)) thedebris
& flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
& randGen .~ newg
& originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
where
@@ -75,7 +75,7 @@ makeDebrisDirected :: Float
-> Point2
-> World -> World
makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
& flip (foldl' (flip $ plNew props prID)) thedebris
& flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
& randGen .~ newg
& originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
where
src/Dodge/Bullet.hs
+5 -5
View File
@@ -25,7 +25,7 @@ updateBullet w bu = case _buState bu of
_ -> mvBullet 1 w bu
useAmmoParams :: Item -> Creature -> World -> World
useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype
useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
& buPos .~ sp
& buTrajectory %~ settrajectory
& buVel %~ (rotateV dir . (muzvel *.*))
@@ -60,7 +60,7 @@ mvBullet x w bt'
partspawn <- bulletSpawn bt'
return $ partspawn p w'
hitstream = thingsHit p (p +.+ vel) w
bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets w)
bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets (_cWorld w))
& buState .~ NormalBulletState
dodrag = case _buTrajectory bt of
BasicBulletTrajectory -> buVel .*.*~ drag
@@ -84,7 +84,7 @@ bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
bulletSpawn bu = case _buSpawn bu of
BulSpark -> Nothing
BulBall IncBall -> Just incBallAt
BulBall ConcBall -> Just $ \p -> shockwaves .:~ concBall p
BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
BulBall TeslaBall -> Just makeStaticBall
hitEffFromBul :: Float -> Bullet
@@ -112,8 +112,8 @@ setFromToDams bu p = map f (_buDamages bu)
damageThingHit :: Bullet -> (Point2,Either Creature Wall) -> World -> World
damageThingHit bu (p,crwl) = case crwl of
Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams
Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
where
dams = setFromToDams bu p
src/Dodge/Button/Event.hs
+4 -4
View File
@@ -9,8 +9,8 @@ doButtonEvent :: ButtonEvent -> Button -> World -> World
doButtonEvent be = case be of
ButtonDoNothing -> const id
ButtonPress newstate newevent thesound f -> \b -> doWorldEffect f
. set (buttons . ix (_btID b) . btState) newstate
. set (buttons . ix (_btID b) . btEvent) newevent
. set (cWorld . buttons . ix (_btID b) . btState) newstate
. set (cWorld . buttons . ix (_btID b) . btEvent) newevent
. soundStart (LeverSound 0) (_btPos b) thesound Nothing
--ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined
ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff
@@ -19,9 +19,9 @@ doButtonEvent be = case be of
flipSwitch :: WdWd -> WdWd -> Button -> World -> World
flipSwitch oneff offeff bt
| _btState bt == BtOff = doWorldEffect oneff . dosound
. over (buttons . ix (_btID bt)) turnon
. over (cWorld . buttons . ix (_btID bt)) turnon
| otherwise = doWorldEffect offeff . dosound
. over (buttons . ix (_btID bt)) turnoff
. over (cWorld . buttons . ix (_btID bt)) turnoff
where
turnon = (btState .~ BtOn ) . (btText .~ "SWITCH\\")
turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
src/Dodge/Clock.hs
+1 -1
View File
@@ -9,5 +9,5 @@ clockCycle :: Int -> V.Vector a -> World -> a
clockCycle tPeriod xs w = xs V.! i
where
l = V.length xs
t = _worldClock w `mod` (l * tPeriod)
t = _worldClock (_cWorld w) `mod` (l * tPeriod)
i = t `div` tPeriod
src/Dodge/Combine.hs
+3 -3
View File
@@ -86,12 +86,12 @@ fullModuleName :: ItemModuleType -> String
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
toggleCombineInv :: World -> World
toggleCombineInv w = case _hudElement (_hud w) of
DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
toggleCombineInv w = case _hudElement (_hud (_cWorld w)) of
DisplayInventory CombineInventory {} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & enterCombineInv
enterCombineInv :: World -> World
enterCombineInv w = w & hud . hudElement .~ DisplayInventory (CombineInventory mi)
enterCombineInv w = w & cWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi)
where
mi = 0 <$ listToMaybe (combineItemListYou w)
src/Dodge/Creature/Action.hs
+15 -15
View File
@@ -66,7 +66,7 @@ performAimAt cr w tcid p = ([TurnToward tpos aimSp], Just $ AimAt tcid tpos)
aimSp = case cr ^? crMvType . mvAimSpeed of
Just f -> doFloatFloat f $ safeAngleVV (unitVectorAtAngle cdir) (tpos - cpos)
Nothing -> error "creature without aiming type"
tpos | canSee' = _crPos (_creatures w IM.! tcid)
tpos | canSee' = _crPos (_creatures (_cWorld w) IM.! tcid)
| otherwise = p
performPathTo :: Creature -> World -> Point2 -> OutAction
@@ -159,8 +159,8 @@ blinkActionFail
-> World
blinkActionFail cr w = w
& soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
& distortions .:~ distortionBulge
& creatures . ix cid . crPos .~ p3
& cWorld . distortions .:~ distortionBulge
& cWorld . creatures . ix cid . crPos .~ p3
& inverseShockwaveAt cpos 40 2 2
where
distR = 120
@@ -176,8 +176,8 @@ blinkActionFail cr w = w
blinkAction :: Creature -> World -> World
blinkAction cr w = w
& soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
& distortions .++~ distortionBulge
& creatures . ix cid . crPos .~ p3
& cWorld . distortions .++~ distortionBulge
& cWorld . creatures . ix cid . crPos .~ p3
& blinkShockwave cid p3
& inverseShockwaveAt cpos 40 2 2
where
@@ -201,13 +201,13 @@ unsafeBlinkAction
-> World
unsafeBlinkAction cr w
| success = soundMultiFrom [TeleSound 0,TeleSound 1] mwp teleS Nothing
. over distortions (distortionBulge ++)
. set (creatures . ix cid . crPos) mwp
. (cWorld . distortions .++~ distortionBulge)
. set (cWorld . creatures . ix cid . crPos) mwp
. blinkShockwave cid mwp
$ inverseShockwaveAt cpos 40 2 2 w
| otherwise = w
& blinkActionFail cr
& creatures . ix cid . crState . csDamage .:~
& cWorld . creatures . ix cid . crState . csDamage .:~
Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
where
success = fromMaybe True $ do
@@ -230,20 +230,20 @@ blinkShockwave
blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
setMinInvSize :: Int -> Creature -> World -> World
setMinInvSize n cr = creatures . ix (_crID cr) . crInvCapacity .~ n
setMinInvSize n cr = cWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
-- maybe this should be removed...
stripNoItems :: Creature -> World -> World
stripNoItems cr = organiseInvKeys (_crID cr) .
( creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just )
( cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapMaybe Just )
organiseInvKeys :: Int -> World -> World
organiseInvKeys cid w = w & creatures . ix cid %~
organiseInvKeys cid w = w & cWorld . creatures . ix cid %~
( ( crInvSel . iselPos .~ newSelKey )
. ( crInv .~ newInv )
. ( crInvSel . iselAction .~ NoInvSelAction) )
where
cr = _creatures w IM.! cid
cr = _creatures (_cWorld w) IM.! cid
pairs = IM.toList (_crInv cr)
newSelKey = fromMaybe 0 $ findIndex ( (== crSel cr) . fst) pairs
newInv = IM.fromAscList $ zip [0..] $ map snd pairs
@@ -291,8 +291,8 @@ sizeSelf x cr w
-- | _crPos cr1 == _crPos cr2 = Just $ w
| not (crOnWall cr1 w) = Just $ w
& soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
& over distortions (distortionBulge :)
& creatures . ix cid %~
& cWorld . distortions .:~ distortionBulge
& cWorld . creatures . ix cid %~
( (crRad .~ 10 * x)
. (crMvType . mvSpeed .~ yourDefaultSpeed * x)
. (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
@@ -309,7 +309,7 @@ sizeSelf x cr w
cpos = _crPos cr
pickUpItemID :: Int -> Int -> World -> World
pickUpItemID cid flid w = pickUpItem cid (_floorItems w IM.! flid) w
pickUpItemID cid flid w = pickUpItem cid (_floorItems (_cWorld w) IM.! flid) w
{- | Pick up a specific item. -}
pickUpItem :: Int -> FloorItem -> World -> World
src/Dodge/Creature/Boid.hs
+8 -8
View File
@@ -175,7 +175,7 @@ swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
Just tcr -> updT tcr cenp cr
where
cid = _crID cr
cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup $ _creatures w IM.! cid)
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup $ _creatures (_cWorld w) IM.! cid)
flockChaseTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
@@ -188,7 +188,7 @@ flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
Just tcr -> updT tcr crs cr
where
is = _swarm $ _crGroup cr
crs = IM.restrictKeys (_creatures w) is
crs = IM.restrictKeys (_creatures (_cWorld w)) is
flockPointTarget
:: (Creature -> IM.IntMap Creature -> Creature -> Point2)
@@ -201,7 +201,7 @@ flockPointTarget f targFunc w cr = case targFunc cr w of
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
is = _swarm $ _crGroup cr
crs = IM.restrictKeys (_creatures w) is
crs = IM.restrictKeys (_creatures (_cWorld w)) is
p = f crTarg crs cr
flockToPointUsing
@@ -213,7 +213,7 @@ flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
where
cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
ptarg = pf tcr cenp cr
flockToPointUsing'
:: (Creature -> Point2 -> Creature -> Point2)
@@ -225,7 +225,7 @@ flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
Nothing -> cr
Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
where
cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
ptarg = pf tcr cenp cr
flockFunc
@@ -237,7 +237,7 @@ flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr
flockCenterFunc
@@ -249,7 +249,7 @@ flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
Nothing -> cr
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
p = f crTarg cenp cr
flockPointTargetR
@@ -262,7 +262,7 @@ flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
where
is = _swarm $ _crGroup cr
crs = IM.restrictKeys (_creatures w) is
crs = IM.restrictKeys (_creatures (_cWorld w)) is
p = f crTarg crs cr
meleeHeadingMove
src/Dodge/Creature/Damage.hs
+5 -5
View File
@@ -20,7 +20,7 @@ applyCreatureDamage dms cr = case _crMaterial cr of
defaultApplyDamage :: [Damage] -> Creature -> World -> World
defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
& creatures . ix (_crID cr) %~ doPoisonDam
& cWorld . creatures . ix (_crID cr) %~ doPoisonDam
where
(ps,ds') = partition isPoison ds
isPoison Damage{_dmType=POISONDAM} = True
@@ -31,15 +31,15 @@ defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
applyDamageEffect dm de cr w = case de of
PushDamage push pushexp pushRad -> w
& creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
& cWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
where
pushAmount
| dist (_crPos cr) fromDir == 0 = 0
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
PushBackDamage pback -> w
& creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir)
& cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback/_crMass cr) *.* (_dmTo dm -.- fromDir)
TorqueDamage rot -> w
& creatures . ix (_crID cr) . crDir +~ rot
& cWorld . creatures . ix (_crID cr) . crDir +~ rot
NoDamageEffect -> w
where
fromDir = _dmFrom dm
@@ -62,7 +62,7 @@ applyPiercingDamage cr dm
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
damageHP :: Creature -> Int -> World -> World
damageHP cr x = creatures . ix (_crID cr) %~
damageHP cr x = cWorld . creatures . ix (_crID cr) %~
( (crHP -~ x)
. (crPastDamage +~ x)
)
src/Dodge/Creature/Impulse.hs
+4 -4
View File
@@ -24,14 +24,14 @@ impulsiveAIBeforeAfter
:: (World -> Creature -> Creature)
-> (World -> Creature -> Creature)
-> Creature -> World -> World
impulsiveAIBeforeAfter startup endup cr w = w' & creatures . ix (_crID cr) .~ endup w' cr'
impulsiveAIBeforeAfter startup endup cr w = w' & cWorld . creatures . ix (_crID cr) .~ endup w' cr'
where
w' = g w
(g,cr') = impulsiveAI startup cr w
impulsiveAIBefore :: (World -> Creature -> Creature)
-> Creature -> World -> World
impulsiveAIBefore f cr w = g w & creatures . ix (_crID cr) .~ cr'
impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr'
where
(g,cr') = impulsiveAI f cr w
@@ -94,9 +94,9 @@ followImpulse cr w imp = case imp of
cpos = _crPos cr
cdir = _crDir cr
cid = _crID cr
posFromID cid' = _crPos $ _creatures w IM.! cid'
posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid'
rr a = randomR (-a,a) $ _randGen w
hitCr i = (creatures . ix i . crState . csDamage
hitCr i = (cWorld . creatures . ix i . crState . csDamage
.:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
)
. soundStart (CrSound cid) cpos hitS Nothing
src/Dodge/Creature/Impulse/UseItem.hs
+19 -14
View File
@@ -20,11 +20,11 @@ import Data.Maybe
useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? creatures . ix (_crID cr')
cr <- w ^? cWorld . creatures . ix (_crID cr')
it <- cr ^? crInv . ix (crSel cr)
return $ itemEffect cr it w
where
f = creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^? itUse of
@@ -40,13 +40,13 @@ itemEffect cr it w = case it ^? itUse of
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w
_ -> w & setuhamdown
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr
. activateEquipmentAt (_rbOptions w) cr)
setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions (_cWorld w)) (crSel cr) cr
. activateEquipmentAt (_rbOptions (_cWorld w)) cr)
tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
tryReload cr it w f
| _crID cr == _yourID w && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons (_cWorld w) M.!? SDL.ButtonLeft == Just False
= crToggleReloading cr
| otherwise
= (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
@@ -58,7 +58,7 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
ic = _itConsumption it
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr = creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
activateEquipmentAt rbo cr = cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i,_) -> crLeftInvSel ?~ i
(_,Just _) -> crLeftInvSel .~ Nothing
_ -> id
@@ -67,31 +67,36 @@ toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just PutOnEquipment {_allocNewPos = newp}
-> w & crpoint . crEquipment . at newp ?~ invid
-> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr
Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-> w & crpoint . crEquipment . at newp ?~ invid
-> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid ?~ newp
Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-> w & crpoint . crEquipment . at newp ?~ invid
-> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at sid ?~ oldp
Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
-> w & crpoint . crEquipment . at newp ?~ invid
-> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at rid .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
Just RemoveEquipment {_allocOldPos = oldp }
-> w & crpoint . crEquipment . at oldp .~ Nothing
-> w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid .~ Nothing
& onremove itm cr
Nothing -> error "tried to toggle equipment whilst not prepared"
where
crpoint = creatures . ix (_crID cr)
crpoint = cWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat (crSel cr)
onequip itm' = useE ((_eqOnEquip . _eqEq . _itUse) itm') itm'
@@ -110,7 +115,7 @@ useLeftItem cid w
. useL f itm cr
$ w
where
cr = _creatures w IM.! cid
cr = _creatures (_cWorld w) IM.! cid
itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
&& _crLeftInvSel cr /= Just (crSel cr)
src/Dodge/Creature/Perception.hs
+2 -2
View File
@@ -91,7 +91,7 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
in crActionPlan . apStrategy .~ StrategyActions WarningCry
[ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++
[[ChangeStrategy $ CloseToMelee 0] ])
, AimAt 0 (_crPos $ _creatures w IM.! 0)
, AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
]
| otherwise = id
@@ -139,7 +139,7 @@ newExtraAwareness cr w cid
| otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
where
vi = _cpVision $ _crPerception cr
tpos = _crPos $ _creatures w IM.! cid
tpos = _crPos $ _creatures (_cWorld w) IM.! cid
cpos = _crPos cr
ang = angleVV (unitVectorAtAngle (_crDir cr)) (tpos - cpos)
d = dist tpos cpos
src/Dodge/Creature/Picture/Awareness.hs
+2 -2
View File
@@ -21,8 +21,8 @@ creatureDisplayText w cr = setLayer DebugLayer
]
) w cr
where
campos = _cameraViewFrom w
theScale = 0.15 / _cameraZoom w
campos = _cameraViewFrom (_cWorld w)
theScale = 0.15 / _cameraZoom (_cWorld w)
cpos = _crPos cr
v = cpos -.- campos
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
src/Dodge/Creature/ReaderUpdate.hs
+1 -1
View File
@@ -172,7 +172,7 @@ targetYouWhenCognizant :: World -> Creature -> Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
-- so this caused a space leak: be careful with ?~
-- consider changing targeted creature to be just an index
Just (Cognizant _) -> _creatures w IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures w IM.! 0
Just (Cognizant _) -> _creatures (_cWorld w) IM.! 0 `seq` cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
searchIfDamaged :: Creature -> Creature
src/Dodge/Creature/SetTarget.hs
+1 -1
View File
@@ -10,6 +10,6 @@ targetYouWhenCognizant
-> Creature
-> Creature
targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures w IM.! 0
Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
_ -> cr & crIntention . targetCr .~ Nothing
src/Dodge/Creature/State.hs
+16 -16
View File
@@ -32,7 +32,7 @@ foldCr :: [Creature -> World -> World]
--foldCr xs cr w = foldr ($ cr) w xs
foldCr xs cr w = foldr f w xs
where
f g w' = case w' ^? creatures . ix (_crID cr) of
f g w' = case w' ^? cWorld . creatures . ix (_crID cr) of
Just cr' -> g cr' w'
Nothing -> w'
@@ -66,15 +66,15 @@ checkDeath cr w
& corpseOrGib cr
where
removecr
| _crID cr == 0 = (creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
. (creatures . ix (_crID cr) . crHP .~ 0)
| _crID cr == 0 = (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
. (cWorld . creatures . ix (_crID cr) . crHP .~ 0)
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = creatures . at (_crID cr) .~ Nothing
| otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
Just (FLAMING,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL,_) -> w & plNew corpses cpID thecorpse
Just (POISONDAM,_) -> w & plNew corpses cpID (thecorpse & cpSPic %~ poisonSPic)
Just (FLAMING,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL,_) -> w & plNew (cWorld . corpses) cpID thecorpse
Just (POISONDAM,_) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
_ | _crPastDamage cr > 200 -> w & addCrGibs cr
& bloodPuddleAt cpos
& bloodPuddleAt cpos
@@ -82,7 +82,7 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
_ -> w
& bloodPuddleAt cpos
& bloodPuddleAt cpos
& plNew corpses cpID thecorpse
& plNew (cWorld . corpses) cpID thecorpse
where
cpos = _crPos cr
thecorpse = makeDefaultCorpse cr
@@ -104,14 +104,14 @@ poisonSPic = over _1 $
bloodPuddleAt :: Point2 -> World -> World
bloodPuddleAt p w = w
& snd . plNewID decorations
& snd . plNewID (cWorld . decorations)
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
& randGen .~ g
where
(q,g) = randInCirc 10 & runState $ _randGen w
internalUpdate :: Creature -> World -> World
internalUpdate cr = creatures . ix (_crID cr) %~
internalUpdate cr = cWorld . creatures . ix (_crID cr) %~
( (crHammerPosition %~ moveHammerUp)
. stepReloading
. updateMovement
@@ -127,7 +127,7 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
clearDamage :: Creature -> World -> World
clearDamage cr w = w
& creatures . ix (_crID cr) . crState . csDamage .~ []
& cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
doDamage :: Creature -> World -> World
doDamage cr w = w
@@ -140,13 +140,13 @@ doDamage cr w = w
applyPastDamages :: Creature -> World -> World
applyPastDamages cr w
| _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w)
in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
& randGen .~ g
| _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w)
in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
& randGen .~ g
| _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w)
in w & creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
& randGen .~ g
| otherwise = w
@@ -184,7 +184,7 @@ useEquipment cr i = useE (_eqUse (_eqEq $ _itUse itm)) itm cr
itm = _crInv cr IM.! i
-- a map updating all inventory items
upInv :: Creature -> World -> World
upInv cr = creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
-- a loop going over equipped items
equipmentEffects :: Creature -> World -> World
equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
@@ -226,7 +226,7 @@ doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
Nothing -> w
Just NoTargeting -> w
Just t -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
in w' & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
src/Dodge/Creature/YourControl.hs
+8 -8
View File
@@ -18,12 +18,12 @@ yourControl :: Creature -> World -> World
yourControl cr w
| inTermFocus w = dimCreatureLight cr w & updateUsingInput
| otherwise = dimCreatureLight cr w
& creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
& cWorld . creatures . ix (_crID cr) %~
(wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_cWorld w)))
& updateUsingInput
dimCreatureLight :: Creature -> World -> World
dimCreatureLight cr = tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
dimCreatureLight cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
-- note the order of operation, setting the posture first--this prevents the twist fire bug
@@ -35,7 +35,7 @@ wasdWithAiming
-> Creature
wasdWithAiming w speed cr
| isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)
= addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| otherwise = theMovement $ theTurn $ removeTwist cr
where
@@ -52,12 +52,12 @@ wasdWithAiming w speed cr
| otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir
theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr'
movDir = wasdDir w
dir = _cameraRot w + argV movDir
movAbs = rotateV (_cameraRot w) $ normalizeV movDir
dir = _cameraRot (_cWorld w) + argV movDir
movAbs = rotateV (_cameraRot (_cWorld w)) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
_ -> argV (_mousePos w) + _cameraRot w
_ -> argV (_mousePos (_cWorld w)) + _cameraRot (_cWorld w)
wasdM :: SDL.Scancode -> Point2
wasdM scancode = case scancode of
@@ -68,7 +68,7 @@ wasdM scancode = case scancode of
_ -> V2 0 0
wasdDir :: World -> Point2
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys . _cWorld
{- | Set posture according to mouse presses. -}
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
src/Dodge/CreatureEffect.hs
+2 -2
View File
@@ -92,7 +92,7 @@ chooseMovementSpreadGun cr w
where
d = dist cpos p
cpos = _crPos cr
tcr = _creatures w IM.! 0
tcr = _creatures (_cWorld w) IM.! 0
p = _crPos tcr
chooseMovementLtAuto :: Creature -> World -> Action
@@ -105,7 +105,7 @@ chooseMovementLtAuto cr w
= DoImpulses [UseItem,TurnToward p' 0.05, Move (V2 0 3)]
where
cpos = _crPos cr
tcr = _creatures w IM.! 0
tcr = _creatures (_cWorld w) IM.! 0
p = _crPos tcr
v = vNormal $ p -.- cpos
p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v)
src/Dodge/CullBox.hs
+3 -3
View File
@@ -13,15 +13,15 @@ import Control.Lens
findBoundDists :: Configuration -> World -> (Float,Float,Float,Float)
findBoundDists cfig w
| debugOn Bound_box_screen cfig = (hh,-hh,hw,-hw)
| otherwise = fromMaybe (0,0,0,0) $ farWallDistDirection (_cameraCenter w) w
| otherwise = fromMaybe (0,0,0,0) $ farWallDistDirection (_cameraCenter (_cWorld w)) w
where
hw = halfWidth cfig
hh = halfHeight cfig
updateBounds :: Universe -> Universe
updateBounds uv = uv
& uvWorld . boundDist .~ bdists
& uvWorld . boundBox .~ map ( (+.+ _cameraCenter w) . rotateV (_cameraRot w) ) (rectNSWE n s w' e)
& uvWorld . cWorld . boundDist .~ bdists
& uvWorld . cWorld . boundBox .~ map ( (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) ) (rectNSWE n s w' e)
where
w = _uvWorld uv
cfig = _uvConfig uv
src/Dodge/Cuse.hs
+1 -1
View File
@@ -6,4 +6,4 @@ import Control.Lens
useC :: Cuse -> Item -> Creature -> World -> World
useC cu = case cu of
CDoNothing -> const $ const id
CHeal x -> const $ \cr -> creatures . ix (_crID cr) . crHP +~ x
CHeal x -> const $ \cr -> cWorld . creatures . ix (_crID cr) . crHP +~ x
src/Dodge/Damage.hs
+3 -3
View File
@@ -9,11 +9,11 @@ import qualified Data.Map.Strict as M
damageCrWlID :: Damage -> CrWlID -> World -> World
damageCrWlID dam crwl = case crwl of
NothingID -> id
CrID cid -> creatures . ix cid . crState . csDamage .:~ dam
WlID wlid -> wallDamages . ix wlid .:~ dam
CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam
WlID wlid -> cWorld . wallDamages . ix wlid .:~ dam
damageCrWall :: Damage -> Either Creature Wall -> World -> World
damageCrWall dt (Left cr) = creatures . ix (_crID cr) . crState . csDamage .:~ dt
damageCrWall dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
damageCrWall dt (Right wl) = damageWall dt wl
damageDirection :: [Damage] -> Maybe Float
src/Dodge/DamageCircle.hs
+2 -2
View File
@@ -10,8 +10,8 @@ import Data.Foldable
import qualified IntMapHelp as IM
damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
damageCircle r sp dt da w = w
& wallDamages %~ addwalldamages
& creatures %~ addcreaturedamages
& cWorld . wallDamages %~ addwalldamages
& cWorld . creatures %~ addcreaturedamages
where
--addwalldamages wlds = runIdentity $ S.fold_ (damageWlCircle wldam) wlds id wlstodam
addwalldamages wlds = foldl' (damageWlCircle wldam) wlds wlstodam
src/Dodge/Data.hs
+8 -4
View File
@@ -204,7 +204,13 @@ data GenWorld = GenWorld
, _genPlacements :: IM.IntMap [(Placement,Int)]
, _genRooms :: IM.IntMap Room
}
data World = World
data World = World
{ _cWorld :: CWorld
, _randGen :: StdGen
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
}
data CWorld = CWorld
{ _keys :: S.Set Scancode
, _mouseButtons :: M.Map MouseButton Bool
, _mousePos :: Point2
@@ -259,15 +265,12 @@ data World = World
, _wlZoning :: IM.IntMap (IM.IntMap IS.IntSet) -- Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)]
, _randGen :: StdGen
, _modifications :: IM.IntMap Modification
, _yourID :: Int
, _worldEvents :: [WdWd]
, _delayedEvents :: [(Int,WdWd)]
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _toPlaySounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
@@ -501,6 +504,7 @@ makeLenses ''Equipment
makeLenses ''ScreenLayer
makeLenses ''WorldBeams
makeLenses ''GenWorld
makeLenses ''CWorld
----- ROOM LENSES
src/Dodge/Debug/LinkDecoration.hs
+2 -2
View File
@@ -14,11 +14,11 @@ import Geometry.Vector
import Control.Lens
addRoomPolyDecorations :: [Room] -> World -> World
addRoomPolyDecorations rms w = w & decorations %~
addRoomPolyDecorations rms w = w & cWorld . decorations %~
IM.insertWithNewKeys (map roomPolyDecorations rms)
addRoomLinkDecorations :: [Room] -> World -> World
addRoomLinkDecorations rms w = w & decorations %~
addRoomLinkDecorations rms w = w & cWorld . decorations %~
IM.insertWithNewKeys (map roomLinkDecorations rms)
roomLinkDecorations :: Room -> Picture
src/Dodge/Debug/Picture.hs
+6 -6
View File
@@ -19,10 +19,10 @@ printRotPoint r p = color white
outsideScreenPolygon :: Configuration -> World -> [Point2]
outsideScreenPolygon cfig w = [tr,tl,bl,br]
where
scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
scRot = rotateV (_cameraRot (_cWorld w))
scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
| otherwise = error "Trying to set screen zoom to zero"
scTran p = p +.+ _cameraCenter w
scTran p = p +.+ _cameraCenter (_cWorld w)
tr = f 3 3
tl = f (-3) 3
br = f 3 (-3)
@@ -37,9 +37,9 @@ lineOnScreenCone cfig w p1 p2 = pointInPolygon p1 sp
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
where
sp' = screenPolygon cfig w
vp = _cameraViewFrom w
vp = _cameraViewFrom (_cWorld w)
sp | pointInPolygon vp sp' = sp'
| otherwise = orderPolygon (_cameraViewFrom w : sp')
| otherwise = orderPolygon (_cameraViewFrom (_cWorld w) : sp')
sps = zip sp (tail sp ++ [head sp])
pointOnScreen :: Configuration -> World -> Point2 -> Bool
@@ -52,7 +52,7 @@ drawWallFace cfig w wall
where
(x,y) = _wlLine wall
points = extendConeToScreenEdge cfig w sightFrom (x,y)
sightFrom = _cameraViewFrom w
sightFrom = _cameraViewFrom (_cWorld w)
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2,Point2) -> [Point2]
extendConeToScreenEdge cfig w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
src/Dodge/Debug/Terminal.hs
+12 -12
View File
@@ -31,16 +31,16 @@ applyTerminalString ss = case ss of
applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
"LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LOADME" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LM" -> applyTerminalCommand "LOADME"
"LT" -> applyTerminalCommand "LOADTEST"
['L',x] -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" -> (uvWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
['L',x] -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
_ -> id
--applyTerminalString' ('s': 'e': 't': '_': 'h': 'p': ' ': hp)
-- | isNothing (readMaybe hp :: Maybe Int) = id
@@ -85,10 +85,10 @@ applySetTerminalString :: String -> Universe -> Universe
applySetTerminalString [] = id
applySetTerminalString var = case key' of
"" -> showTerminalError ("set "++var) ("Unable to read as argument as float: " ++ val)
"hp" -> uvWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"invcap" -> uvWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
"mass" -> uvWorld . creatures . ix 0 . crMass .~ fromJust val'
"mvspeed" -> uvWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val'
"hp" -> uvWorld . cWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"invcap" -> uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
"mass" -> uvWorld . cWorld . creatures . ix 0 . crMass .~ fromJust val'
"mvspeed" -> uvWorld . cWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val'
_ -> showTerminalError ("set "++var) ("Invalid set command: " ++ key) -- never reached?
where
(key, val) = getSplitString var
src/Dodge/Default/World.hs
+8 -3
View File
@@ -11,6 +11,14 @@ import Data.Graph.Inductive.Graph hiding ((&))
--import Data.Graph.Inductive.NodeMap
defaultWorld :: World
defaultWorld = World
{ _cWorld = defaultCWorld
, _toPlaySounds = M.empty
, _playingSounds = M.empty
, _randGen = mkStdGen 2
}
defaultCWorld :: CWorld
defaultCWorld = CWorld
{ _keys = S.empty
, _magnets = IM.empty
, _mouseButtons = mempty
@@ -62,15 +70,12 @@ defaultWorld = World
, _wlZoning = IM.empty --Zoning IM.empty wlZoneSize zoneOfWall
, _floorItems = IM.empty
, _floorTiles = []
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _yourID = 0
, _worldEvents = []
, _delayedEvents = []
, _pressPlates = IM.empty
, _buttons = IM.empty
, _toPlaySounds = M.empty
, _playingSounds = M.empty
, _corpses = IM.empty
, _decorations = IM.empty
--, _savedWorlds = M.empty
src/Dodge/DrWdWd.hs
+5 -5
View File
@@ -26,7 +26,7 @@ doorMechanism dr w = case mvDir of
Just d -> w
& flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
& moveUpdate
& doors . ix drid . drPos . each %~ (+.+ d)
& cWorld . doors . ix drid . drPos . each %~ (+.+ d)
& maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
Nothing -> w
where
@@ -46,9 +46,9 @@ doorMechanism dr w = case mvDir of
dop = snd $ _drOpenPos dr
dcp = snd $ _drClosePos dr
setStatus
| dist dpos dop < 1 = doors . ix drid . drStatus .~ DoorOpen
| dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
| otherwise = doors . ix drid . drStatus .~ DoorHalfway
| dist dpos dop < 1 = cWorld . doors . ix drid . drStatus .~ DoorOpen
| dist dpos dcp < 1 = cWorld . doors . ix drid . drStatus .~ DoorClosed
| otherwise = cWorld . doors . ix drid . drStatus .~ DoorHalfway
-- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
-- TODO update _drPos
@@ -70,7 +70,7 @@ doorMechanismStepwise nsteps wlids pss dr w
playSound = soundContinue (WallSound drid) (fst $ head pss) slideDoorS (Just 1)
toOpen = doWdBl (_drTrigger dr) w
setWalls n = playSound (foldl' (&) w (zipWith moveWallID wlids newps))
& doors . ix drid . drStatus .~ DoorInt n
& cWorld . doors . ix drid . drStatus .~ DoorInt n
where
newps = uncurry (rectanglePairs 9) (pss !! n)
-- it is not at all clear that the zoning selects the correct walls
src/Dodge/EnergyBall.hs
+3 -3
View File
@@ -17,7 +17,7 @@ makeFlamelet
-> World
makeFlamelet (V2 x y) z vel size time w = w
& randGen .~ g
& energyBalls .:~ EnergyBall
& cWorld . energyBalls .:~ EnergyBall
{ _ebVel = vel
, _ebColor = red
, _ebPos = V2 x y
@@ -39,7 +39,7 @@ moveEnergyBall w eb
incBallAt :: Point2 -> World -> World
incBallAt p w = w & energyBalls .:~ theincball
incBallAt p w = w & cWorld . energyBalls .:~ theincball
& randGen .~ g
where
(theincball,g) = runState thestate (_randGen w)
@@ -58,6 +58,6 @@ incBallAt p w = w & energyBalls .:~ theincball
ebFlicker :: EnergyBall -> World -> World
ebFlicker pt
| _ebTimer pt `mod` 7 == 0 = tempLightSources
| _ebTimer pt `mod` 7 == 0 = cWorld . tempLightSources
.:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ebColor pt)) (addZ 20 $ _ebPos pt)
| otherwise = id
src/Dodge/Event.hs
+21 -21
View File
@@ -46,7 +46,7 @@ handleEvent e = case eventPayload e of
_ -> return . Just
handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
handleMouseMotionEvent mmev u = Just $ u & uvWorld . cWorld . mousePos .~ V2
(fromIntegral x - 0.5*_windowX cfig)
(0.5*_windowY cfig - fromIntegral y)
where
@@ -55,8 +55,8 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
handleMouseButtonEvent :: MouseButtonEventData -> World -> World
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
Released -> mouseButtons . at thebutton .~ Nothing
Pressed -> mouseButtons . at thebutton ?~ False
Released -> cWorld . mouseButtons . at thebutton .~ Nothing
Pressed -> cWorld . mouseButtons . at thebutton ?~ False
where
thebutton = mouseButtonEventButton mbev
@@ -89,19 +89,19 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
_ -> Just w
wheelEvent :: Float -> World -> World
wheelEvent y w = case _hudElement $ _hud w of
wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte
| rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
| otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
| rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
| otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi)
DisplayInventory NoSubInventory
-- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps
| _crInvLock (_creatures w IM.! _yourID w) -> w
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
| _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
| rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions (_cWorld w)) of
(_,EquipOptions{}) -> scrollRBOption y w
(Nothing,_) -> closeObjScrollDir y w
(Just f,_) -> w & creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
| lbDown -> w & cameraZoom +~ y
(Just f,_) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
| lbDown -> w & cWorld . cameraZoom +~ y
| invKeyDown -> changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
DisplayInventory TweakInventory
@@ -110,12 +110,12 @@ wheelEvent y w = case _hudElement $ _hud w of
| rbDown -> w & changeTweakParam yi
| otherwise -> w & moveTweakSel yi
DisplayInventory (CombineInventory _) -> w
& hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
& cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
DisplayInventory (DisplayTerminal tmid)
| rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
& terminals . ix tmid %~ updatetermsubsel
& cWorld . terminals . ix tmid %~ updatetermsubsel
| inTermFocus w -> w
& terminals . ix tmid %~ updatetermsel
& cWorld . terminals . ix tmid %~ updatetermsel
_ -> w
where
updatetermsel tm = case tm ^? tmInput . tiSel of
@@ -134,10 +134,10 @@ wheelEvent y w = case _hudElement $ _hud w of
arg = getArguments' tc tm w' !! j
numcombs = length $ combineItemListYou w
yi = round $ signum y
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
rbDown = ButtonRight `M.member` _mouseButtons w
lbDown = ButtonLeft `M.member` _mouseButtons w
invKeyDown = ScancodeCapsLock `S.member` _keys w
numLocs = (fst . IM.findMax $ _seenLocations (_cWorld w)) + 1
rbDown = ButtonRight `M.member` _mouseButtons (_cWorld w)
lbDown = ButtonLeft `M.member` _mouseButtons (_cWorld w)
invKeyDown = ScancodeCapsLock `S.member` _keys (_cWorld w)
getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm
@@ -159,18 +159,18 @@ nullCommand = TerminalCommand
scrollRBOption :: Float -> World -> World
scrollRBOption y w
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
| y < 0 = w & cWorld . rbOptions . opSel %~ (min (length (_opEquip (_rbOptions (_cWorld w)))-1) . (+1))
| y > 0 = w & cWorld . rbOptions . opSel %~ (max 0 . subtract 1)
| otherwise = w
moveTweakSel :: Int -> World -> World
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
Just l -> w & creatures . ix (_yourID w) . crInv . ix (crSel (you w))
Just l -> w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
. itTweaks . tweakSel %~ (`mod` length l) . subtract i
_ -> w
changeTweakParam :: Int -> World -> World
changeTweakParam i w = w
& creatures . ix (_yourID w) . crInv . ix (crSel (you w)) %~
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~
( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
. doTweak (_tweakType params) x)
where
src/Dodge/Event/Keyboard.hs
+26 -26
View File
@@ -38,17 +38,17 @@ handleTextInput text u = u
& menuLayers . ix 0 . scInput %~ updateText
& updateTerminalText
where
updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of
updateTerminalText = case u ^? uvWorld . cWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | hasfocus tmid
-> uvWorld %~ \w -> guardDisconnectedID tmid w (w & terminals . ix tmid . tmInput . tiText %~ updateText)
-> uvWorld %~ \w -> guardDisconnectedID tmid w (w & cWorld . terminals . ix tmid . tmInput . tiText %~ updateText)
_ -> id
hasfocus tmid = fromMaybe False $ u ^? uvWorld . terminals . ix tmid . tmInput . tiFocus
hasfocus tmid = fromMaybe False $ u ^? uvWorld . cWorld . terminals . ix tmid . tmInput . tiFocus
updateText s = case T.unpack text of
";" -> s
_ -> s `T.append` T.toUpper text
guardDisconnectedID :: Int -> World -> World -> World
guardDisconnectedID tmid w w' = case w ^? terminals . ix tmid . tmStatus of
guardDisconnectedID tmid w w' = case w ^? cWorld . terminals . ix tmid . tmStatus of
Just TerminalReady -> w'
_ -> w
@@ -60,23 +60,23 @@ see 'handlePressedKeyInGame'.
-}
handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe)
handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
Released -> return . Just $ u & uvWorld . keys %~ S.delete scode
Released -> return . Just $ u & uvWorld . cWorld . keys %~ S.delete scode
Pressed -> handlePressedKey (keyboardEventRepeat kev) scode
(u & uvWorld . keys %~ S.insert scode)
(u & uvWorld . cWorld . keys %~ S.insert scode)
where
scode = (keysymScancode . keyboardEventKeysym) kev
handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
handlePressedKey True ScancodeBackspace u
| _backspaceTimer (_uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u
<&> _Just . uvWorld . backspaceTimer .~ 0
| otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1
| _backspaceTimer (_cWorld $ _uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u
<&> _Just . uvWorld . cWorld . backspaceTimer .~ 0
| otherwise = return $ Just $ u & uvWorld . cWorld . backspaceTimer -~ 1
handlePressedKey True _ u = return $ Just u
handlePressedKey _ scode u = case scode of
ScancodeF5 -> return . Just $ doQuicksave u
ScancodeF9 -> return . Just $ loadSaveSlot QuicksaveSlot u
ScancodeSemicolon -> return . Just $ gotoTerminal u
_ | null (_menuLayers u) -> case u ^? uvWorld . hud . hudElement . subInventory of
_ | null (_menuLayers u) -> case u ^? uvWorld . cWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u)
-> return $ uvWorld (Just . handlePressedKeyTerminal tmid scode) u
_ -> return $ (Just . handlePressedKeyInGame scode) u
@@ -91,9 +91,9 @@ handlePressedKeyInGame scode uv = case scode of
ScancodeM -> over uvWorld toggleMap uv
ScancodeR -> over uvWorld (crToggleReloading (you w)) uv
ScancodeT -> over uvWorld testEvent uv
ScancodeX -> uv & uvWorld . hud . hudElement %~ toggleTweakInv
ScancodeX -> uv & uvWorld . cWorld . hud . hudElement %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
ScancodeI -> uv & uvWorld . hud . hudElement %~ toggleInspectInv
ScancodeI -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv
_ -> uv
where
w = _uvWorld uv
@@ -101,11 +101,11 @@ handlePressedKeyInGame scode uv = case scode of
handlePressedKeyTerminal :: Int -> Scancode -> World -> World
handlePressedKeyTerminal tmid scode w = case scode of
ScancodeEscape -> w & terminals . ix tmid . tmInput . tiFocus %~ const False
ScancodeReturn -> w & terminalReturnEffect (w ^?! terminals . ix tmid)
ScancodeEscape -> w & cWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
ScancodeReturn -> w & terminalReturnEffect (w ^?! cWorld . terminals . ix tmid)
ScancodeBackspace -> w
& terminals . ix tmid . tmInput . tiText %~ doBackspace
& backspaceTimer .~ 5
& cWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace
& cWorld . backspaceTimer .~ 5
_ -> w
where
doBackspace t = case T.unsnoc t of
@@ -128,26 +128,26 @@ gotoTerminal w = case _menuLayers w of
_ -> w & menuLayers .:~ InputScreen T.empty "Enter command"
spaceAction :: World -> World
spaceAction w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . carteCenter .~ theLoc
spaceAction w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> w & cWorld . hud . carteCenter .~ theLoc
DisplayInventory NoSubInventory -> case selectedCloseObject w of
Just (_,Left flit) -> pickUpItem 0 flit w
Just (_,Right but) -> doButtonEvent (_btEvent but) but w
_ -> w
DisplayInventory DisplayTerminal {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayInventory NoSubInventory
DisplayInventory DisplayTerminal {} -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
where
theLoc = doWorldPos (fst (_seenLocations w IM.! _selLocation w)) w
theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
pauseGame :: Universe -> Universe
pauseGame = menuLayers .~ [pauseMenu]
toggleMap :: World -> World
toggleMap w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayCarte
toggleMap w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & cWorld . hud . hudElement .~ DisplayCarte
escapeMap :: World -> World
escapeMap w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
escapeMap w = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w
src/Dodge/Flame.hs
+5 -5
View File
@@ -53,8 +53,8 @@ doDamagesFL :: (Flame -> Point2 -> [Damage])
-> World
-> World
doDamagesFL fdm (p,thhit) bt = case thhit of
Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams
Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
where
dams = fdm bt p
@@ -97,7 +97,7 @@ flDamageInArea :: (Creature -> Bool) -> (Wall -> Bool) -> Flame -> World -> Worl
flDamageInArea crt wlt pt w = damwls damcrs
where
p = _flPos pt
damcrs = foldl' (flip $ \cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter crt $ _creatures w
damcrs = foldl' (flip $ \cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter crt $ _creatures (_cWorld w)
damwls w'
= foldl'
(flip $ \wl -> fst . hiteff [(p,Right wl)])
@@ -108,12 +108,12 @@ flDamageInArea crt wlt pt w = damwls damcrs
flFlicker :: Flame -> World -> World
flFlicker pt
| _flTimer pt `mod` 7 == 0 = tempLightSources
| _flTimer pt `mod` 7 == 0 = cWorld . tempLightSources
.:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_flColor pt)) (addZ 10 $ _flPos pt)
| otherwise = id
makeFlame :: Point2 -> Point2 -> World -> World
makeFlame pos vel w = w
& flames .:~ aFlameParticle t pos vel
& cWorld . flames .:~ aFlameParticle t pos vel
& randGen .~ g
where
(t,g) = randomR (99,101) (_randGen w)
src/Dodge/FloorItem.hs
+3 -3
View File
@@ -18,15 +18,15 @@ copyItemToFloor pos it = snd . copyItemToFloorID pos it
{- | Copy an item to the floor, returns the floor item's id. -}
copyItemToFloorID :: Point2 -> Item -> World -> (Int, World)
copyItemToFloorID pos it w = (,) flid $ w'
& floorItems %~ IM.insert flid theflit
& cWorld . floorItems %~ IM.insert flid theflit
& updateLocation
where
(p',w') = findWallFreeDropPoint (_dimRad $ _itDimension it) pos w
rot = fst . randomR (-pi,pi) $ _randGen w
updateLocation = case it ^? itID of
Just (Just i') -> itemPositions . ix i' .~ OnFloor flid
Just (Just i') -> cWorld . itemPositions . ix i' .~ OnFloor flid
_ -> id
flid = IM.newKey $ _floorItems w
flid = IM.newKey $ _floorItems (_cWorld w)
theflit = FlIt
{_flIt = it & itConsumption . icAmount %~ const 1
,_flItPos = p'
src/Dodge/HeldUse.hs
+4 -4
View File
@@ -360,10 +360,10 @@ overNozzles = overNozzles' . overNozzle
overNozzles' :: (Item -> Creature -> World -> Nozzle -> (World,Nozzle))
-> Item -> Creature -> World -> World
overNozzles' eff it cr w = neww & creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
overNozzles' eff it cr w = neww & cWorld . creatures . ix cid . crInv . ix i . itParams . sprayNozzles .~ newNozzles
where
cid = _crID cr
i = crSel $ _creatures w IM.! cid
i = crSel $ _creatures (_cWorld w) IM.! cid
(neww,newNozzles) = mapAccumR (eff it cr) w $ _sprayNozzles (_itParams it)
overNozzle :: (Nozzle -> Item -> Creature -> World -> World)
@@ -386,12 +386,12 @@ useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_itConsumption it)
pos = _crPos cr +.+ (_nzLength nz *.* unitVectorAtAngle (_crDir cr))
fireRemoteShell :: Item -> Creature -> World -> World
fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse)
fireRemoteShell it cr w = set (cWorld . creatures . ix cid . crInv . ix j . itUse . rUse)
(HeldExplodeRemoteShell itid i)
$ addRemRocket w'
where
(w',itid) = getHeldItemLoc cr w
i = IM.newKey $ _props w
i = IM.newKey $ _props (_cWorld w)
cid = _crID cr
addRemRocket = makeShell it cr
[ PJSetScope itid
src/Dodge/Humanoid.hs
+1 -1
View File
@@ -170,7 +170,7 @@ chooseMovementPistol' cr w = takeOneWeighted [chargeProb,retreatProb,strafeProb,
where
g = _randGen w
cpos = _crPos cr
ycr = _creatures w IM.! 0
ycr = _creatures (_cWorld w) IM.! 0
ypos = _crPos ycr
chargeProb | dist cpos ypos > 300 = 5
| dist cpos ypos > 150 = 1
src/Dodge/Initialisation.hs
+6 -19
View File
@@ -13,26 +13,13 @@ import System.Random
import qualified Data.Set as S
import qualified IntMapHelp as IM
import qualified Data.Map as M
import Control.Lens
initialWorld :: World
initialWorld = defaultWorld
{ _keys = S.empty
, _cameraCenter = V2 0 0
, _cameraRot = 0
, _cameraZoom = 10
, _creatures = IM.fromList [(0,startCr)]
, _props = IM.empty
, _walls = IM.empty
, _floorItems = IM.empty
, _randGen = mkStdGen 2
, _mousePos = V2 0 0
, _yourID = 0
, _worldEvents = SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
: [MakeStartCloudAt (V3 x y 5) | x <- [-5,-4..5] , y <- [-5,-4..5]]
, _pressPlates = IM.empty
, _buttons = IM.empty
, _toPlaySounds = M.empty
, _decorations = IM.empty
-- , _menuLayers = [TerminalScreen 300 rezText']
}
& cWorld . cameraZoom .~ 10
& cWorld . creatures .~ IM.fromList [(0,startCr)]
& cWorld . yourID .~ 0
& cWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing
: [MakeStartCloudAt (V3 x y 5) | x <- [-5,-4..5] , y <- [-5,-4..5]]
src/Dodge/InputFocus.hs
+3 -3
View File
@@ -6,7 +6,7 @@ import Data.Maybe
inTermFocus :: World -> Bool
inTermFocus w = fromMaybe False $ do
tmid <- w ^? hud . hudElement . subInventory . termID
hasfocus <- w ^? terminals . ix tmid . tmInput . tiFocus
connectionstatus <- w ^? terminals . ix tmid . tmStatus
tmid <- w ^? cWorld . hud . hudElement . subInventory . termID
hasfocus <- w ^? cWorld . terminals . ix tmid . tmInput . tiFocus
connectionstatus <- w ^? cWorld . terminals . ix tmid . tmStatus
return $ hasfocus && connectionstatus == TerminalReady
src/Dodge/Inventory.hs
+66 -61
View File
@@ -53,23 +53,24 @@ rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World
-> World
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
_ -> w & creatures . ix cid . crInv %~ f
& creatures . ix cid . crInvSel %~ stopCrInvSelAction
& creatures . ix cid . crInvSel . iselPos %~ g
& creatures . ix cid . crLeftInvSel %~ g'
rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
_ -> w
& cWorld . creatures . ix cid . crInv %~ f
& cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
& cWorld . creatures . ix cid . crInvSel . iselPos %~ g
& cWorld . creatures . ix cid . crLeftInvSel %~ g'
& removeAnySlotEquipment
& dounequipfunction
& doanyitemeffect
& creatures . ix cid . crInvEquipped %~ IM.delete invid
& creatures . ix cid . crInvEquipped %~ IM.mapKeys g
& cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
& cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
-- TODO check whether this can be mapKeysMonotonic
where
stopCrInvSelAction (InvSel i a)
| i == invid = InvSel i NoInvSelAction
| otherwise = InvSel i a
cr = _creatures w IM.! cid
cr = _creatures (_cWorld w) IM.! cid
itm = _crInv cr IM.! invid
dounequipfunction = fromMaybe id $ do
rmf <- itm ^? itUse . eqEq . eqOnRemove
@@ -77,10 +78,10 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieDrop
return $ doDropEffect rmf itm cr
removeAnySlotEquipment = case w ^? creatures . ix cid . crInvEquipped . ix invid of
Just epos -> creatures . ix cid . crEquipment . at epos .~ Nothing
removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
Nothing -> id
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld w) IM.! cid
f inv = let (xs,ys) = IM.split invid inv
in xs `IM.union` IM.mapKeys (subtract 1) ys
g x | x > invid || Just x == maxk = max 0 $ x - 1
@@ -92,7 +93,7 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
| otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures w IM.! cid)) w
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures (_cWorld w) IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
@@ -100,7 +101,7 @@ augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union
(f <$> yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w))
invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
@@ -154,18 +155,18 @@ updateTerminal :: World -> World
updateTerminal = checkTermDist
checkTermDist :: World -> World
checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do
btid <- w ^? terminals . ix tmid . tmButtonID
btpos <- w ^? buttons . ix btid . btPos
checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do
btid <- w ^? cWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . buttons . ix btid . btPos
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
Nothing -> w
-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w = w
& closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& creatures . ix (_yourID w) . crInvSel . iselPos %~ updateinvsel
& cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel
where
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
@@ -175,26 +176,26 @@ updateCloseObjects w = w
activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState)
. IM.elems
$ _buttons w
currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ _closeObjects w
$ _buttons (_cWorld w)
currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w)
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
updatebyid (Left flid) = fmap Left $ w ^? floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? buttons . ix (_btID btid)
updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid)
updateRBList :: World -> World
updateRBList w
| w ^? rbOptions . opCurInvPos == Just curinvid
| w ^? cWorld . rbOptions . opCurInvPos == Just curinvid
= w & setEquipAllocation & setEquipActivation
| otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of
Just esite -> w
& rbOptions .~ EquipOptions (equipSiteToPositions esite)
& cWorld . rbOptions .~ EquipOptions (equipSiteToPositions esite)
(chooseEquipmentPosition cr (equipSiteToPositions esite))
curinvid
DoNotMoveEquipment
NoChangeActivateEquipment
& setEquipAllocation & setEquipActivation
Nothing -> w & rbOptions .~ NoRightButtonOptions
Nothing -> w & cWorld . rbOptions .~ NoRightButtonOptions
-- | otherwise = w & rbOptions .~ NoRightButtonOptions
where
curinvid = crSel cr
@@ -211,53 +212,53 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
setEquipAllocation :: World -> World
setEquipAllocation w = case _rbOptions w of
setEquipAllocation w = case _rbOptions (_cWorld w) of
EquipOptions {_opEquip = es,_opSel=i} ->
case you w ^? crInvEquipped . ix (crSel (you w)) of
Just epos | es !! i == epos
-> w & rbOptions . opAllocateEquipment .~ RemoveEquipment
-> w & cWorld . rbOptions . opAllocateEquipment .~ RemoveEquipment
{_allocOldPos = epos}
Just epos | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ SwapEquipment
-> w & cWorld . rbOptions . opAllocateEquipment .~ SwapEquipment
{_allocOldPos = epos
,_allocNewPos = es !! i
,_allocSwapID = _crEquipment (you w) M.! (es !! i)
}
Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment
Just epos -> w & cWorld . rbOptions . opAllocateEquipment .~ MoveEquipment
{_allocOldPos = epos
,_allocNewPos = es !! i
}
Nothing | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment
-> w & cWorld . rbOptions . opAllocateEquipment .~ ReplaceEquipment
{_allocNewPos = es !! i
,_allocRemoveID = _crEquipment (you w) M.! (es !! i)
}
Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment
Nothing -> w & cWorld . rbOptions . opAllocateEquipment .~ PutOnEquipment
{_allocNewPos = es !! i}
_ -> w
-- where
-- curpos = invSelPos w
setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
setEquipActivation w = case w ^? cWorld . rbOptions . opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just RemoveEquipment { }
-> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment
Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment
{_deactivateEquipment = i}
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
_ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just rbos
-> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
{_activateEquipment = invsel,_deactivateEquipment = i}
Just i | Just i == rbos ^? allocRemoveID
-> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment
-> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment i
Just _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateEquipment
{_activateEquipment = invsel}
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where
invsel = crSel (you w)
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)
@@ -274,29 +275,32 @@ equipSiteToPositions es = case es of
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
| x > 0 = over closeObjects rotU
| x < 0 = over closeObjects rotD
| x > 0 = over (cWorld . closeObjects) rotU
| x < 0 = over (cWorld . closeObjects) rotD
| otherwise = id
changeInvSel :: Int -> World -> World
changeInvSel i w
| n == 0 = w
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n))
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
| yourInvSel w < n = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
| otherwise = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n))
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
-- arguably this should jump the invpos into the inventory proper
where
n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w
n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w)
numCO = length $ _closeObjects (_cWorld w)
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w
| n == 0 = w
| yourInvSel w < n = w
& creatures . ix (_yourID w) %~ updatecreature
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos .~ ico'
& closeObjects %~ swapIndices (i - n) (ico' - n)
& cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature
| otherwise = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico'
& cWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
where
updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
@@ -315,18 +319,19 @@ changeSwapInvSel k w
i = crSel cr
ico' = ( (i - (k+n)) `mod` numCO ) + n
n = length $ _crInv cr
numCO = length $ _closeObjects w
numCO = length $ _closeObjects (_cWorld w)
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| n == 0 = w
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
| otherwise = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
where
n = length (yourInv w) + length (_closeObjects w)
n = length (yourInv w) + length (_closeObjects (_cWorld w))
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ _closeObjects w
bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w)
where
f (Right _) = True
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
@@ -342,4 +347,4 @@ selectedCloseObject w
inv = _crInv cr
selectNthCloseObject :: World -> Int -> Maybe (Int,Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects w !? n)
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n)
src/Dodge/Inventory/Add.hs
+5 -5
View File
@@ -11,7 +11,7 @@ import qualified IntMapHelp as IM
putItemInInvID :: Int -> Int -> World -> (Maybe Int,World)
putItemInInvID cid flid w = fromMaybe (Nothing,w) $ do
(i,w') <- tryPutItemInInv cid (_floorItems w IM.! flid) w
(i,w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! flid) w
return (Just i,w')
putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
@@ -23,15 +23,15 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
Nothing -> Nothing
Just i -> Just (i, w
& updateItLocation i
& floorItems %~ IM.delete (_flItID flit)
& creatures . ix cid . crInv %~ putItemInInvSlot i it
& cWorld . floorItems %~ IM.delete (_flItID flit)
& cWorld . creatures . ix cid . crInv %~ putItemInInvSlot i it
)
where
it = _flIt flit
maybeInvSlot = checkInvSlotsYou it w
updateItLocation invid w' = case _itID it of
Nothing -> w'
Just j -> w' & itemPositions . ix j .~ InInv cid invid
Just j -> w' & cWorld . itemPositions . ix j .~ InInv cid invid
--{- | Pick up a specific item. -}
--putItemInInv :: Int -> FloorItem -> World -> World
@@ -48,5 +48,5 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
-- Nothing -> w'
-- Just j -> w' & itemPositions . ix j .~ InInv cid invid
createPutItem :: Item -> World -> (Maybe Int, World)
createPutItem it w = uncurry (putItemInInvID (_yourID w))
createPutItem it w = uncurry (putItemInInvID (_yourID (_cWorld w)))
$ copyItemToFloorID (_crPos $ you w) (applyModules it) w
src/Dodge/Inventory/Lock.hs
+2 -2
View File
@@ -3,7 +3,7 @@ import Dodge.Data
import Control.Lens
lockInv :: Int -> World -> World
lockInv cid = creatures . ix cid . crInvLock %~ (|| True)
lockInv cid = cWorld . creatures . ix cid . crInvLock %~ (|| True)
unlockInv :: Int -> World -> World
unlockInv cid = creatures . ix cid . crInvLock %~ (&& False)
unlockInv cid = cWorld . creatures . ix cid . crInvLock %~ (&& False)
src/Dodge/ItEffect.hs
+7 -7
View File
@@ -29,16 +29,16 @@ onOffEff f g it
rewindEffect :: Item -> Creature -> World -> World
rewindEffect itm cr w
| Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : ))
& ptrWpCharge .~ length (_rewindWorlds w)
| otherwise = w & rewindWorlds .~ []
| Just invid == _crLeftInvSel cr = w & cWorld . rewindWorlds %~ (take maxcharge . (w' : ))
& ptrWpCharge .~ length (_rewindWorlds (_cWorld w))
| otherwise = w & cWorld . rewindWorlds .~ []
& ptrWpCharge .~ 0
where
invid = _ipInvID $ _itPos itm
ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
maxcharge = _wpMaxCharge . _itConsumption $ itm
w' = w & rewindWorlds .~ []
& timeFlow .~ NormalTimeFlow
w' = w & cWorld . rewindWorlds .~ []
& cWorld . timeFlow .~ NormalTimeFlow
resetAttachmentEffect :: Item -> Creature -> World -> World
resetAttachmentEffect itm cr w
@@ -47,7 +47,7 @@ resetAttachmentEffect itm cr w
where
iteff = _itEffect itm
invid = _ipInvID $ _itPos itm
pointToIt = creatures . ix (_crID cr) . crInv . ix invid
pointToIt = cWorld . creatures . ix (_crID cr) . crInv . ix invid
createHeldLight :: Item -> Creature -> World -> World
createHeldLight itm cr = createTorchLightOffset cr itm 0
src/Dodge/Item/Attachment.hs
+2 -2
View File
@@ -15,8 +15,8 @@ import qualified IntMapHelp as IM
charFiringStratI
:: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
-> ChainEffect
charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv
. ix (crSel $ _creatures w IM.! cid) . itAttachment . atCharMode of
charFiringStratI strats eff item cr w = case w ^? cWorld . creatures . ix cid . crInv
. ix (crSel $ _creatures (_cWorld w) IM.! cid) . itAttachment . atCharMode of
Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
_ -> w
where
src/Dodge/Item/Consumable.hs
+3 -3
View File
@@ -24,8 +24,8 @@ medkit i = defaultConsumable
heal25 :: Int -> World -> Maybe World
heal25 = heal 25
heal :: Int -> Int -> World -> Maybe World
heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing
heal hp n w | _crHP (_creatures (_cWorld w) IM.! n) >= 10000 = Nothing
| otherwise = Just $ soundStart (CrSound $ _crID cr) (_crPos cr) healS Nothing w
& creatures . ix n . crHP %~ min 10000 . (+ hp)
& cWorld . creatures . ix n . crHP %~ min 10000 . (+ hp)
where
cr = _creatures w IM.! n
cr = _creatures (_cWorld w) IM.! n
src/Dodge/Item/Equipment.hs
+10 -10
View File
@@ -51,7 +51,7 @@ magShield = defaultEquipment
& itUse . eqEq . eqSite .~ GoesOnWrist
& itType . iyBase .~ EQUIP MAGSHIELD
useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & magnets . at mgid ?~ themagnet
useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
where
themagnet = Magnet
{_mgID = mgid
@@ -61,7 +61,7 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet
}
mgid = case it ^? itAttachment . atMInt . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets w
Nothing -> IM.newKey $ _magnets (_cWorld w)
-- it = _crInv cr IM.! invid
flameShield :: Item
@@ -89,15 +89,15 @@ wristArmour = defaultEquipment
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w = w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
& walls . at i ?~ forceField {_wlID = i}
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
& cWorld . walls . at i ?~ forceField {_wlID = i}
& setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
where
i = IM.newKey (_walls w)
i = IM.newKey (_walls (_cWorld w))
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm cr w = w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
& deleteWallID i
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
@@ -168,7 +168,7 @@ shieldWall crid = defaultWall
createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
in w' & creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
Just wid -> moveWallID wid wlline w
where
invid = fromJust $ _itID it
@@ -185,7 +185,7 @@ removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> w
Just wid -> w & deleteWallID wid
& creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
& cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
where
crid = _crID cr
invid = fromJust (_itID it)
@@ -241,7 +241,7 @@ headLamp = defaultEquipment
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
createHeadLamp _ cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
powerLegs :: Item
@@ -268,4 +268,4 @@ wristInvisibility = defaultEquipment
& itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = creatures . ix (_crID cr) %~ f
overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
src/Dodge/Item/Equipment/Booster.hs
+3 -3
View File
@@ -40,10 +40,10 @@ boostSelfL x itm cr w = case boostPoint x cr w of
cid = _crID cr
cpos = _crPos cr
r = _crRad cr
pid = fromMaybe (IM.newKey $ _props w)
pid = fromMaybe (IM.newKey $ _props (_cWorld w))
(cr ^? crInv . ix invid . itAttachment . atInt)
crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
& creatures . ix cid %~
& cWorld . creatures . ix cid %~
(crPos .~ p)
. (crInv . ix invid %~
ammoEff
@@ -57,7 +57,7 @@ addBoostShockwave
-> Point2
-> World
-> World
addBoostShockwave pjid p v w = w & linearShockwaves %~
addBoostShockwave pjid p v w = w & cWorld . linearShockwaves %~
IM.insertWith f pjid thePJ
where
thePJ = LinearShockwave
src/Dodge/Item/Location.hs
+8 -8
View File
@@ -11,27 +11,27 @@ setHeldItemLoc cr = fst . getHeldItemLoc cr
getHeldItemLoc :: Creature -> World -> (World,Int)
getHeldItemLoc cr w = case maybeitid of
Nothing ->
( w & creatures . ix cid . crInv . ix j . itID ?~ newitid
& itemPositions %~ IM.insert newitid (InInv cid j)
( w & cWorld . creatures . ix cid . crInv . ix j . itID ?~ newitid
& cWorld . itemPositions %~ IM.insert newitid (InInv cid j)
, itid)
_ -> (w, itid)
where
cid = _crID cr
j = crSel cr
newitid = IM.newKey $ _itemPositions w
newitid = IM.newKey $ _itemPositions (_cWorld w)
maybeitid = cr ^? crInv . ix j . itID . _Just
itid = fromMaybe newitid maybeitid
getItem :: Int -> World -> Maybe Item
getItem itid w = do
itpos <- w ^? itemPositions . ix itid
itpos <- w ^? cWorld . itemPositions . ix itid
case itpos of
OnFloor flitid -> w ^? floorItems . ix flitid . flIt
InInv cid invid -> w ^? creatures . ix cid . crInv . ix invid
OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt
InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid
VoidItm -> Nothing
pointToItem :: Applicative f =>
ItemPos -> (Item -> f Item) -> World -> f World
pointToItem (InInv cid invid) = creatures . ix cid . crInv . ix invid
pointToItem (OnFloor flid) = floorItems . ix flid . flIt
pointToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointToItem _ = const pure
src/Dodge/Item/Weapon/BatteryGuns.hs
+6 -6
View File
@@ -276,14 +276,14 @@ tractorGunTweak = TweakParam
-- | assumes that the item is held
shootTeslaArc :: Item -> Creature -> World -> World
shootTeslaArc it cr w = w'
& creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
& cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
where
(w',ip) = shootTeslaArc' (_itParams it) pos dir w
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
dir = _crDir cr
shootLaser :: Item -> Creature -> World -> World
shootLaser it cr = lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
shootLaser it cr = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
where
pos = _crPos cr
dir = _crDir cr
@@ -294,7 +294,7 @@ shootLaser it cr = lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos
circleLaser :: Item -> Creature -> World -> World
circleLaser it cr w
| hasLOSIndirect cpos pos w = w
& lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
& cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
| otherwise = w
where
cpos = _crPos cr
@@ -306,8 +306,8 @@ circleLaser it cr w
shootDualLaser :: Item -> Creature -> World -> World
shootDualLaser it cr w = w'
& newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
& newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
& cWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
& cWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
where
(w',itid) = getHeldItemLoc cr w
dir = _crDir cr
@@ -346,7 +346,7 @@ dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev p
& bmType .~ bt
aTractorBeam :: Item -> Creature -> World -> World
aTractorBeam _ cr w = w & tractorBeams .:~ tractorBeamAt spos outpos dir power
aTractorBeam _ cr w = w & cWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
where
cpos = _crPos cr
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
src/Dodge/Item/Weapon/ExtraEffect.hs
+8 -8
View File
@@ -38,11 +38,11 @@ import qualified SDL
autoEffect :: (Item -> Creature -> World -> World) -> Int -> SoundID -> Item -> Creature -> World -> World
autoEffect eff t sid itm cr w
| _eparamInt (_eqParams (_eqEq $ _itUse itm)) < 1 = eff itm cr w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
. itUse . eqEq . eqParams . eparamInt .~ t
& soundStart OnceSound (_crPos cr) sid Nothing
| otherwise = w
& creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
. itUse . eqEq . eqParams . eparamInt -~ 1
{- | Automatically send out radar pulses that detect walls. -}
@@ -83,7 +83,7 @@ targetRBCreatureUp it cr w t
& tgPos .~ Nothing
& tgActive .~ False
)
| SDL.ButtonRight `M.member` _mouseButtons w && isJust (t ^? tgID . _Just)
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) && isJust (t ^? tgID . _Just)
&& canSeeTarget = (w, t & updatePos
& tgActive .~ True
)
@@ -99,10 +99,10 @@ targetRBCreatureUp it cr w t
mwp = mouseWorldPos w
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? creatures . ix i . crPos
posFromMaybeID (Just i) = w ^? cWorld . creatures . ix i . crPos
canSeeTarget = fromMaybe False $ do
cid <- t ^? tgID . _Just
cpos <- w ^? creatures . ix cid . crPos
cpos <- w ^? cWorld . creatures . ix cid . crPos
Just $ hasLOS cpos (_crPos cr) w
targetUpdateWith :: (World -> Targeting -> Targeting)
@@ -113,7 +113,7 @@ targetUpdateWith f it _ w t
targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons w = t
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t
& tgPos . _Just .~ mouseWorldPos w
& tgActive .~ True
| otherwise = t & tgPos %~ const Nothing
@@ -121,7 +121,7 @@ targetCursorUpdate w t
targetRBPressUpdate :: World -> Targeting -> Targeting
targetRBPressUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons w = t
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w) = t
& tgPos %~ maybe (Just $ mouseWorldPos w) Just
& tgActive .~ True
| otherwise = t & tgPos %~ const Nothing
@@ -140,7 +140,7 @@ targetLaserUpdate _ cr w t
(mp, _) = reflectLaserAlong 0.2 sp ep w
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
addLaserPic = lasers .:~ LaserStart
addLaserPic = cWorld . lasers .:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
src/Dodge/Item/Weapon/Launcher.hs
+4 -4
View File
@@ -99,12 +99,12 @@ explodeRemoteRocket
-> World
-> World
explodeRemoteRocket itid pjid w = w
& projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
& projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
& cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& itPoint . itUse . rUse .~ HeldDoNothing
& usePayload (_prjPayload thepj) (_prjPos thepj)
where
itPoint = pointToItem $ _itemPositions w IM.! itid
thepj = _projectiles w IM.! pjid
itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
thepj = _projectiles (_cWorld w) IM.! pjid
src/Dodge/Item/Weapon/Remote.hs
+7 -7
View File
@@ -12,17 +12,17 @@ import qualified IntMapHelp as IM
import Control.Lens
setRemoteBombScope :: Int -> Prop -> World -> World
setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of
setRemoteBombScope itid pj w' = case _itemPositions (_cWorld w') IM.! itid of
InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itScope
. scopePos .~ (_prPos pj -.- _crPos (_creatures w' IM.! cid))
& creatures . ix cid . crInv . ix invid . itUse . useAim . aimZoom
-> w' & cWorld . creatures . ix cid . crInv . ix invid . itScope
. scopePos .~ (_prPos pj -.- _crPos (_creatures (_cWorld w') IM.! cid))
& cWorld . creatures . ix cid . crInv . ix invid . itUse . useAim . aimZoom
.~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
_ -> w'
setRemoteScope :: Int -> Point2 -> World -> World
setRemoteScope itid pos w' = case w' ^? itemPositions . ix itid of
setRemoteScope itid pos w' = case w' ^? cWorld . itemPositions . ix itid of
Just (InInv cid' invid )
-> w' & creatures . ix cid' . crInv . ix invid . itScope
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid'))
-> w' & cWorld . creatures . ix cid' . crInv . ix invid . itScope
. scopePos .~ (pos -.- _crPos (_creatures (_cWorld w') IM.! cid'))
_ -> w'
src/Dodge/Item/Weapon/Shell.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Geometry.Vector
import Control.Lens
decTimMvVel :: Proj -> World -> World
decTimMvVel pj = projectiles . ix pjid %~
decTimMvVel pj = cWorld . projectiles . ix pjid %~
( (prjTimer -~ 1)
. (prjPos %~ (+.+ vel) )
. (prjAcc %~ rotateV rot )
src/Dodge/Item/Weapon/Spawn.hs
+2 -2
View File
@@ -24,9 +24,9 @@ spawnCrNextTo
-> Creature -- ^ existing creature that will be spawned next to
-> World
-> World
spawnCrNextTo cr sCr w = w & creatures %~ IM.insert k newCr
spawnCrNextTo cr sCr w = w & cWorld . creatures %~ IM.insert k newCr
where
k = IM.newKey $ _creatures w
k = IM.newKey $ _creatures (_cWorld w)
newCr = cr
& crID .~ k
& crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
src/Dodge/Item/Weapon/TriggerType.hs
+30 -30
View File
@@ -95,7 +95,7 @@ type ChainEffect
-> World
lockInvFor :: Int -> ChainEffect
lockInvFor i f it cr = f it cr . (delayedEvents .:~ (i, UnlockInv (_crID cr)))
lockInvFor i f it cr = f it cr . (cWorld . delayedEvents .:~ (i, UnlockInv (_crID cr)))
. lockInv (_crID cr)
trigDoAlso'
@@ -139,7 +139,7 @@ withThickSmokeI eff item cr w = eff item cr
ammoCheckI :: ChainEffect
ammoCheckI eff itm cr w
| _laLoaded ic <= 0 || not (_laPrimed ic) = w
| otherwise = eff itm cr $ w & creatures . ix (_crID cr) %~ crCancelReloading
| otherwise = eff itm cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
where
ic = _itConsumption itm
@@ -149,7 +149,7 @@ ammoHammerCheck :: ChainEffect
ammoHammerCheck eff it cr w
| _laLoaded ic <= 0 || not (_laPrimed ic) = w -- fromMaybe w (startReloadingWeapon cr w)
| otherwise = case it ^? itUse . useHammer of
Just HammerUp -> eff it cr $ w & creatures . ix (_crID cr) %~ crCancelReloading
Just HammerUp -> eff it cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
_ -> w
where
ic = _itConsumption it
@@ -184,7 +184,7 @@ rateIncAB exeffFirst exeffCont eff item cr w
startRate = _rateMaxMax . _useDelay $ _itUse item
cid = _crID cr
itRef = crSel cr
pointItem = creatures . ix cid . crInv . ix itRef
pointItem = cWorld . creatures . ix cid . crInv . ix itRef
currentRate = _rateMax (_useDelay (_itUse item))
repeatFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 1
firstFire = crWeaponReady cr && _rateTime (_useDelay (_itUse item)) == 0
@@ -203,7 +203,7 @@ withWarmUp soundID f item cr w
where
cid = _crID cr
itRef = crSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef
pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
curWarmUp = _warmTime . _useDelay $ _itUse item
maxWarmUp = _warmMax . _useDelay $ _itUse item
withSoundItemChoiceStart
@@ -259,12 +259,12 @@ withSoundForVol vol soundid playTime f item cr
afterRecoil
:: Float -- ^ Recoil amount
-> ChainEffect
afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (creatures . ix cid) pushback
afterRecoil recoilAmount eff item cr = eff item (pushback cr) . over (cWorld . creatures . ix cid) pushback
where
cid = _crID cr
pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((-recoilAmount) / _crMass cr ) 0))
withRecoil :: ChainEffect
withRecoil eff it cr = eff it cr . over (creatures . ix cid) pushback
withRecoil eff it cr = eff it cr . over (cWorld . creatures . ix cid) pushback
where
cid = _crID cr
recoilAmount = fromMaybe 0 $ it ^? itParams . recoil
@@ -275,7 +275,7 @@ withSidePushI
:: Float -- ^ Maximal possible side push amount
-> ChainEffect
withSidePushI maxSide eff item cr w = eff item (push cr) $ w
& creatures . ix cid %~ push
& cWorld . creatures . ix cid %~ push
& randGen .~ g
where
cid = _crID cr
@@ -287,7 +287,7 @@ Applied after the underlying effect. -}
withSidePushAfterI
:: Float -- ^ Maximal possible side push amount
-> ChainEffect
withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff item cr $ w
withSidePushAfterI maxSide eff item cr w = over (cWorld . creatures . ix cid) push . eff item cr $ w
& randGen .~ g
where
cid = _crID cr
@@ -295,14 +295,14 @@ withSidePushAfterI maxSide eff item cr w = over (creatures . ix cid) push . eff
(pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w
useAllAmmo :: ChainEffect
useAllAmmo eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0)
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0)
useAmmoUpTo :: Int -> ChainEffect
useAmmoUpTo amAmount eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded
%~ (max 0 . subtract amAmount))
useAmmoAmount :: Int -> ChainEffect
useAmmoAmount amAmount eff item cr = eff item cr
. (creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount)
. (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount)
{- |
Applies a world effect after an item use cooldown check. -}
useTimeCheck :: ChainEffect
@@ -311,7 +311,7 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of
_ -> w
where
cid = _crID cr
setUseTime = creatures . ix cid . crInv . ix (crSel cr) . itUse . useDelay . rateTime +~ userate
setUseTime = cWorld . creatures . ix cid . crInv . ix (crSel cr) . itUse . useDelay . rateTime +~ userate
userate = fromMaybe 0 $ item ^? itUse . useDelay . rateMax
{- | Applies a world effect after a hammer position check. -}
hammerCheckI :: ChainEffect
@@ -332,7 +332,7 @@ ammoUseCheck f item cr w
where
cid = _crID cr
itRef = crSel cr
pointerToItem = creatures . ix cid . crInv . ix itRef
pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
fireCondition = crWeaponReady cr
&& _rateTime (_useDelay (_itUse item)) == 0
&& _laLoaded (_itConsumption item) > 0
@@ -364,7 +364,7 @@ shootL f item cr w
where
cid = _crID cr
invid = _ipInvID $ _itPos item
pointerToItem = creatures . ix cid . crInv . ix invid
pointerToItem = cWorld . creatures . ix cid . crInv . ix invid
fireCondition = _rateTime (_useDelay (_itUse item)) == 0
&& _arLoaded (_itConsumption item) > 0
-- reloadCondition = _laLoaded (_itConsumption item) == 0
@@ -373,20 +373,20 @@ withItem g f it = g it f it
-- not ideal
withItemUpdate' :: (Item -> Item) -> ChainEffect
withItemUpdate' up f it cr = f (up it) cr . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
withItemUpdate' up f it cr = f (up it) cr . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
withItemUpdate :: (Item -> Item) -> (Item -> ChainEffect) -> ChainEffect
withItemUpdate up g f it cr = g it f it cr . (creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
withItemUpdate up g f it cr = g it f it cr . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) %~ up)
withTempLight :: Int -> Float -> V3 Float -> ChainEffect
withTempLight time rad col eff item cr = eff item cr
. over tempLightSources (theTLS :)
. over (cWorld . tempLightSources) (theTLS :)
where
theTLS = tlsTimeRadColPos time rad col (V3 x y 10)
V2 x y = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
modClock :: Int -> ChainEffect -> ChainEffect
modClock n chainEff eff it cr w
| _worldClock w `mod` n == 0 = chainEff eff it cr w
| _worldClock (_cWorld w) `mod` n == 0 = chainEff eff it cr w
| otherwise = eff it cr w
withMuzFlareI :: ChainEffect
@@ -491,9 +491,9 @@ torqueBefore
torqueBefore torque feff item cr w
| cid == 0 = feff item (cr & crDir +~ rot) $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot
& cameraRot +~ rot
| otherwise = feff item cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot) w
& cWorld . creatures . ix cid . crDir +~ rot
& cWorld . cameraRot +~ rot
| otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) w
where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w
@@ -506,9 +506,9 @@ torqueBeforeAtLeast
torqueBeforeAtLeast minTorque exTorque feff item cr w
| cid == 0 = feff item (cr & crDir +~ rot') $ w
& randGen .~ g
& creatures . ix cid . crDir +~ rot'
& cameraRot +~ rot'
| otherwise = feff item cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
& cWorld . creatures . ix cid . crDir +~ rot'
& cWorld . cameraRot +~ rot'
| otherwise = feff item cr $ set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot') w
where
cid = _crID cr
(rot, g) = randomR (-exTorque,exTorque) $ _randGen w
@@ -518,8 +518,8 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
withTorqueAfter :: ChainEffect
withTorqueAfter feff item cr w
-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
| cid == 0 = set randGen g $ over cameraRot (+rot) $ feff item cr w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff item cr w
| cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) $ feff item cr w
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) $ feff item cr w
where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w
@@ -547,12 +547,12 @@ sideEffectOnFrame :: Int
-> (Item -> Creature -> WdWd)
-> ChainEffect
sideEffectOnFrame i sf f it cr w = f it cr w
& delayedEvents .:~ (i, sf it cr)
& cWorld . delayedEvents .:~ (i, sf it cr)
torqueSideEffect :: Float -> Item -> Creature -> World -> World
torqueSideEffect torque _ cr w
| cid == 0 = set randGen g $ over cameraRot (+rot) w
| otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) w
| cid == 0 = set randGen g $ over (cWorld . cameraRot) (+rot) w
| otherwise = set randGen g $ over (cWorld . creatures . ix cid . crDir) (+rot) w
where
cid = _crID cr
(rot, g) = randomR (-torque,torque) $ _randGen w
src/Dodge/Item/Weapon/Utility.hs
+3 -3
View File
@@ -90,11 +90,11 @@ useForceFieldGun itm cr w = fromMaybe w $ do
b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
wlline = (a,b)
return $ w
& walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i}
& creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
& cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i}
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls w)) $ itm ^? itParams . paramMID . _Just
i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just
-- grapGun = defaultGun
-- { _itName = "grapGun"
src/Dodge/Lampoid.hs
+5 -5
View File
@@ -10,16 +10,16 @@ import LensHelp
import qualified IntMapHelp as IM
updateLampoid :: Creature -> World -> World
updateLampoid cr w = case cr ^?! crType . lampLSID of
Nothing -> let i = IM.newKey (_lightSources w)
in w & lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
Nothing -> let i = IM.newKey (_lightSources (_cWorld w))
in w & cWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
Just i
| _crHP cr < 0 -> w
& explosionFlashAt cpos
& originsIDsAt [MaterialSound Glass n | n <- [0,1,2]] (destroyMatS Glass) cpos
& lightSources . at i .~ Nothing
& creatures . at cid .~ Nothing
& cWorld . lightSources . at i .~ Nothing
& cWorld . creatures . at cid .~ Nothing
| otherwise -> w
& lightSources . ix i . lsParam . lsPos .~ addZ h cpos
& cWorld . lightSources . ix i . lsParam . lsPos .~ addZ h cpos
& doDamage cr
where
cpos = _crPos cr
src/Dodge/Layout.hs
+10 -11
View File
@@ -41,12 +41,11 @@ generateLevelFromRoomList gr' w = over gwWorld initWallZoning
. doIndividualPlacements
. setFloors
. worldToGenWorld rs'
$ w { _walls = wallsFromRooms rs
, _gameRooms = gameRoomsFromRooms (IM.elems rs')
, _pathGraph = path
}
& pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
& peZoning .~ foldl' (flip zonePe) mempty (labEdges path)
$ w & cWorld . walls .~ wallsFromRooms rs
& cWorld . gameRooms .~ gameRoomsFromRooms (IM.elems rs')
& cWorld . pathGraph .~ path
& cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
& cWorld . peZoning .~ foldl' (flip zonePe) mempty (labEdges path)
where
(_,path) = pairsToGraph pairPath'
pairPath = foldMap _rmPath rs
@@ -55,10 +54,10 @@ generateLevelFromRoomList gr' w = over gwWorld initWallZoning
rs'= mapM shuffleRoomPos gr' & evalState $ _randGen w
randomCompass :: World -> World
randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
randomCompass w = w & cWorld . cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
putFloorTiles :: GenWorld -> GenWorld
putFloorTiles gw = gw & gwWorld . floorTiles .~ floorsFromGenWorld gw
putFloorTiles gw = gw & gwWorld . cWorld . floorTiles .~ floorsFromGenWorld gw
setFloors :: GenWorld -> GenWorld
setFloors = putFloorTiles . setTiles
@@ -124,7 +123,7 @@ doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
setupWorldBounds :: World -> World
setupWorldBounds w = w & worldBounds %~
setupWorldBounds w = w & cWorld . worldBounds %~
( (bdMinX .~ f minx)
. (bdMaxX .~ f maxx)
. (bdMinY .~ f miny)
@@ -132,7 +131,7 @@ setupWorldBounds w = w & worldBounds %~
)
where
f = fromMaybe 0
ps = IM.map (fst . _wlLine) $ _walls w
ps = IM.map (fst . _wlLine) $ _walls (_cWorld w)
(minx,maxx,miny,maxy) = L.fold ((,,,)
<$> L.premap fstV2 L.minimum
<*> L.premap fstV2 L.maximum
@@ -144,7 +143,7 @@ setupWorldBounds w = w & worldBounds %~
--polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges
initWallZoning :: World -> World
initWallZoning w = foldl' (flip insertWallInZones) (w & wlZoning .~ IM.empty) (_walls w)
initWallZoning w = foldl' (flip insertWallInZones) (w & cWorld . wlZoning .~ IM.empty) (_walls (_cWorld w))
--makePath :: Tree Room -> [(Point2,Point2)]
--makePath = concatMap _rmPath . flatten
src/Dodge/LevelGen.hs
+3 -3
View File
@@ -29,17 +29,17 @@ generateWorldFromSeed i = do
return -- $ saveLevelStartSlot
$ postGenerationProcessing
$ _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i})
& roomClipping .~ bounds
& cWorld . roomClipping .~ bounds
postGenerationProcessing :: World -> World
postGenerationProcessing w = foldl' assignPushDoors w (_doors w)
postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))
generateGraphs :: IO ()
generateGraphs = TIO.writeFile "graph/itemCombinations.gv" combinationsDotGraph
assignPushDoors :: World -> Door -> World
assignPushDoors w dr = case dr ^?! drPushedBy of
PushedBy i -> w & doors . ix i . drPushes ?~ _drID dr
PushedBy i -> w & cWorld . doors . ix i . drPushes ?~ _drID dr
_ -> w
layoutLevelFromSeed :: Int -> Int -> IO (IM.IntMap Room,[ConvexPoly])
src/Dodge/LevelGen/LevelStructure.hs
+1 -1
View File
@@ -18,7 +18,7 @@ import qualified Data.Map.Strict as M
worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
worldToGenWorld rms w = GenWorld
{ _gwWorld = w & genParams .~ evalState generateGenParams (_randGen w)
{ _gwWorld = w & cWorld . genParams .~ evalState generateGenParams (_randGen w)
, _genRooms = rms
, _genPlacements = mempty
}
src/Dodge/LightSource.hs
+4 -4
View File
@@ -84,19 +84,19 @@ tlsTimeRadColPos t rmax col (V3 x y z) = TLS
}
makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World
makeTlsTimeRadColPos i rad (V3 r g b) p = tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p
makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p
destroyLS :: Int -> World -> World
destroyLS lsid w = w
& lightSources . at lsid .~ Nothing
& cWorld . lightSources . at lsid .~ Nothing
& destroyLSFlashAt p3
& originsIDsAt [MaterialSound Glass n | n <- [0,1,2]] (destroyMatS Glass) (xyV3 p3)
where
ls = w ^?! lightSources . ix lsid
ls = w ^?! cWorld . lightSources . ix lsid -- unsafe
p3 = _lsPos $ _lsParam ls
destroyLSFlashAt :: Point3 -> World -> World
destroyLSFlashAt (V3 x' y' z') = tempLightSources .:~ tlsTimeRadFunPos 20 150
destroyLSFlashAt (V3 x' y' z') = cWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150
(TLSFade 1 10)
(addZ z' p)
where
src/Dodge/LightSource/Torch.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Dodge.Item.Draw -- heldItemOffset needs to be moved somewhere more sensi
import Dodge.LightSource -- this needs to be split!
createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World
createTorchLightOffset cr it off = tempLightSources .:~ tlsTimeRadColPos 1 250 0.7
createTorchLightOffset cr it off = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 250 0.7
(p +.+.+ rotate3 (_crDir cr) (heldItemOffset it cr (off +.+.+ V3 8 0 1.5)))
where
p = addZ 0 $ _crPos cr
src/Dodge/LinearShockwave/Update.hs
+2 -2
View File
@@ -7,8 +7,8 @@ import Control.Lens
updateLinearShockwave :: LinearShockwave -> World -> World
updateLinearShockwave lw w
| t < 1 = w & linearShockwaves %~ IM.delete lwid
| otherwise = w & linearShockwaves . ix lwid . lwTimer -~ 1
| t < 1 = w & cWorld . linearShockwaves %~ IM.delete lwid
| otherwise = w & cWorld . linearShockwaves . ix lwid . lwTimer -~ 1
where
lwid = _lwID lw
t = _lwTimer lw
src/Dodge/Luse.hs
+5 -5
View File
@@ -16,18 +16,18 @@ useL lu = case lu of
LBoost -> boostSelfL 10
useRewindGun :: Item -> Creature -> World -> World
useRewindGun _ _ w = case _rewindWorlds w of
useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
[w'] -> rewindusing w' [w']
(w':ws) -> rewindusing w' ws
_ -> w
where
rewindusing w' ws = w
& maybeWorld .~ Just' ( w'
& cWorld . maybeWorld .~ Just' ( w'
-- & creatures . ix (_crID cr) .~ cr
& upbuts
& rewindWorlds .~ ws
& cWorld . rewindWorlds .~ ws
)
upbuts = (keys .~ _keys w) . (mouseButtons .~ _mouseButtons w)
upbuts = (cWorld . keys .~ _keys (_cWorld w)) . (cWorld . mouseButtons .~ _mouseButtons (_cWorld w))
-- be careful changing this around; potential problems include updating the
-- creature but using the old crInvSel value
@@ -39,5 +39,5 @@ useShrinkGun it cr w = if _atBool $ _itAttachment it
where
invid = _ipInvID $ _itPos it
tryResize x g = maybe w g $ sizeSelf x cr w
f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix invid %~
f isInUse cstatus = cWorld . creatures . ix (_crID cr) . crInv . ix invid %~
( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) )
src/Dodge/Machine.hs
+4 -4
View File
@@ -19,9 +19,9 @@ machineUpdateLiveDieEff
-> Machine -> World -> World
machineUpdateLiveDieEff livef dief mc
| _mcHP mc < 1 = dief mc
. (machines %~ IM.delete mcid)
. (cWorld . machines %~ IM.delete mcid)
. deleteWallIDs (_mcWallIDs mc)
| otherwise = livef mc . (machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ))
| otherwise = livef mc . (cWorld . machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ))
where
dams = sum $ map _dmAmount $ _mcDamage mc
mcid = _mcID mc
@@ -30,9 +30,9 @@ machineUpdateDeathEff :: (Machine -> World -> World)
-> Machine -> World -> World
machineUpdateDeathEff f mc
| _mcHP mc < 1 = f mc
. (machines %~ IM.delete mcid)
. (cWorld . machines %~ IM.delete mcid)
. deleteWallIDs (_mcWallIDs mc)
| otherwise = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )
| otherwise = cWorld . machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )
where
dams = sum $ map _dmAmount $ _mcDamage mc
mcid = _mcID mc
src/Dodge/Machine/Damage.hs
+1 -1
View File
@@ -3,7 +3,7 @@ import Dodge.Data
import LensHelp
basicMachineApplyDamage :: Machine -> World -> World
basicMachineApplyDamage mc = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )
basicMachineApplyDamage mc = cWorld . machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )
where
dams = sum $ map _dmAmount $ _mcDamage mc
mcid = _mcID mc
src/Dodge/Machine/Destroy.hs
+3 -3
View File
@@ -9,7 +9,7 @@ import Data.Maybe
import qualified IntMapHelp as IM
destroyMachine :: Machine -> World -> World
destroyMachine mc = (machines %~ IM.delete (_mcID mc))
destroyMachine mc = (cWorld . machines %~ IM.delete (_mcID mc))
. deleteWallIDs (_mcWallIDs mc)
. makeExplosionAt (_mcPos mc)
. mcKillTerm mc
@@ -18,11 +18,11 @@ destroyMachine mc = (machines %~ IM.delete (_mcID mc))
mcKillTerm :: Machine -> World -> World
mcKillTerm mc w = fromMaybe w $ do
tmid <- mc ^? mcMounts . ix ObTerminal
tm <- w ^? terminals . ix tmid
tm <- w ^? cWorld . terminals . ix tmid
return $ w
& doTmWdWd (_tmDeathEffect tm) tm
mcKillBut :: Machine -> World -> World
mcKillBut mc w = fromMaybe w $ do
btid <- mc ^? mcMounts . ix ObButton
return $ w & buttons . at btid .~ Nothing
return $ w & cWorld . buttons . at btid .~ Nothing
src/Dodge/Machine/Update.hs
+21 -21
View File
@@ -34,7 +34,7 @@ mcTurretUpdate mc = case _mcType mc of
-- this needs a major cleanup
updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w
| _mcHP mc < 1 = w & machines %~ IM.delete mcid
| _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
@@ -47,12 +47,12 @@ updateTurret rotSpeed mc w
where
deleteHomonculus = case _tuMCrID (_mcType mc) of
Nothing -> id
Just cid -> creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid
& creatures . at cid ?~ thecreature
Just cid -> cWorld . creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& cWorld . creatures . at cid ?~ thecreature
where
cid = IM.newKey (_creatures w')
cid = IM.newKey (_creatures (_cWorld w'))
thecreature = defaultCreature
& crID .~ cid
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
@@ -65,9 +65,9 @@ updateTurret rotSpeed mc w
& crStance . posture .~ Aiming
& crMaterial .~ Crystal
Just cid -> w'
& creatures . ix cid . crPos .~ mcpos
& creatures . ix cid . crDir .~ mcdir
dodamage = machines . ix mcid %~
& cWorld . creatures . ix cid . crPos .~ mcpos
& cWorld . creatures . ix cid . crDir .~ mcdir
dodamage = cWorld . machines . ix mcid %~
( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
. (mcHP -~ dam)
)
@@ -78,7 +78,7 @@ updateTurret rotSpeed mc w
| _tuFireTime (_mcType mc) > 0
= fromMaybe id $ do
cid <- _tuMCrID (_mcType mc)
return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
| otherwise = id
mcid = _mcID mc
ypos = _crPos $ you w
@@ -89,18 +89,18 @@ updateTurret rotSpeed mc w
dam = sum $ map _dmAmount dams
elecDam = sum $ map _dmAmount elecDams
doTurn
| seesYou = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| otherwise = id
closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
updateFiringStatus
| closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
| closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
mcSensorTriggerUpdate :: Machine -> World -> World
mcSensorTriggerUpdate mc = fromMaybe id $ do
trid <- mc ^? mcMounts . ix ObTrigger
bval <- mcTriggerVal mc
return $ triggers . ix trid .~ bval
return $ cWorld . triggers . ix trid .~ bval
mcTriggerVal :: Machine -> Maybe Bool
mcTriggerVal mc = case mc ^. mcSensor of
@@ -119,7 +119,7 @@ mcPlaySound mc w = case _mcCloseSound mc of
mcApplyDamage :: [Damage] -> Machine -> World -> World
mcApplyDamage ds mc = case _mcSensor mc of
NoSensor -> machines . ix (_mcID mc) %~
NoSensor -> cWorld . machines . ix (_mcID mc) %~
( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
_ -> id
@@ -137,12 +137,12 @@ mcProximitySensorUpdate mc w = case
, dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
(_,True,_,_) -> w
(_,False,True,True) -> w
& machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
& cWorld . machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
& playsound dedaS
& machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
& cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(NotClose,_,False,True) -> w & playsound dedumS
& machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
& cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
(_,_,_,False) -> w & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
_ -> w
where
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
@@ -158,7 +158,7 @@ mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
cr = you w
senseDamage :: DamageType -> Machine -> World -> World
senseDamage dt mc = (machines . ix mcid %~ upmc)
senseDamage dt mc = (cWorld . machines . ix mcid %~ upmc)
. updatels
where
upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
@@ -167,7 +167,7 @@ senseDamage dt mc = (machines . ix mcid %~ upmc)
ni = fromIntegral (_sensAmount $ _mcSensor mc) / 1000
updatels = fromMaybe id $ do
lsid <- mc ^? mcMounts . ix ObLightSource
return $ lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
return $ cWorld . lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni
damageUsing :: DamageType -> Damage -> Either Int Int
damageUsing dt dm
src/Dodge/ModificationEffect.hs
+2 -2
View File
@@ -7,11 +7,11 @@ import Control.Lens
doModificationEffect :: MdWdWd -> Modification -> World -> World
doModificationEffect mww = case mww of
MdWdId -> const id
MdTrigIf ftrue ffalse -> \md w -> if w ^?! triggers . ix (_mdExternalID2 md)
MdTrigIf ftrue ffalse -> \md w -> if w ^?! cWorld . triggers . ix (_mdExternalID2 md)
then w & doModificationEffect ftrue md
else w & doModificationEffect ffalse md
-- note this uses the second external ix
MdSetLSCol col -> \md w -> w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col
MdSetLSCol col -> \md w -> w & cWorld . lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ col
-- note this uses the first external ix, this should be made more
-- transparent
MdFlickerUpdate -> flickerUpdate
src/Dodge/Path.hs
+6 -6
View File
@@ -34,13 +34,13 @@ import qualified Streaming.Prelude as S
--import Data.Graph.Inductive.Graph hiding ((&))
getNodePos :: Int -> World -> Maybe Point2
getNodePos i w = _pathGraph w `lab` i
getNodePos i w = _pathGraph (_cWorld w) `lab` i
makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w)
na <- walkableNodeNear w a
nb <- walkableNodeNear w b
sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ _pathGraph w))
sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ _pathGraph (_cWorld w)))
pathEdgeObstructed :: PathEdge -> Bool
pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs
@@ -53,15 +53,15 @@ walkableNodeNear :: World -> Point2 -> Maybe Int
walkableNodeNear w p = fmap fst . find (flip (isWalkable p) w . snd) $ nodesNear
where
--nodesNear = runIdentity . S.toList_ $ nearPoint _pnZoning p w
nodesNear = zonesExtract (w ^. pnZoning) $ zonesAroundPoint pnZoneSize p
nodesNear = zonesExtract (w ^. cWorld . pnZoning) $ zonesAroundPoint pnZoneSize p
makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph w) <$> makePathBetween a b w
makePathBetweenPs a b w = mapMaybe (lab $ _pathGraph (_cWorld w)) <$> makePathBetween a b w
bfsNodePoints :: Int -> World -> [Point2]
bfsNodePoints n w = mapMaybe (lab g) $ bfs n g
where
g = _pathGraph w
g = _pathGraph (_cWorld w)
pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
@@ -137,7 +137,7 @@ addEdges nodemap gr = runIdentity . S.fold_ f (mempty,gr) id
obstructPathsCrossing :: EdgeObstacle -> Point2 -> Point2 -> World -> ( World, [(Int,Int,PathEdge)])
obstructPathsCrossing obstacletype sp' ep w =
( w & pathGraph %~ updateedges
( w & cWorld . pathGraph %~ updateedges
, es
)
where
src/Dodge/Picture/SizeInvariant.hs
+8 -8
View File
@@ -20,9 +20,9 @@ fixedSizePicAt pic p w
. scale theScale theScale
$ pic
where
campos = _cameraViewFrom w
campos = _cameraViewFrom (_cWorld w)
v = p -.- campos
theScale = 1 / _cameraZoom w
theScale = 1 / _cameraZoom (_cWorld w)
(V2 x y) = campos +.+ v
fixedSizePicClamp
@@ -40,11 +40,11 @@ fixedSizePicClamp xbord ybord pic p cfig w
. scale theScale theScale
$ pic
where
r = negate $ _cameraRot w
z = _cameraZoom w
campos = _cameraViewFrom w
r = negate $ _cameraRot (_cWorld w)
z = _cameraZoom (_cWorld w)
campos = _cameraViewFrom (_cWorld w)
v = p -.- campos
theScale = 1 / _cameraZoom w
theScale = 1 / _cameraZoom (_cWorld w)
(V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
(V2 xr yr) = rotateV r v
xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
@@ -71,8 +71,8 @@ fixedSizePicClampArrow xbord ybord pic p cfig w = pictures
Nothing -> blank
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
(V2 x y) = fromMaybe p borderPoint
campos = _cameraCenter w
theScale = 1 / _cameraZoom w
campos = _cameraCenter (_cWorld w)
theScale = 1 / _cameraZoom (_cWorld w)
absClamp
:: Float -- ^ clamping value, assumed positive
src/Dodge/Placement/Instance/LightSource/Flicker.hs
+4 -4
View File
@@ -18,13 +18,13 @@ flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool
flickerUpdate :: Modification -> World -> World
flickerUpdate md w
| _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1
| otherwise = w & lightSources . ix lsid . lsParam . lsCol .~ mdcol
& modifications . ix mdid
| _mdTimer md > 0 = w & cWorld . modifications . ix mdid . mdTimer -~ 1
| otherwise = w & cWorld . lightSources . ix lsid . lsParam . lsCol .~ mdcol
& cWorld . modifications . ix mdid
%~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) )
where
mdcol = _mdPoint3 md
lscol = _lsCol $ _lsParam $ _lightSources w IM.! lsid
lscol = w ^?! cWorld . lightSources . ix lsid . lsParam . lsCol -- _lsCol $ _lsParam $ _lightSources w IM.! lsid
lsid = _mdExternalID md
mdid = _mdID md
timerange
src/Dodge/Placement/Instance/Sensor.hs
+1 -1
View File
@@ -29,7 +29,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams gw) M.! dt)
& mcDraw .~ MachineDrawDamageSensor wdth (_sensorCoding (_genParams (_cWorld gw)) M.! dt)
& mcSensor .~ DamageSensor False 0 dt
)
defaultSensorWall
src/Dodge/Placement/Instance/Terminal.hs
+4 -4
View File
@@ -29,10 +29,10 @@ putTerminal mc tm
$ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
where
setids tmpl btpl mcpl w = w
& terminals . ix tmid . tmButtonID .~ btid
& terminals . ix tmid . tmMachineID .~ mcid
& machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
& buttons . ix btid . btTermMID ?~ tmid
& cWorld . terminals . ix tmid . tmButtonID .~ btid
& cWorld . terminals . ix tmid . tmMachineID .~ mcid
& cWorld . machines . ix mcid . mcMounts . at ObTerminal ?~ tmid
& cWorld . buttons . ix btid . btTermMID ?~ tmid
where
tmid = fromJust (_plMID tmpl)
btid = fromJust (_plMID btpl)
src/Dodge/Placement/Instance/Turret.hs
+13 -13
View File
@@ -39,7 +39,7 @@ lasTurret = Turret
-- this needs a major cleanup
updateTurret :: Float -> Machine -> World -> World
updateTurret rotSpeed mc w
| _mcHP mc < 1 = w & machines %~ IM.delete mcid
| _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid
& deleteWallIDs (_mcWallIDs mc)
& makeExplosionAt mcpos
& copyItemToFloor mcpos lasGun
@@ -52,12 +52,12 @@ updateTurret rotSpeed mc w
where
deleteHomonculus = case _tuMCrID (_mcType mc) of
Nothing -> id
Just cid -> creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & machines . ix mcid . mcType . tuMCrID ?~ cid
& creatures . at cid ?~ thecreature
Just cid -> cWorld . creatures . at cid .~ Nothing
initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
& cWorld . creatures . at cid ?~ thecreature
where
cid = IM.newKey (_creatures w')
cid = IM.newKey (_creatures (_cWorld w'))
thecreature = defaultCreature
& crID .~ cid
& crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
@@ -70,9 +70,9 @@ updateTurret rotSpeed mc w
& crStance . posture .~ Aiming
& crMaterial .~ Crystal
Just cid -> w'
& creatures . ix cid . crPos .~ mcpos
& creatures . ix cid . crDir .~ mcdir
dodamage = machines . ix mcid %~
& cWorld . creatures . ix cid . crPos .~ mcpos
& cWorld . creatures . ix cid . crDir .~ mcdir
dodamage = cWorld . machines . ix mcid %~
( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
. (mcHP -~ dam)
)
@@ -83,7 +83,7 @@ updateTurret rotSpeed mc w
| _tuFireTime (_mcType mc) > 0
= fromMaybe id $ do
cid <- _tuMCrID (_mcType mc)
return $ creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
| otherwise = id
mcid = _mcID mc
ypos = _crPos $ you w
@@ -94,12 +94,12 @@ updateTurret rotSpeed mc w
dam = sum $ map _dmAmount dams
elecDam = sum $ map _dmAmount elecDams
doTurn
| seesYou = machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| seesYou = cWorld . machines . ix mcid . mcDir %~ turnTo rotSpeed mcpos ypos
| otherwise = id
closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
updateFiringStatus
| closeFireAngle = machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
| closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
| otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
drawTurret :: Machine -> SPic
src/Dodge/Placement/PlaceSpot.hs
+17 -17
View File
@@ -88,21 +88,21 @@ placeSpotID ps pt gw = let (i,w) = placeSpotID' ps pt (_gwWorld gw)
-- the Int here is some id that is assigned when the placement is placed
placeSpotID' :: PlacementSpot -> PSType -> World -> (Int, World)
placeSpotID' ps pt w = case pt of
PutTrigger cnd -> plNewID triggers cnd w
PutMod mdi -> plNewUpID modifications mdID mdi w
PutProp prp -> plNewUpID props prID (mvProp p rot prp) w
PutButton bt -> plNewUpID buttons btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID terminals tmID tm w
PutFlIt itm -> plNewUpID floorItems flItID (createFlIt p rot itm) w
PutCrit cr -> plNewUpID creatures crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID foregroundShapes fsID (mvFS p rot fs) w
PutDecoration pic -> plNewID decorations (shiftDec p rot pic) w
PutTrigger cnd -> plNewID (cWorld . triggers) cnd w
PutMod mdi -> plNewUpID (cWorld . modifications) mdID mdi w
PutProp prp -> plNewUpID (cWorld . props) prID (mvProp p rot prp) w
PutButton bt -> plNewUpID (cWorld . buttons) btID (mvButton p rot bt) w
PutTerminal tm -> plNewUpID (cWorld . terminals) tmID tm w
PutFlIt itm -> plNewUpID (cWorld . floorItems) flItID (createFlIt p rot itm) w
PutCrit cr -> plNewUpID (cWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID (cWorld . foregroundShapes) fsID (mvFS p rot fs) w
PutDecoration pic -> plNewID (cWorld . decorations) (shiftDec p rot pic) w
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
PutLS ls -> plNewUpID lightSources lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID pressPlates ppID (mvPP p rot pp) w
PutLS ls -> plNewUpID (cWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID (cWorld . pressPlates) ppID (mvPP p rot pp) w
RandPS rgn -> evaluateRandPS rgn ps w
PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
PutCoord cp -> plNewID coordinates (doShift cp) w
PutCoord cp -> plNewID (cWorld . coordinates) (doShift cp) w
PutSlideDr wl dr eo off a b
-> plSlideDoor wl dr eo off (doShift a) (doShift b) w
PutBlock bl wl ps' -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
@@ -148,7 +148,7 @@ placeWallPoly qs wl w = foldl' (addPane wl) w pairs
addPane :: Wall -> World -> (Point2,Point2) -> World
--addPane wl w l = w & walls %~ IM.insert wlid (wl { _wlLine = l, _wlID = wlid })
addPane wl w l = w & plNew walls wlID (wl & wlLine .~ l)
addPane wl w l = w & plNew (cWorld . walls) wlID (wl & wlLine .~ l)
& fst . uncurry (obstructPathsCrossing WallObstacle) l
-- where
-- wlid = IM.newKey (_walls w)
@@ -174,14 +174,14 @@ mvFS p a = (fsDir +~ a) . (fsPos %~ ( (p +.+) . rotateV a ))
plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int,World)
plMachine wallpoly mc wl p rot gw = (mcid
, gw & machines %~ addMc
& walls %~ placeMachineWalls wl col wallpoly mcid wlid
, gw & cWorld . machines %~ addMc
& cWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
)
where
col = _mcColor mc
w' = gw
mcid = IM.newKey $ _machines w'
wlid = IM.newKey $ _walls w'
mcid = IM.newKey $ _machines (_cWorld w')
wlid = IM.newKey $ _walls (_cWorld w')
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
--addMc = IM.insert mcid (mc {_mcPos = centroid wallpoly,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
addMc = IM.insert mcid (mc {_mcPos = p,_mcDir = rot,_mcID = mcid, _mcWallIDs = wlids})
src/Dodge/Placement/PlaceSpot/Block.hs
+8 -8
View File
@@ -23,7 +23,7 @@ plBlock
-> (Int,World)
plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
plBlock (p:ps) bl wl w = (,) blid $ w
& blocks . at blid ?~ bl
& cWorld . blocks . at blid ?~ bl
{ _blID = blid
, _blWallIDs = IS.fromList is
, _blShadows = []
@@ -31,9 +31,9 @@ plBlock (p:ps) bl wl w = (,) blid $ w
}
& insertWalls blid wls
where
blid = IM.newKey $ _blocks w
blid = IM.newKey $ _blocks (_cWorld w)
lns = zip (p:ps) (ps ++ [p])
i = IM.newKey $ _walls w
i = IM.newKey $ _walls (_cWorld w)
is = [i.. i + length lns-1]
wls = zipWith
(\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid)
@@ -62,11 +62,11 @@ plLineBlock basePane blwidth a b gw = ( 0
cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
linesAt p = loopPairs $ cornersAt p
wlid = IM.newKey $ _walls gw
blid = IM.newKey $ _blocks gw
wlid = IM.newKey $ _walls (_cWorld gw)
blid = IM.newKey $ _blocks (_cWorld gw)
insertBlock (i,p) =
insertWalls (i + blid) (makeWallAt p i)
. over blocks (IM.insert (i+blid) Block
. over (cWorld . blocks) (IM.insert (i+blid) Block
{ _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
, _blHP = 1000, _blShadows = shadowsAt i
, _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning
@@ -96,10 +96,10 @@ plLineBlock basePane blwidth a b gw = ( 0
-- | Must be done after inserting the block
insertWalls :: Int -> [Wall] -> World -> World
insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths
insertWalls blid wls w = w' & cWorld . blocks . ix blid . blObstructs .~ concat paths
where
(w',paths) = mapAccumR (flip insertWall) w wls
insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
. (walls . at (_wlID wl) ?~ wl)
. (cWorld . walls . at (_wlID wl) ?~ wl)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+10 -10
View File
@@ -27,9 +27,9 @@ plDoor :: Color
-- Bumped out up and down by 9, not widened
-> World
-> (Int,World)
plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls
plDoor col eo cond pss gw = (drid, addWalls $ gw & cWorld . doors %~ addDoor) -- carefull with the ordering of addWalls
where
drid = IM.newKey $ _doors gw
drid = IM.newKey $ _doors (_cWorld gw)
addDoor = IM.insert drid $ defaultDoor
{ _drID = drid
, _drWallIDs = IS.fromList wlids
@@ -42,18 +42,18 @@ plDoor col eo cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull
, _drObstacleType = eo
}
nsteps = length pss - 1
wlids = take 4 [IM.newKey $ _walls gw ..]
wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
wlps' = uncurry (rectanglePairs 9) $ head pss
addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int,(Point2,Point2)) -> World
addDoorWall eo drid wl w (wlid,wlps) = w'
& walls %~ IM.insert wlid wl
& cWorld . walls %~ IM.insert wlid wl
{ _wlLine = wlps
, _wlID = wlid
, _wlStructure = DoorPart drid
}
& doors . ix drid . drObstructs .++~ es
& cWorld . doors . ix drid . drObstructs .++~ es
where
(w',es) = uncurry (obstructPathsCrossing eo) wlps w
@@ -63,9 +63,9 @@ maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World
maybeClearDoorPath eo w (x,y,pe)
| not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w
= w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
= w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
| otherwise
= w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y)
= w & cWorld . pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y)
plSlideDoor
:: Door
@@ -77,9 +77,9 @@ plSlideDoor
-> World
-> (Int, World)
plSlideDoor dr wl eo shiftOffset a b gw
= (drid, addDoorWalls $ gw & doors %~ addDoor)
= (drid, addDoorWalls $ gw & cWorld . doors %~ addDoor)
where
drid = IM.newKey $ _doors gw
drid = IM.newKey $ _doors (_cWorld gw)
addDoor = IM.insert drid $ dr
{ _drID = drid
, _drWallIDs = IS.fromList wlids
@@ -93,7 +93,7 @@ plSlideDoor dr wl eo shiftOffset a b gw
addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
pairs = rectanglePairs 9 a b
shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
wlids = take 4 [IM.newKey $ _walls gw ..]
wlids = take 4 [IM.newKey $ _walls (_cWorld gw) ..]
-- old code that may help with pathing
--import Dodge.LevelGen.Pathing
--import Data.Graph.Inductive hiding ((&))
src/Dodge/Projectile/Create.hs
+2 -2
View File
@@ -22,7 +22,7 @@ fireShell it cr = makeShell it cr
spinamount = _shellSpinAmount params
thrustdelay = _shellThrustDelay params
makeShell :: Item -> Creature -> [ProjectileUpdate] -> World -> World
makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell
makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
{ _prjPos = pos
, _prjZ = 20
, _prjStartPos = pos
@@ -38,7 +38,7 @@ makeShell it cr theupdate w = w & projectiles %~ IM.insert i Shell
, _prjMITID = _itID it
}
where
i = IM.newKey $ _props w
i = IM.newKey $ _props (_cWorld w)
dir = _crDir cr
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
am = _itConsumption it
src/Dodge/Projectile/Update.hs
+19 -19
View File
@@ -46,7 +46,7 @@ updateRemoteShell pj w
doExplode = w
& usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i)
& projectiles %~ IM.delete i
& cWorld . projectiles %~ IM.delete i
i = _prjID pj
oldPos = _prjPos pj
vel = _prjVel pj
@@ -58,15 +58,15 @@ explodeRemoteRocket'
-> World
-> World
explodeRemoteRocket' mitid thepj w = w
& projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
& usePayload (_prjPayload thepj) (_prjPos thepj)
& updateitem
where
updateitem = fromMaybe (projectiles . at pjid .~ Nothing) $ do
updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do
itid <- mitid
itpos <- w ^? itemPositions . ix itid
itpos <- w ^? cWorld . itemPositions . ix itid
return $ (pointToItem itpos . itUse . rUse .~ HeldDoNothing)
. (projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
. (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
pjid = _prjID thepj
updateShell :: Proj -> World -> World
@@ -82,7 +82,7 @@ updateShell pj w
doExplode = w
& usePayload (_prjPayload pj) oldPos
& stopSoundFrom (ShellSound i)
& projectiles %~ IM.delete i
& cWorld . projectiles %~ IM.delete i
i = _prjID pj
oldPos = _prjPos pj
vel = _prjVel pj
@@ -108,7 +108,7 @@ upProjectile pu pj = case pu of
| otherwise -> id
PJSetScope itid -> setRemoteScope itid (_prjPos pj)
PJRetireRemote itid 0 pjid -> retireRemoteProj'' itid pjid
PJRetireRemote _ _ pjid -> projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1
PJRetireRemote _ _ pjid -> cWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1
where
time = _prjTimer pj
act st et = time <= st && time >= et
@@ -116,26 +116,26 @@ upProjectile pu pj = case pu of
retireRemoteProj'' :: Int -> Int -> World -> World
retireRemoteProj'' itid pjid w = w
& pointToItem (_itemPositions w IM.! itid) %~
& pointToItem (_itemPositions (_cWorld w) IM.! itid) %~
( (itScope . scopePos .~ V2 0 0)
. (itUse . rUse .~ HeldFireRemoteShell)
)
& props %~ IM.delete pjid
& cWorld . props %~ IM.delete pjid
setRemoteDir :: Int -> Int -> Proj -> World -> World
setRemoteDir cid itid pj w = w & projectiles . ix i . prjDir .~ newdir
setRemoteDir cid itid pj w = w & cWorld . projectiles . ix i . prjDir .~ newdir
where
i = _prjID pj
newdir
| SDL.ButtonRight `M.member` _mouseButtons w
&& w ^? creatures . ix cid . crInvSel . iselPos == w ^? itemPositions . ix itid . ipInvID
= _cameraRot w + argV (_mousePos w)
| SDL.ButtonRight `M.member` _mouseButtons (_cWorld w)
&& w ^? cWorld . creatures . ix cid . crInvSel . iselPos == w ^? cWorld . itemPositions . ix itid . ipInvID
= _cameraRot (_cWorld w) + argV (_mousePos (_cWorld w))
| otherwise = _prjDir pj
doThrust' :: Proj -> World -> World
doThrust' pj w = w
& randGen .~ g
& projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& cWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) 3 10
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
@@ -155,11 +155,11 @@ trySpinByCID'
-> Proj
-> World
-> World
trySpinByCID' cid i pj w = w & projectiles . ix pjid . prjSpin .~ newSpin
trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
where
pjid = _prjID pj
dir = argV $ _prjVel pj
newSpin = case w ^? creatures . ix cid of
newSpin = case w ^? cWorld . creatures . ix cid of
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
_ -> 0
spinFactor = 5 * (6 - fromIntegral i)
@@ -169,9 +169,9 @@ pjTrack' itid pj w = rotateToTarget pj w
where
rotateToTarget _ = fromMaybe id $ do
tpos <- w ^? itPoint . itTargeting . tgPos . _Just
return $ projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos
return $ cWorld . projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos
(argV $ _prjAcc pj)
itPoint = pointToItem $ _itemPositions w IM.! itid
itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
reduceSpinBy' :: Float -> Proj -> World -> World
reduceSpinBy' x pj = projectiles . ix (_prjID pj) . prjSpin *~ x
reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
src/Dodge/Prop/Gib.hs
+3 -3
View File
@@ -68,7 +68,7 @@ addGibsAtDir dir minh maxh col p w = foldl' (flip $ addGib4 p col) w (zip4 vels
addGib4 :: Point2 -> Color -> (Point2, Float, Q.Quaternion Float, Float)
-> World -> World
addGib4 p col (v,zs,q,h) = plNew props prID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
addGib4 p col (v,zs,q,h) = plNew (cWorld . props) prID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
& prColor .~ col
& prVel .~ v
& prQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
@@ -79,7 +79,7 @@ addGib4 p col (v,zs,q,h) = plNew props prID (aGib & prPos .~ p +.+ (5 *.* normal
addGibAt :: Float -> Color -> Point2 -> World -> World
addGibAt h col p w = w
& plNew props prID gib
& plNew (cWorld . props) prID gib
& randGen .~ newg
where
(gib,newg) = runState f $ _randGen w
@@ -100,7 +100,7 @@ addGibAt h col p w = w
addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World
addGibAtDir dir h col p w = w
& plNew props prID gib
& plNew (cWorld . props) prID gib
& randGen .~ newg
where
(gib,newg) = runState f $ _randGen w
src/Dodge/Prop/Moving.hs
+3 -3
View File
@@ -9,12 +9,12 @@ import LensHelp
fallSmallBounceDamage :: Prop -> World -> World
fallSmallBounceDamage pr w = w
& dodamage
& props . ix (_prID pr) %~ fallSmallBounce' w
& cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
where
p = _prPos pr
v = _prVel pr
dodamage
| _prPosZ pr < 25 = creatures %~ fmap dodamage'
| _prPosZ pr < 25 = cWorld . creatures %~ fmap dodamage'
| otherwise = id
dodamage' cr
| dist (_crPos cr) p < _crRad cr + 5 = cr & crState . csDamage
@@ -23,7 +23,7 @@ fallSmallBounceDamage pr w = w
fallSmallBounce :: Prop -> World -> World
fallSmallBounce pr w = w
& props . ix (_prID pr) %~ fallSmallBounce' w
& cWorld . props . ix (_prID pr) %~ fallSmallBounce' w
fallSmallBounce' :: World -> Prop -> Prop
fallSmallBounce' w pr
src/Dodge/Prop/Update.hs
+5 -5
View File
@@ -17,7 +17,7 @@ updateProp pr = case _prUpdate pr of
PropRotate x -> rotateProp x pr
PropSetToggleAnd wb pu -> propSetToggleAnd wb pu pr
PropUpdates pus -> doPropUpdates pr pus
PropUpdateLS lsid x -> \w -> w & lightSources . ix lsid %~ doPrWdLsLs x pr w
PropUpdateLS lsid x -> \w -> w & cWorld . lightSources . ix lsid %~ doPrWdLsLs x pr w
PropUpdatePosition x -> propUpdatePosition x pr
PropUpdateWhen t x -> propUpdateIf t x PropUpdateId pr
PropUpdateAnd x y -> doPropUpdates pr [x,y]
@@ -32,8 +32,8 @@ propUpdateIf wb x y pr w
propUpdatePosition :: WdP2f -> Prop -> World -> World
propUpdatePosition x pr w = w
& props . ix (_prID pr) . prPos .~ fst (doWdP2f x w)
& props . ix (_prID pr) . prRot .~ snd (doWdP2f x w)
& cWorld . props . ix (_prID pr) . prPos .~ fst (doWdP2f x w)
& cWorld . props . ix (_prID pr) . prRot .~ snd (doWdP2f x w)
doPropUpdates :: Prop -> [PropUpdate] -> World -> World
doPropUpdates pr pus w = foldl' f w pus
@@ -45,9 +45,9 @@ propSetToggleAnd wb pu pr = setToggle (doWdBl wb) pr . updateProp (pr & prUpdate
-- fugly
setToggle :: (World -> Bool) -> Prop -> World -> World
setToggle cond pr w = w & props . ix (_prID pr) . prToggle .~ cond w
setToggle cond pr w = w & cWorld . props . ix (_prID pr) . prToggle .~ cond w
rotateProp :: Float -> Prop -> World -> World
rotateProp rotAmount pr w = w
& props . ix (_prID pr) . prRot +~ rotAmount
& cWorld . props . ix (_prID pr) . prRot +~ rotAmount
src/Dodge/RadarSweep.hs
+4 -4
View File
@@ -9,7 +9,7 @@ import Data.Maybe
import qualified IntMapHelp as IM
aRadarPulse :: Object -> Creature -> World -> World
aRadarPulse ob cr = radarSweeps .:~ RadarSweep
aRadarPulse ob cr = cWorld . radarSweeps .:~ RadarSweep
{ _rsTimer = 100
, _rsRad = 0
, _rsPos = _crPos cr
@@ -29,7 +29,7 @@ updateRadarSweep w pt
blipsF = findBlips ob
bf = makeBlip ob
x = _rsTimer pt
putBlips = radarBlips .++~ blips
putBlips = cWorld . radarBlips .++~ blips
blips = map bf circPoints
circPoints = blipsF p r w
r = fromIntegral (400 - x*4)
@@ -58,13 +58,13 @@ blipAt r col i p = RadarBlip
}
crBlips :: Point2 -> Float -> World -> [Point2]
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures
crBlips p r = IM.elems . IM.filter f . fmap _crPos . IM.filter g . _creatures . _cWorld
where
f q = dist p q <= r && dist p q > r - 100
g cr = _crID cr /= 0
itemBlips :: Point2 -> Float -> World -> [Point2]
itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems
itemBlips p r = IM.elems . IM.filter f . fmap _flItPos . _floorItems . _cWorld
where
f q = dist p q <= r && dist p q > r - 4
src/Dodge/Reloading.hs
+3 -3
View File
@@ -37,12 +37,12 @@ tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProg
crToggleReloading :: Creature -> World -> World
crToggleReloading cr w = case cr ^?! crInvSel . iselAction of
ReloadAction {} -> w & creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
_ -> w & creatures . ix (_crID cr) %~ tryStartLoading
ReloadAction {} -> w & cWorld . creatures . ix (_crID cr) . crInvSel . iselAction .~ NoInvSelAction
_ -> w & cWorld . creatures . ix (_crID cr) %~ tryStartLoading
crHoldReloading :: Creature -> World -> World
crHoldReloading cr w = w
& creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown
& cWorld . creatures . ix (_crID cr) . crInvSel . iselAction . actionHammer .~ HasHammer HammerDown
tryStartLoading :: Creature -> Creature
tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
src/Dodge/Render.hs
+6 -6
View File
@@ -34,14 +34,14 @@ doDrawing pdata u = do
sTicks <- SDL.ticks
let w = _uvWorld u
cfig = _uvConfig u
rot = _cameraRot w
camzoom = _cameraZoom w
trans = _cameraCenter w
rot = _cameraRot (_cWorld w)
camzoom = _cameraZoom (_cWorld w)
trans = _cameraCenter (_cWorld w)
wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
resFact = resFactorNum $ cfig ^. graphics_resolution_factor
(wallPointsCol,windowPoints,wallSPics) = wallsToDraw w
lightPoints = lightsToRender cfig w
viewFroms@(V2 vfx vfy) = _cameraViewFrom w
viewFroms@(V2 vfx vfy) = _cameraViewFrom (_cWorld w)
viewFrom3d = Vector3 vfx vfy 20
shadV = _pictureShaders pdata
lwShad = _lightingWallShadShader pdata
@@ -64,7 +64,7 @@ doDrawing pdata u = do
(shadVBOptr $ _textureArrayShader pdata)
wallPointsCol
windowPoints
(_floorTiles w)
(_floorTiles (_cWorld w))
)
( pokeShape'
(_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
@@ -248,7 +248,7 @@ doDrawing pdata u = do
depthFunc $= Just Always
blendFunc $= (One,Zero)
-- perform any radial distortion
case _distortions w of
case _distortions (_cWorld w) of
[] -> do
bindTO $ fst $ snd $ _fboBase pdata
bindFramebuffer Framebuffer $= defaultFramebufferObject
src/Dodge/Render/HUD.hs
+14 -14
View File
@@ -34,7 +34,7 @@ import qualified Data.Text as T
--import Data.Bifunctor
hudDrawings :: Universe -> Picture
hudDrawings uv = case _hudElement $ _hud w of
hudDrawings uv = case _hudElement $ _hud (_cWorld w) of
DisplayCarte -> drawCarte cfig w
DisplayInventory subinv -> drawInGameHUD uv
<> subInventoryDisplay subinv cfig w
@@ -59,7 +59,7 @@ inventoryDisplay cfig w = listPicturesAt 0 0 cfig invlist
inv = _crInv cr
invlist = concatMap (itemText' cr) (IM.toList inv)
++ displayFreeSlots
++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects (_cWorld w))
-- ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
-- floorItemsColor = case _hudElement (_hud w) of
-- DisplayInventory NoSubInventory -> id
@@ -131,7 +131,7 @@ subInventoryDisplay subinv cfig w = case subinv of
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
selcursor = selcursor' selcursortype
selcursortype
| ButtonRight `M.member` _mouseButtons w = listCursorNESW
| ButtonRight `M.member` _mouseButtons (_cWorld w) = listCursorNESW
| otherwise = listCursorNSW
curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w)
@@ -140,8 +140,8 @@ subInventoryDisplay subinv cfig w = case subinv of
_ -> mempty
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
rboptions = if ButtonRight `M.member` _mouseButtons w
then drawRBOptions cfig w (_rbOptions w)
rboptions = if ButtonRight `M.member` _mouseButtons (_cWorld w)
then drawRBOptions cfig w (_rbOptions (_cWorld w))
else mempty
itmInfo :: Maybe Item -> [String]
@@ -151,7 +151,7 @@ itmInfo mit = fromMaybe [] $ do
displayTerminal :: Int -> Configuration -> World -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
tm <- w ^? terminals . ix tid
tm <- w ^? cWorld . terminals . ix tid
return $ pictures
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
, renderListAt subInvX 60 cfig
@@ -187,7 +187,7 @@ drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=a
where
midtext str = listTextPictureAt 252 0 cfig curpos (text str)
extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
deactivatetext = case w ^? cWorld . rbOptions . opActivateEquipment . deactivateEquipment of
Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
Nothing -> ""
curpos = invSelPos w
@@ -255,9 +255,9 @@ topCursorTypeWidth ctype width cfig w i
= ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
determineInvSelCursorWidth w = case _rbOptions (_cWorld w) of
NoRightButtonOptions -> topInvW
EquipOptions {} -> if ButtonRight `M.member` _mouseButtons w
EquipOptions {} -> if ButtonRight `M.member` _mouseButtons (_cWorld w)
then 47
else topInvW
@@ -309,9 +309,9 @@ drawCarte cfig w = pictures $
++ mapOverlay cfig w
++ [mainListCursor white iPos cfig]
where
iPos = _selLocation w
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ w
iPos = _selLocation (_cWorld w)
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ (_cWorld w)
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations $ (_cWorld w)
locTexts = map fst locs
displayListEndCoords :: Configuration -> [String] -> [Point2]
@@ -325,7 +325,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
(mapMaybe (mapWall cfig w) . IM.elems $ _walls w)
(mapMaybe (mapWall cfig w) . IM.elems $ _walls (_cWorld w))
mapWall :: Configuration -> World -> Wall -> Maybe Picture
mapWall cfig w wl =
@@ -419,4 +419,4 @@ displayHP cid cfig w = translate (halfWidth cfig-80) (halfHeight cfig-20)
. leftPad 5 ' '
. show
. _crHP
$ _creatures w IM.! cid
$ _creatures (_cWorld w) IM.! cid
src/Dodge/Render/Lights.hs
+4 -4
View File
@@ -9,13 +9,13 @@ import Data.Maybe
import qualified IntMapHelp as IM
lightsToRender :: Configuration -> World -> [(Point3,Float,Point3)]
lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources w)
++ mapMaybe getTLS (_tempLightSources w)
lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources (_cWorld w))
++ mapMaybe getTLS (_tempLightSources (_cWorld w))
where
getLS = getlsparam . _lsParam
getTLS = getlsparam . _tlsParam
cbox = _boundBox w
cpos = _cameraCenter w
cbox = _boundBox (_cWorld w)
cpos = _cameraCenter (_cWorld w)
getlsparam ls
| not (pointInPolygon lpos cbox) && extraculltest = Nothing
| otherwise = Just ( _lsPos ls, rad^(2::Int) , _lsCol ls)
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -23,6 +23,6 @@ fixedCoordPictures u = case _menuLayers u of
customMouseCursor :: Configuration -> World -> Picture
customMouseCursor cfig w = winScale cfig
. uncurryV translate (_mousePos w)
. uncurryV translate (_mousePos (_cWorld w))
. color white
$ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]
src/Dodge/Render/ShapePicture.hs
+44 -44
View File
@@ -78,7 +78,7 @@ worldSPic cfig w
<> singleSPic (anyTargeting cfig w)
where
foldup = foldMap'
filtOn f g = IM.filter (pointIsClose . f) (g w)
filtOn f g = IM.filter (pointIsClose . f) (g (_cWorld w))
pointIsClose = cullPoint cfig w
anyTargeting :: Configuration -> World -> SPic
@@ -128,30 +128,30 @@ shiftDraw' fpos fdir fdraw x = uncurryV translateSPf (fpos x)
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox w)
| otherwise = dist (_cameraCenter w) p < _viewDistance w
| debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox (_cWorld w))
| otherwise = dist (_cameraCenter (_cWorld w)) p < _viewDistance (_cWorld w)
extraPics :: Configuration -> World -> Picture
extraPics cfig w = pictures (_decorations w)
<> concatMapPic drawTractorBeam (_tractorBeams w)
<> concatMapPic drawLinearShockwave (_linearShockwaves w)
<> concatMapPic drawShockwave (_shockwaves w)
<> concatMapPic drawLaser (_lasersToDraw w)
<> concatMapPic drawTeslaArc (_teslaArcs w)
extraPics cfig w = pictures (_decorations (_cWorld w))
<> concatMapPic drawTractorBeam (_tractorBeams (_cWorld w))
<> concatMapPic drawLinearShockwave (_linearShockwaves (_cWorld w))
<> concatMapPic drawShockwave (_shockwaves (_cWorld w))
<> concatMapPic drawLaser (_lasersToDraw (_cWorld w))
<> concatMapPic drawTeslaArc (_teslaArcs (_cWorld w))
-- <> concatMapPic drawParticle (_particles w)
<> concatMapPic drawRadarSweep (_radarSweeps w)
<> concatMapPic drawFlame (_flames w)
<> concatMapPic drawEnergyBall (_energyBalls w)
<> concatMapPic drawSpark (_sparks w)
<> concatMapPic drawBul (_bullets w)
<> concatMapPic drawBlip (_radarBlips w)
<> concatMapPic drawFlare (_flares w)
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams w)
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams w)
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources w)
<> concatMapPic drawRadarSweep (_radarSweeps (_cWorld w))
<> concatMapPic drawFlame (_flames (_cWorld w))
<> concatMapPic drawEnergyBall (_energyBalls (_cWorld w))
<> concatMapPic drawSpark (_sparks (_cWorld w))
<> concatMapPic drawBul (_bullets (_cWorld w))
<> concatMapPic drawBlip (_radarBlips (_cWorld w))
<> concatMapPic drawFlare (_flares (_cWorld w))
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams (_cWorld w))
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams (_cWorld w))
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources (_cWorld w))
<> testPic cfig w
<> concatMapPic clDraw (_clouds w )
<> concatMapPic ppDraw (_pressPlates w )
<> concatMapPic clDraw (_clouds (_cWorld w) )
<> concatMapPic ppDraw (_pressPlates (_cWorld w) )
<> viewClipBounds cfig w
<> debugDraw cfig w
@@ -196,7 +196,7 @@ debugDraw' cfig w bl = case bl of
rdraw pic = (mempty,pic)
drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w)
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w))
drawPathBetween :: World -> Picture
drawPathBetween w = setLayer DebugLayer
@@ -207,22 +207,22 @@ drawPathBetween w = setLayer DebugLayer
where
nodepos = (`getNodePos` w)
nodelist = makePathBetween sp ep w
sp = _lSelect w
ep = _rSelect w
sp = _lSelect (_cWorld w)
ep = _rSelect (_cWorld w)
drawNodesNearSelect :: World -> Picture
drawNodesNearSelect w = setLayer DebugLayer
$ runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp))
<> color green (drawCross sp)
where
sp = _lSelect w
sp = _lSelect (_cWorld w)
drawInspectWalls :: World -> Picture
drawInspectWalls w = foldMap (drawInspectWall w)
$ filter (isJust . uncurry (intersectSegSeg a b) . _wlLine)
$ IM.elems $ _walls w
$ IM.elems $ _walls (_cWorld w)
where
(a,b) = _lLine w
(a,b) = _lLine (_cWorld w)
drawInspectWall :: World -> Wall -> Picture
drawInspectWall w wl = setLayer DebugLayer
@@ -233,7 +233,7 @@ drawInspectWall w wl = setLayer DebugLayer
drawDoorPaths :: World -> Int -> Picture
drawDoorPaths w drid = fromMaybe mempty $ do
paths <- w ^? doors . ix drid . drObstructs
paths <- w ^? cWorld . doors . ix drid . drObstructs
return $ foldMap (drawPathEdge . (^. _3)) paths
drawPathEdge :: PathEdge -> Picture
@@ -252,8 +252,8 @@ drawWorldSelect w = setLayer DebugLayer
$ color cyan (line [a,b])
<> color magenta (line [c,d])
where
(a,b) = _lLine w
(c,d) = _rLine w
(a,b) = _lLine (_cWorld w)
(c,d) = _rLine (_cWorld w)
drawFarWallDetect :: World -> Picture
drawFarWallDetect w = setLayer DebugLayer
@@ -264,7 +264,7 @@ drawFarWallDetect w = setLayer DebugLayer
] )
$ runIdentity $ S.toList_ $ streamViewpoints p w
where
p = _cameraViewFrom w
p = _cameraViewFrom (_cWorld w)
drawDDATest :: World -> Picture
drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
@@ -273,12 +273,12 @@ drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
<> color blue (runIdentity (S.foldMap_ drawCross qs'))
<> setLayer DebugLayer (color yellow (line [cvf,mwp]))
where
cvf = _cameraViewFrom w
cvf = _cameraViewFrom (_cWorld w)
mwp = mouseWorldPos w
ps = ddaStreamX 50 cvf mwp
ps' = ddaStreamY 50 (_cameraViewFrom w) (mouseWorldPos w)
qs = xIntercepts 50 (_cameraViewFrom w) (mouseWorldPos w)
qs' = yIntercepts 50 (_cameraViewFrom w) (mouseWorldPos w)
ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
drawCross :: Point2 -> Picture
drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5
@@ -299,7 +299,7 @@ drawWallSearchRays :: World -> Picture
drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
where
f p = setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5)
<> line [_cameraViewFrom w, p]
<> line [_cameraViewFrom (_cWorld w), p]
testPic :: Configuration -> World -> Picture
testPic _ _ = mempty
@@ -307,7 +307,7 @@ testPic _ _ = mempty
drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
where
(x:xs) = _boundBox w
(x:xs) = _boundBox (_cWorld w)
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c)
@@ -329,7 +329,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
where
p = _soundPos s
thePic
= rotate (_cameraRot w)
= rotate (_cameraRot (_cWorld w))
. scale theScale theScale
. centerText
. soundToOnomato
@@ -348,7 +348,7 @@ drawMousePosition cfig w = setLayer FixedCoordLayer . winScale cfig
mwp = mouseWorldPos w
drawWlIDs :: Configuration -> World -> Picture
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls w)
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (_walls (_cWorld w))
where
f wl
| dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
@@ -374,7 +374,7 @@ drawPathing cfig w = setLayer DebugLayer
<> foldMap dispInc (graphToIncidence gr)
where
dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
gr = _pathGraph w
gr = _pathGraph (_cWorld w)
crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2,[String])
crDisplayInfo cfig w cr
@@ -401,7 +401,7 @@ fpreShow str = fmap (((rightPad 7 '.'str ++ "...") ++) . show)
drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w = setLayer FixedCoordLayer
$ renderInfoListsAt (2*hw - 400) 0 cfig w
$ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures w
$ mapMaybe (crDisplayInfo cfig w) $ IM.elems $ _creatures (_cWorld w)
where
hw = halfWidth cfig
@@ -410,14 +410,14 @@ viewBoundaries w = setLayer DebugLayer $ color green (foldMap (polygonWire . _gr
<> color yellow (foldMap (\q -> line [p,q]) $ farWallPoints p w)
where
p = _crPos $ you w
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
viewClipBounds :: Configuration -> World -> Picture
viewClipBounds cfig w
| _debug_view_clip_bounds cfig == AllRoomClipBoundaries
= setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping w)
= setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping (_cWorld w))
| _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries
= setLayer DebugLayer $ f (_roomClipping w)
= setLayer DebugLayer $ f (_roomClipping (_cWorld w))
| otherwise = mempty
where
f (x:xs) = g x xs <> f xs
src/Dodge/Render/Walls.hs
+1 -1
View File
@@ -23,7 +23,7 @@ wallsToDraw w
<$> L.prefilter wlOpaqueDraw (L.premap f L.list)
<*> L.prefilter wlSeeThroughDraw (L.premap f L.list)
<*> L.premap getWallSPic L.mconcat
) (wlsFromIXs w $ zonesExtract (w ^. wlZoning) $ zoneOfSight' wlZoneSize w)
) (wlsFromIXs w $ zonesExtract (w ^. cWorld . wlZoning) $ zoneOfSight' wlZoneSize w)
--wallsToDraw
-- :: World
-- -> ( [((Point2,Point2),Point4)] ,[((Point2,Point2),Point4)], SPic )
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -105,7 +105,7 @@ addButtonSlowDoor x h rm = do
(V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90))
$ \plls plpr -> Just $ ptCont (PutWorldUpdate (const $ setmount dr plls plpr))
$ const mpl
setmount pldr plls plpr = doors . ix (fromJust $ _plMID pldr) . drMounts .++~
setmount pldr plls plpr = cWorld . doors . ix (fromJust $ _plMID pldr) . drMounts .++~
[MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
-- TODO make the height of this light source and of other mounted lights
-- be taken from a single consistent source
src/Dodge/Save.hs
+1 -1
View File
@@ -28,7 +28,7 @@ doQuicksave :: Universe -> Universe
doQuicksave = saveWorldInSlot QuicksaveSlot
clearKeys :: World -> World
clearKeys = (keys .~ mempty) . (mouseButtons .~ mempty)
clearKeys = (cWorld . keys .~ mempty) . (cWorld . mouseButtons .~ mempty)
saveLevelStartSlot :: Universe -> Universe
--saveLevelStartSlot = id
src/Dodge/Shockwave/Update.hs
+2 -2
View File
@@ -28,7 +28,7 @@ moveShockwave w sw
t = _swTimer sw
tFraction = fromIntegral t / fromIntegral (_swMaxTime sw)
rad = r - (3/4) * r * tFraction
doDams w' = over creatures (IM.map damCr)
doDams w' = over (cWorld . creatures) (IM.map damCr)
$ foldl'
(flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))
w'
@@ -56,7 +56,7 @@ moveInverseShockwave w sw
r = _swRad sw
t = _swTimer sw
rad = r - 0.1 * r * fromIntegral (10 - t)
dams = over creatures (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
dams = over (cWorld . creatures) (IM.map damCr) -- . flip (foldr (damageBlocksBy 1)) hitBlocks
-- hitBlocks = wallsOnCirc' p rad $ wallsNearPoint' p w
damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr
src/Dodge/SoundLogic.hs
+2 -2
View File
@@ -146,9 +146,9 @@ soundAngle p w
. radToDeg
. normalizeAngle
. (+ pi)
$ argV (vNormal (p -.- earPos)) - _cameraRot w
$ argV (vNormal (p -.- earPos)) - _cameraRot (_cWorld w)
where
earPos = _cameraViewFrom w
earPos = _cameraViewFrom (_cWorld w)
{-| Uses the first free origin from a list.
Does nothing if all origins are already creating sounds. -}
src/Dodge/Spark.hs
+4 -4
View File
@@ -35,8 +35,8 @@ sparkDam
-> World
-> World
sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of
(hitp,Left cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
(hitp,Right wl) -> wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp]
(hitp,Left cr) -> cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
(hitp,Right wl) -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp]
where
thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
@@ -53,7 +53,7 @@ randColDirSpark
-> World
-> World
randColDirSpark randcol randdir pos w = w
& sparks .:~ spark
& cWorld . sparks .:~ spark
& randGen .~ g
where
((col,dir),g) = (`runState` _randGen w) $ do
@@ -79,7 +79,7 @@ randSpark
-> World
randSpark dt randspeed randcol randdir pos w = w
& randGen .~ g
& sparks .:~ Spark
& cWorld . sparks .:~ Spark
{ _skVel = rotateV dir (V2 speed 0)
, _skColor = col
, _skPos = pos

Some files were not shown because too many files have changed in this diff Show More