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/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