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

Work on cleaning up item effects/attachments etc

Browse Source
This commit is contained in:
justin
2022-07-27 16:39:58 +01:00
parent 8d17ce66e9
commit b52adddd5d
39 changed files with 696 additions and 844 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Attachment.hs
-42
View File
@@ -1,42 +0,0 @@
module Dodge.Item.Attachment
( charFiringStratI
, changeFuse
) where
import Dodge.Data
import Dodge.ChainEffect
import Dodge.Default
import Control.Lens hiding ((|>),(<|))
import Data.Sequence
import Data.Maybe
import qualified IntMapHelp as IM
charFiringStratI
:: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
-> ChainEffect
charFiringStratI strats eff item cr w = case w ^? cWorld . creatures . ix cid . crInv
. ix (crSel $ _creatures (_cWorld w) IM.! cid) . itUse . heldScroll . hsCharMode of
Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
_ -> w
where
cid = _crID cr
changeFuse
:: Float -- ^ Old fuse time
-> Creature -- ^ Inventory item reference (I believe)
-> Item
-> Item
changeFuse scrollAmount _ it = it
& ( itAttachment .~ AttachFuse newTime )
& ( itUse . useAim . aimZoom .~ defaultItZoom{_itZoomMax = zm, _itZoomMin = zm} )
where
oldTime = _atFuseTime $ _itAttachment it
newTime = min 90 $ max 20 $ oldTime - round (5 * scrollAmount)
zm = 50 / fromIntegral newTime
--removeItAttachment :: Int -> Int -> World -> World
--removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ NoItAttachment
-- where
-- cr = _creatures w IM.! i
-- itRef = _crInvSel cr
src/Dodge/Item/Draw.hs
+1 -1
View File
@@ -33,7 +33,7 @@ pictureWeaponAim
-> Creature
-> Item
-> SPic
pictureWeaponAim f cr itm = case _itPos itm of
pictureWeaponAim f cr itm = case _itLocation itm of
InInv _ i -> pictureWeaponOnAimItem (f itm) cr i
_ -> mempty
src/Dodge/Item/Draw/SPic.hs
-1
View File
@@ -31,7 +31,6 @@ equipItemSPic et _ = case et of
BRAINHAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
HAT -> noPic (colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
HEADLAMP -> noPic headLampShape
HEADLAMP1 -> noPic headLampShape
POWERLEGS -> legsSPic yellow
SPEEDLEGS -> legsSPic green
JUMPLEGS -> legsSPic red
src/Dodge/Item/Equipment.hs
+9 -208
View File
@@ -3,283 +3,89 @@ module Dodge.Item.Equipment (
torch,
magShield,
powerLegs,
flatShield,
wristInvisibility,
wristArmour,
hat,
brainHat,
frontArmour,
headLamp,
headLamp1,
jetPack,
speedLegs,
jumpLegs,
flameShield,
useMagShield,
setWristShieldPos,
createHeadLamp,
overCID,
onEquipWristShield,
onRemoveWristShield,
createShieldWall,
removeShieldWall,
) where
import Data.Maybe
import Dodge.Creature.HandPos
import Dodge.Creature.Test
import Dodge.Data
import Dodge.Data.CamouflageStatus
import Dodge.Data.Item
import Dodge.Default
import Dodge.Item.Equipment.Booster
import Dodge.Item.HeldOffset
import Dodge.LightSource
import Dodge.Wall
import Dodge.Wall.ForceField
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import Picture
magShield :: Item
magShield =
defaultEquipment
{ _itID = Nothing
, _itAttachment = AttachMInt Nothing
}
& itUse . eqEq . eqUse .~ EMagShield --useMagShield
& itParams .~ MagShieldParams Nothing
& itUse . eqEq . eqUse .~ EMagShield
& itUse . eqEq . eqSite .~ GoesOnWrist
& itType . iyBase .~ EQUIP MAGSHIELD
useMagShield :: Item -> Creature -> World -> World
useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
where
themagnet =
Magnet
{ _mgID = mgid
, _mgUpdate = MagnetUpdateTimer 1
, _mgPos = _crPos cr
, _mgField = MagnetBuBuCurveAroundField 50 200
}
mgid = case it ^? itAttachment . atMInt . _Just of
Just mgid' -> mgid'
Nothing -> IM.newKey $ _magnets (_cWorld w)
-- it = _crInv cr IM.! invid
flameShield :: Item
flameShield =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FLAMESHIELD
-- | Slows you down, blocks forward projectiles.
frontArmour :: Item
frontArmour =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnChest
& itType . iyBase .~ EQUIP FRONTARMOUR
wristArmour :: Item
wristArmour =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
& itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
& itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
& itUse . eqEq . eqOnEquip .~ EonWristShield
& itUse . eqEq . eqUse .~ EWristShield
& itUse . eqEq . eqOnRemove .~ EoffWristShield
& itType . iyBase .~ EQUIP WRISTARMOUR
onEquipWristShield :: Item -> Creature -> World -> World
onEquipWristShield itm cr w =
w
& 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 (_cWorld w))
onRemoveWristShield :: Item -> Creature -> World -> World
onRemoveWristShield itm cr w =
w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
& deleteWallID i
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
setWristShieldPos :: Item -> Creature -> World -> World
setWristShieldPos itm cr w =
w
& moveWallIDUnsafe i wlline
where
i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
invid = _ipInvID (_itPos itm)
--wlline = (V2 10 0, V2 (-10) 100)
handtrans = case cr ^? crInvEquipped . ix invid of
Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
_ -> translatePointToRightHand
g
| twists cr = (+.+.+ V3 (-5) 10 0)
| otherwise = id
f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
torch :: Item
torch =
defaultWeapon
& itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect -- createHeldLight (const $ const id)
& itEffect . ieInv .~ EffectWhileHeld CreateHeldLight
& itType . iyBase .~ HELD TORCH
& itUse . useAim . aimHandlePos .~ 5
& itUse . useAim . aimMuzPos .~ 10
flatShield :: Item
flatShield =
defaultWeapon
& itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall
& itUse
.~ defaultrUse
{ _useAim =
AimParams
{ _aimWeight = 5
, _aimRange = 0
, _aimZoom = ItZoom 20 0.2 1
, _aimStance = TwoHandFlat
, _aimHandlePos = 0
, _aimMuzPos = 0
}
}
& itInvSize .~ 3
& itType . iyBase .~ HELD FLATSHIELD
shieldWall :: Int -> Wall
shieldWall crid =
defaultWall
{ _wlColor = yellow
, _wlOpacity = SeeAbove
, _wlPathable = True
, _wlWalkable = True
, _wlFireThrough = True
, _wlReflect = True
, _wlUnshadowed = False
, _wlRotateTo = False
, _wlStructure = CreaturePart crid -- shieldWallDamage
}
-- TODO the reflection should be controled by the particle
--shieldWallDamage :: Damage -> Wall -> Int -> World -> World
--shieldWallDamage dm _ crid w = case _dmType dm of
---- Lasering -> w
-- _ | isMovementDam dm -> w & creatures . ix crid . crState . crDamage .:~ dm
-- _ -> w
createShieldWall :: Item -> Creature -> World -> World
createShieldWall it cr w = case it ^? itEffect . ieMID . _Just of
Nothing ->
let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
Just wid -> moveWallID wid wlline w
where
invid = fromJust $ _itID it
crid = _crID cr
wlline = (a, b)
crdirv = unitVectorAtAngle $ _crDir cr
crpos = _crPos cr
rad = _crRad cr + 2
a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
therot
| crIsAiming cr = vNormal
| otherwise = rotateV (twoFlatHRot cr) . vNormal
removeShieldWall :: Item -> Creature -> World -> World
removeShieldWall it cr w = case _ieMID $ _itEffect it of
Nothing -> w
Just wid ->
w & deleteWallID wid
& cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
where
crid = _crID cr
invid = fromJust (_itID it)
effectOnOffHeld ::
-- | effect when held
ItInvEffect ->
-- | effect when not held
ItInvEffect ->
ItEffect
effectOnOffHeld f f' =
ItInvEffectID
{ _ieInv = OnOffHeldEffect f f'
, _ieMID = Nothing
}
-- | Increases speed, reduces friction, cannot only move forwards.
jetPack :: Item
jetPack =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnBack
& itType . iyBase .~ EQUIP JETPACK
brainHat :: Item
brainHat =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP BRAINHAT
hat :: Item
hat =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HAT
headLamp1 :: Item
headLamp1 =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP1
headLamp :: Item
headLamp =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
& itUse . eqEq . eqUse .~ EHeadLamp
& itUse . eqEq . eqSite .~ GoesOnHead
& itType . iyBase .~ EQUIP HEADLAMP
createHeadLamp :: Item -> Creature -> World -> World
createHeadLamp _ cr =
cWorld . tempLightSources
.:~ tlsTimeRadColPos
1
200
0.7
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
powerLegs :: Item
powerLegs =
defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnLegs
& itType . iyBase .~ EQUIP POWERLEGS
@@ -296,12 +102,7 @@ jumpLegs =
wristInvisibility :: Item
wristInvisibility =
defaultEquipment
{ _itID = Nothing
}
& itUse . eqEq . eqSite .~ GoesOnWrist
& itUse . eqEq . eqOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
& itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
& itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
src/Dodge/Item/Equipment/Booster.hs
+3 -3
View File
@@ -12,9 +12,9 @@ boosterGun =
defaultLeftItem
{ _itInvColor = cyan
, _itUse = luseInstantNoH LBoost
, _itEffect = resetAttachmentID
-- , _itEffect = resetAttachmentID
}
& itType . iyBase .~ LEFT BOOSTER
resetAttachmentID :: ItEffect
resetAttachmentID = ItInvEffect ResetAttachmentEffect 0
--resetAttachmentID :: ItEffect
--resetAttachmentID = ItInvEffect ResetAttachmentEffect 0
src/Dodge/Item/Equipment/Shape.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Data.Maybe
pictureOnEquip :: SPic -> Creature -> Item -> SPic
pictureOnEquip sp cr itm = fromMaybe mempty $ do
i <- itm ^? itPos . ipInvID
i <- itm ^? itLocation . ipInvID
epos <- cr^? crInvEquipped . ix i
return $ equipPosition epos cr sp
src/Dodge/Item/Held.hs
+24
View File
@@ -0,0 +1,24 @@
module Dodge.Item.Held
where
import Dodge.Default.Weapon
import Dodge.Data.Item
import Control.Lens
flatShield :: Item
flatShield =
defaultWeapon
& itEffect . ieInv .~ EffectIfHeld CreateShieldWall RemoveShieldWall
& itUse
.~ defaultrUse
{ _useAim =
AimParams
{ _aimWeight = 5
, _aimRange = 0
, _aimZoom = ItZoom 20 0.2 1
, _aimStance = TwoHandFlat
, _aimHandlePos = 0
, _aimMuzPos = 0
}
}
& itInvSize .~ 3
& itType . iyBase .~ HELD FLATSHIELD
src/Dodge/Item/Location.hs
+11 -7
View File
@@ -12,26 +12,30 @@ getHeldItemLoc :: Creature -> World -> (World,Int)
getHeldItemLoc cr w = case maybeitid of
Nothing ->
( w & cWorld . creatures . ix cid . crInv . ix j . itID ?~ newitid
& cWorld . itemPositions %~ IM.insert newitid (InInv cid j)
& cWorld . itemLocations %~ IM.insert newitid (InInv cid j)
, itid)
_ -> (w, itid)
where
cid = _crID cr
j = crSel cr
newitid = IM.newKey $ _itemPositions (_cWorld w)
newitid = IM.newKey $ _itemLocations (_cWorld w)
maybeitid = cr ^? crInv . ix j . itID . _Just
itid = fromMaybe newitid maybeitid
getItem :: Int -> World -> Maybe Item
getItem itid w = do
itpos <- w ^? cWorld . itemPositions . ix itid
itpos <- w ^? cWorld . itemLocations . ix itid
case itpos of
OnFloor flitid -> w ^? cWorld . floorItems . ix flitid . flIt
InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid
VoidItm -> Nothing
pointerToItemLocation :: Applicative f =>
ItemLocation -> (Item -> f Item) -> World -> f World
pointerToItemLocation (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointerToItemLocation (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointerToItemLocation _ = const pure
pointerToItem :: Applicative f =>
ItemPos -> (Item -> f Item) -> World -> f World
pointerToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
pointerToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
pointerToItem _ = const pure
Item -> (Item -> f Item) -> World -> f World
pointerToItem = pointerToItemLocation . _itLocation
src/Dodge/Item/PassKey.hs
+2 -10
View File
@@ -5,17 +5,9 @@ import Picture
import LensHelp
keyCard :: Int -> Item
keyCard n = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = aquamarine
}
& itInvColor .~ aquamarine
& itType . iyBase .~ HELD (KEYCARD n)
latchkey :: Int -> Item
latchkey _ = defaultEquipment
{ _itEffect = NoItEffect
, _itID = Nothing
-- , _itZoom = defaultItZoom
, _itInvColor = yellow
}
& itInvColor .~ yellow
src/Dodge/Item/Weapon/ExtraEffect.hs
+2 -2
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
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
. itUse . eqEq . eqParams . eparamInt .~ t
& soundStart OnceSound (_crPos cr) sid Nothing
| otherwise = w
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itPos itm)
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID $ _itLocation itm)
. itUse . eqEq . eqParams . eparamInt -~ 1
{- | Automatically send out radar pulses that detect walls. -}
src/Dodge/Item/Weapon/Launcher.hs
+1 -1
View File
@@ -118,5 +118,5 @@ explodeRemoteRocket itid pjid w =
& itPoint . itUse . rUse .~ HeldDoNothing
& usePayload (_prjPayload thepj) (_prjPos thepj)
where
itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
itPoint = pointerToItemLocation $ _itemLocations (_cWorld w) IM.! itid
thepj = _projectiles (_cWorld w) IM.! pjid
src/Dodge/Item/Weapon/Remote.hs
+3 -5
View File
@@ -1,18 +1,16 @@
module Dodge.Item.Weapon.Remote
( pointerToItem
, setRemoteScope
( setRemoteScope
, setRemoteBombScope
) where
import Dodge.Data
import Dodge.Default
import Geometry
import Dodge.Item.Location
import qualified IntMapHelp as IM
import Control.Lens
setRemoteBombScope :: Int -> Prop -> World -> World
setRemoteBombScope itid pj w' = case _itemPositions (_cWorld w') IM.! itid of
setRemoteBombScope itid pj w' = case _itemLocations (_cWorld w') IM.! itid of
InInv cid invid
-> w' & cWorld . creatures . ix cid . crInv . ix invid . itScope
. scopePos .~ (_prPos pj -.- _crPos (_creatures (_cWorld w') IM.! cid))
@@ -21,7 +19,7 @@ setRemoteBombScope itid pj w' = case _itemPositions (_cWorld w') IM.! itid of
_ -> w'
setRemoteScope :: Int -> Point2 -> World -> World
setRemoteScope itid pos w' = case w' ^? cWorld . itemPositions . ix itid of
setRemoteScope itid pos w' = case w' ^? cWorld . itemLocations . ix itid of
Just (InInv cid' invid )
-> w' & cWorld . creatures . ix cid' . crInv . ix invid . itScope
. scopePos .~ (pos -.- _crPos (_creatures (_cWorld w') IM.! cid'))
src/Dodge/Item/Weapon/TriggerType.hs
+1 -1
View File
@@ -363,7 +363,7 @@ shootL f item cr w
| otherwise = w
where
cid = _crID cr
invid = _ipInvID $ _itPos item
invid = _ipInvID $ _itLocation item
pointerToItem = cWorld . creatures . ix cid . crInv . ix invid
fireCondition = _rateTime (_useDelay (_itUse item)) == 0
&& _arLoaded (_leftConsumption (_itUse item)) > 0
src/Dodge/Item/Weapon/Utility.hs
+4 -6
View File
@@ -18,12 +18,12 @@ rewindGun :: Item
rewindGun =
defaultLeftItem
{ _itInvColor = cyan
, _itEffect = ItRewindEffect RewindEffect -- []
, _itUse =
defaultlUse
& lUse .~ LRewind --useRewindGun
& eqEq . eqSite .~ GoesOnChest
}
& itEffect . ieInv .~ RewindEffect
& itType . iyBase .~ LEFT REWINDER
& itUse . leftConsumption
.~ ChargeableAmmo
@@ -35,10 +35,8 @@ rewindGun =
shrinkGun :: Item
shrinkGun =
defaultLeftItem
{ _itUse = defaultlUse & lUse .~ LShrink -- hammerCheckL useShrinkGun
-- , _itFloorPict = shrinkGunPic
, _itAttachment = AttachBool True
}
& itUse .~ (defaultlUse & lUse .~ LShrink)
& itParams .~ ShrinkGunParams FullSize
& itType . iyBase .~ LEFT SHRINKER
shrinkGunPic :: Item -> SPic
@@ -100,7 +98,7 @@ useForceFieldGun itm cr w = fromMaybe w $ do
return $
w
& cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
& cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itLocation itm)) . itParams . paramMID ?~ i
& moveWallIDUnsafe i wlline
where
i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just