272 lines
8.4 KiB
Haskell
272 lines
8.4 KiB
Haskell
module Dodge.Item.Equipment
|
|
( module Dodge.Item.Equipment.Booster
|
|
, 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 Dodge.Data
|
|
import Dodge.Item.Draw
|
|
import Dodge.Item.Equipment.Booster
|
|
import Dodge.LightSource
|
|
import Dodge.Default
|
|
import Dodge.Creature.Test
|
|
import Dodge.Creature.HandPos
|
|
import Dodge.Wall
|
|
import Dodge.Wall.ForceField
|
|
import Picture
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
|
|
import Data.Maybe
|
|
|
|
magShield :: Item
|
|
magShield = defaultEquipment
|
|
{ _itID = Nothing
|
|
, _itAttachment = AttachMInt Nothing
|
|
}
|
|
& itUse . eqEq . eqUse .~ EMagShield --useMagShield
|
|
& 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
|
|
& 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)
|
|
& itType . iyBase .~ HELD TORCH
|
|
& itUse . useAim . aimHandlePos .~ 5
|
|
& itUse . useAim . aimMuzPos .~ 10
|
|
|
|
flatShield :: Item
|
|
flatShield = defaultWeapon
|
|
& itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall --createShieldWall removeShieldWall
|
|
-- the above seems to work, but I am not sure why: it may break on edge
|
|
-- cases
|
|
& itUse .~ defaultrUse
|
|
{ _rUse = HeldDoNothing
|
|
, _useDelay = NoDelay
|
|
, _useMods = HeldModNothing
|
|
, _useHammer = HammerUp
|
|
, _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 _ieMID $ _itEffect it 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
|
|
:: ItInvEffect -- ^ effect when held
|
|
-> ItInvEffect -- ^ effect when not held
|
|
-> 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 . 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
|
|
speedLegs :: Item
|
|
speedLegs = powerLegs
|
|
& itType . iyBase .~ EQUIP SPEEDLEGS
|
|
jumpLegs :: Item
|
|
jumpLegs = powerLegs
|
|
& itType . iyBase .~ EQUIP 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
|