Cleanup, remove jetpack
This commit is contained in:
@@ -280,7 +280,6 @@ testInventory =
|
||||
stackedInventory :: [Item]
|
||||
stackedInventory =
|
||||
[ torch
|
||||
, torch
|
||||
, remoteScreen
|
||||
, megaShellMag
|
||||
, targetingScope TARGETLASER
|
||||
|
||||
+85
-149
@@ -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)
|
||||
|
||||
@@ -109,7 +109,6 @@ data EquipItemType
|
||||
| POWERLEGS
|
||||
| SPEEDLEGS
|
||||
| JUMPLEGS
|
||||
| JETPACK
|
||||
| FUELPACK
|
||||
| BULLETBELTPACK
|
||||
| BULLETBELTBRACER
|
||||
|
||||
@@ -67,7 +67,6 @@ itemFromEquipType et = case et of
|
||||
POWERLEGS -> powerLegs
|
||||
SPEEDLEGS -> speedLegs
|
||||
JUMPLEGS -> jumpLegs
|
||||
JETPACK -> jetPack
|
||||
BATTERYPACK -> batteryPack
|
||||
FUELPACK -> fuelPack
|
||||
BULLETBELTPACK -> bulletBeltPack
|
||||
|
||||
@@ -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,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
|
||||
|
||||
@@ -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."
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user