Cleanup, remove jetpack

This commit is contained in:
2024-10-02 18:23:49 +01:00
parent bac57a702d
commit effd89dc78
11 changed files with 120 additions and 212 deletions
-1
View File
@@ -280,7 +280,6 @@ testInventory =
stackedInventory :: [Item]
stackedInventory =
[ torch
, torch
, remoteScreen
, megaShellMag
, targetingScope TARGETLASER
+85 -149
View File
@@ -3,13 +3,6 @@ module Dodge.Creature.State (
doDamage,
) where
import Dodge.WorldEvent.Flash
import Dodge.Data.DoubleTree
import Dodge.Item.HeldOffset
import Dodge.DoubleTree
import Dodge.Data.ComposedItem
import qualified Quaternion as Q
import Dodge.Item.Grammar
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
@@ -21,24 +14,31 @@ import Dodge.Creature.Impulse.Movement
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.World
import Dodge.EnergyBall
import Dodge.DoubleTree
import Dodge.Euse
import Dodge.Hammer
import Dodge.ItEffect
import Dodge.Item.Grammar
import Dodge.Item.HeldOffset
import Dodge.Prop.Gib
import Dodge.SoundLogic
import Dodge.WorldEvent.Flash
import Dodge.Zoning.Creature
import FoldableHelp
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
import qualified Quaternion as Q
import RandomHelp
import qualified SDL
import Shape
import ShapePicture
-- this can almost certainly be made more efficient
foldCr ::
[Creature -> World -> World] ->
Creature ->
@@ -68,28 +68,13 @@ stateUpdate f =
, updateInv -- upInv must be called before invSideEff 22.05.23
, invSideEff
, equipmentEffects
-- , heldItemEffects
-- , heldAimEffects
]
--heldItemEffects :: Creature -> World -> World
--heldItemEffects _ = id
--heldAimEffects :: Creature -> World -> World
--heldAimEffects cr = fromMaybe id $ do
-- guard (crIsAiming cr)
-- ipos <- cr ^? crManipulation . manObject . inInventory . ispItem
-- itm <- cr ^? crInv . ix ipos
-- f <- itm ^? itEffect . ieWhileAiming
-- return $ doInvEffect f itm cr
checkDeath :: Creature -> World -> World
checkDeath cr w
| _crHP cr > 0 =
w
| _crHP cr > 0 = w
& cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
| otherwise =
w
| otherwise = w
-- & creatures . at (_crID cr) .~ Nothing
& dropByState cr
& removecr
@@ -104,58 +89,25 @@ checkDeath cr w
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
Just (FLAMING, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL, _) -> w & plNew (cWorld . lWorld . corpses) cpID thecorpse
Just (POISONDAM, _) -> w & plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
_
| _crPastDamage cr > 200 ->
w & addCrGibs cr
& bloodPuddleAt cpos
& bloodPuddleAt cpos
& bloodPuddleAt cpos
_ ->
w
& bloodPuddleAt cpos
& bloodPuddleAt cpos
& plNew (cWorld . lWorld . corpses) cpID thecorpse
corpseOrGib cr = case maxDamageType (_csDamage (_crState cr)) of
Just (FLAMING, _) -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
Just (ELECTRICAL, _) -> plNew (cWorld . lWorld . corpses) cpID thecorpse
Just (POISONDAM, _) -> plNew (cWorld . lWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
_ | _crPastDamage cr > 200 -> addCrGibs cr
_ -> plNew (cWorld . lWorld . corpses) cpID thecorpse
where
cpos = _crPos cr
thecorpse = makeDefaultCorpse cr
scorchSPic :: SPic -> SPic
scorchSPic =
over _1 $
overColSH (mixColors 0.9 0.1 black . normalizeColor)
scorchSPic = over _1 $ overColSH (mixColors 0.9 0.1 black . normalizeColor)
poisonSPic :: SPic -> SPic
poisonSPic =
over _1 $
overColSH (mixColors 0.5 0.5 green . normalizeColor)
--scorchSPic :: World -> SPic -> SPic
--scorchSPic w sp = evalState (scorchSPic' sp) (_randGen w)
--
--scorchSPic' :: SPic -> State StdGen SPic
--scorchSPic' = _1 $ overColSHM $ \col -> takeOne [col,black]
---- (return . mixColorsLinear 0.9 0.1 black)
bloodPuddleAt :: Point2 -> World -> World
bloodPuddleAt p w =
w
& snd
. plNewID
(cWorld . lWorld . decorations)
(color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
& randGen .~ g
where
(q, g) = randInCirc 10 & runState $ _randGen w
poisonSPic = over _1 $ overColSH (mixColors 0.5 0.5 green . normalizeColor)
internalHammerUpdate :: Creature -> World -> World
internalHammerUpdate cr =
cWorld . lWorld . creatures . ix (_crID cr)
%~ ( (crHammerPosition %~ moveHammerUp)
-- . stepReloading
. updateMovement
)
@@ -169,10 +121,7 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
doDamage :: Creature -> World -> World
doDamage cr w =
w
& applyPastDamages cr
& applyCreatureDamage dams cr
doDamage cr = applyPastDamages cr . applyCreatureDamage dams cr
where
dams = _csDamage $ _crState cr
@@ -194,29 +143,7 @@ applyPastDamages cr w
| otherwise = w
movementSideEff :: Creature -> World -> World
movementSideEff cr w
| hasJetPack = case cr ^? crStance . carriage of
Just (Boosting v) ->
w
& randGen .~ g
& makeFlamelet
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
20
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
1
20
_ -> w
| otherwise = footstepSideEffect cr w
where
hasJetPack = any (\it -> it ^? itType == Just (EQUIP JETPACK)) $ _crInv cr
oldPos = _crOldPos cr
momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
momentum''
| magV momentum' > 3 = 3 *.* normalizeV momentum'
| otherwise = momentum'
momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
(randDir, g) = randomR (-0.5, 0.5) $ _randGen w
(randAng, _) = randomR (0, 2 * pi) $ _randGen w
movementSideEff = footstepSideEffect
useUpdate :: ItemUse -> ItemUse
useUpdate =
@@ -242,8 +169,9 @@ equipmentEffects cr = alaf Endo foldMap (useEquipment cr) (IM.keys $ _crInvEquip
-- a loop going over all inventory items
invSideEff :: Creature -> World -> World
invSideEff cr = alaf Endo foldMap f (_crInv cr)
. updateRootItem cr
invSideEff cr =
alaf Endo foldMap f (_crInv cr)
. updateRootItem cr
where
-- be careful with side effects that affect creature targeting
f it =
@@ -257,22 +185,25 @@ updateRootItem cr = fromMaybe id $ do
return $ updateRootItem' itmtree cr
-- need to check rotation
chainLinkOrientation
:: Maybe (Point3, Q.Quaternion Float)
-> Item
-> ItemLink
-> Item
-> Maybe (Point3,Q.Quaternion Float)
chainLinkOrientation ::
Maybe (Point3, Q.Quaternion Float) ->
Item ->
ItemLink ->
Item ->
Maybe (Point3, Q.Quaternion Float)
chainLinkOrientation mo par (ILink lt f) child = do
(p,q) <- mo
(p1,q1) <- f par lt child
(p, q) <- mo
(p1, q1) <- f par lt child
return (p + Q.rotate q1 p1, q * q1)
updateRootItem' :: LabelDoubleTree ItemLink Item -> Creature -> World -> World
updateRootItem' itmtree cr = ldtPropagateFold chainLinkOrientation chainLinkOrientation
(updateItemWithOrientation cr)
(Just (heldItemRelativeOrient (_ldtValue itmtree) cr (0,Q.qID)))
itmtree
updateRootItem' itmtree cr =
ldtPropagateFold
chainLinkOrientation
chainLinkOrientation
(updateItemWithOrientation cr)
(Just (heldItemRelativeOrient (_ldtValue itmtree) cr (0, Q.qID)))
itmtree
updateItemWithOrientation :: Creature -> Maybe (Point3, Q.Quaternion Float) -> Item -> World -> World
updateItemWithOrientation cr m itm = case _itType itm of
@@ -281,7 +212,7 @@ updateItemWithOrientation cr m itm = case _itType itm of
testtorch :: Creature -> Maybe (Point3, Q.Quaternion Float) -> World -> World
testtorch cr m = fromMaybe id $ do
(pos,q) <- m
(pos, q) <- m
let d = _crDir cr + argV (Q.qToV2 q)
return $ muzFlareAt yellow (_crPos cr `v2z` 0 + rotate3z d pos) d
@@ -302,50 +233,55 @@ itemInvSideEffect cr itm = case _itType itm of
-- attachoff = it ^?! itDimension . dimAttachPos
updateItemTargeting :: TargetingType -> Creature -> Item -> World -> World
updateItemTargeting tt cr itm w = w & case tt of
_ | not isattached ->
updateItemTargeting tt cr itm w =
w & case tt of
_
| not isattached ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TARGETLASER
| crIsAiming cr ->
cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. tgPos
.~ Nothing
TargetRBPress
| rbpressed ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
. (tgActive .~ True)
)
TargetRBPress ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos .~ Nothing)
. (tgActive .~ False))
TARGETLASER | crIsAiming cr ->
cWorld . lWorld . lasers
.:~ LaserStart
{ _lpPhaseV = 1
, _lpDir = _crDir cr
, _lpPos = sp
, _lpColor = col
, _lpType = TargetingLaser (_itID itm)
}
TARGETLASER ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm)
. itUse
. tgPos
.~ Nothing
TargetRBPress | rbpressed ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just)
. (tgActive .~ True)
. (tgActive .~ False)
)
TargetRBPress ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix (_ilInvID $ _itLocation itm) . itUse
%~ ( (tgPos .~ Nothing)
. (tgActive .~ False)
)
TargetRBCreature ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
%~ setRBCreatureTargeting cr w
TargetCursor ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
.~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam)))
Nothing
True
TargetRBCreature ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
%~ setRBCreatureTargeting cr w
TargetCursor ->
cWorld . lWorld . creatures . ix (_crID cr)
. crInv
. ix (_ilInvID $ _itLocation itm)
. itUse
.~ TargetingUse
(Just (mouseWorldPos (w ^. input) (w ^. wCam)))
Nothing
True
where
isattached = itm ^?! itLocation . ilIsAttached
rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
-1
View File
@@ -109,7 +109,6 @@ data EquipItemType
| POWERLEGS
| SPEEDLEGS
| JUMPLEGS
| JETPACK
| FUELPACK
| BULLETBELTPACK
| BULLETBELTBRACER
-1
View File
@@ -67,7 +67,6 @@ itemFromEquipType et = case et of
POWERLEGS -> powerLegs
SPEEDLEGS -> speedLegs
JUMPLEGS -> jumpLegs
JETPACK -> jetPack
BATTERYPACK -> batteryPack
FUELPACK -> fuelPack
BULLETBELTPACK -> bulletBeltPack
-1
View File
@@ -83,7 +83,6 @@ equipItemSPic et _ = case et of
POWERLEGS -> legsSPic yellow
SPEEDLEGS -> legsSPic green
JUMPLEGS -> legsSPic red
JETPACK -> noPic $ colorSH yellow backpackShape
BATTERYPACK -> noPic $ colorSH blue backpackShape
FUELPACK ->
noPic $ colorSH yellow $ upperPrismPolyMT 10 $ polyCirc 3 5
-8
View File
@@ -8,7 +8,6 @@ module Dodge.Item.Equipment (
brainHat,
frontArmour,
headLamp,
jetPack,
fuelPack,
batteryPack,
bulletBeltPack,
@@ -88,13 +87,6 @@ bulletBeltBracer =
& itUse . equipEffect . eeUse .~ EAmmoSource 100 100 --BulletSource
Nothing
jetPack :: Item
jetPack =
defaultEquipment
& itUse . equipEffect . eeSite .~ GoesOnBack
& itType .~ EQUIP JETPACK
& itUse . equipEffect . eeAttachPos .~ V3 (-8) 0 10
brainHat :: Item
brainHat =
defaultEquipment
-1
View File
@@ -117,7 +117,6 @@ equipInfo eit = case eit of
POWERLEGS -> "Strength enhancing legs."
SPEEDLEGS -> "Speed enhancing legs."
JUMPLEGS -> "Jump enhancing legs."
JETPACK -> "A device enabling flight."
FUELPACK -> "A liquid container with attached hose."
BULLETBELTPACK -> "A container holding a long belt of bullets."
BULLETBELTBRACER -> "A container holding a long belt of bullets."
+2 -2
View File
@@ -21,8 +21,8 @@ orientByLink itm lt = case (_itType itm,lt) of
orientAttachment :: Item -> ComposeLinkType -> Item -> Maybe (Point3, Q.Quaternion Float)
orientAttachment par lnk ch = Just $ case (_itType par,lnk,_itType ch) of
(HELD BURSTRIFLE,_,HELD TORCH) -> (V3 20 0 0, Q.qID)
(HELD LAUNCHER,_,HELD TORCH) -> (V3 0 20 0, Q.qID)
-- (HELD BURSTRIFLE,_,HELD TORCH) -> (V3 20 0 0, Q.qID)
-- (HELD LAUNCHER,_,HELD TORCH) -> (V3 0 20 0, Q.qID)
_ -> (t1 + Q.rotate q1 t2, q1 * q2)
where
(t1,q1) = orientByLink par lnk
+5 -11
View File
@@ -1,7 +1,7 @@
module Dodge.LightSource.Torch where
module Dodge.LightSource.Torch
( createTorchLightOffset
) where
import Color
import Dodge.WorldEvent.Flash
import Dodge.Data.World
import Dodge.Item.Draw -- heldItemOffset needs to be moved somewhere more sensible
import Dodge.LightSource -- this needs to be split!
@@ -9,14 +9,8 @@ import Geometry
import LensHelp
createTorchLightOffset :: Creature -> Item -> Point3 -> World -> World
createTorchLightOffset cr it off =
(cWorld . lWorld . tempLightSources
.:~ tlsTimeRadColPos
1
250
0.7
pos
)
createTorchLightOffset cr it off = cWorld . lWorld . tempLightSources .:~
tlsTimeRadColPos 1 250 0.7 pos
where
pos = (p +.+.+ rotate3 (_crDir cr) (heldItemOffset it cr (off +.+.+ V3 8 0 1.5)))
p = addZ 0 $ _crPos cr