Work on cleaning up item effects/attachments etc
This commit is contained in:
+9
-208
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user