135 lines
4.5 KiB
Haskell
135 lines
4.5 KiB
Haskell
module Dodge.Euse where
|
|
|
|
import Dodge.LightSource
|
|
import Dodge.Item.HeldOffset
|
|
import Dodge.Wall.Create
|
|
import Color
|
|
import Dodge.Default.Wall
|
|
import Dodge.Creature.Test
|
|
import Dodge.Creature.HandPos
|
|
import Geometry
|
|
import Dodge.Wall.Move
|
|
import Dodge.Wall.Delete
|
|
import Dodge.Wall.ForceField
|
|
import Dodge.Item.Location
|
|
import Dodge.Data
|
|
import Dodge.Item.Weapon.ExtraEffect
|
|
import Dodge.Item.Weapon.Radar
|
|
import Dodge.SoundLogic.ExternallyGeneratedSounds
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
|
|
useE :: Euse -> Item -> Creature -> World -> World
|
|
useE eo = case eo of
|
|
EDoNothing -> const $ const id
|
|
EDetector dt -> autoEffect (detectorEffect dt) 100 click1S
|
|
EMagShield -> useMagShield
|
|
EWristShield -> setWristShieldPos
|
|
EHeadLamp -> createHeadLamp
|
|
ECamouflage vis -> overCID (crCamouflage .~ vis)
|
|
EonWristShield -> onEquipWristShield
|
|
EoffWristShield -> onRemoveWristShield
|
|
|
|
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 ^? itParams . magShieldMgMIX . _Just of
|
|
Just mgid' -> mgid'
|
|
Nothing -> IM.newKey $ _magnets (_cWorld w)
|
|
|
|
onEquipWristShield :: Item -> Creature -> World -> World
|
|
onEquipWristShield itm cr w =
|
|
w
|
|
& pointerToItem 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 _ =
|
|
(pointerToItem 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 (_itLocation itm)
|
|
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
|
|
|
|
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 ^? itParams . flatShieldWlMIX . _Just of
|
|
Nothing ->
|
|
let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
|
|
in w' & pointerToItem it . itParams .~ FlatShieldParams (Just wlid)
|
|
Just wid -> moveWallID wid wlline w
|
|
where
|
|
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 _ w = case it ^? itParams . flatShieldWlMIX . _Just of
|
|
Nothing -> w
|
|
Just wid ->
|
|
w & deleteWallID wid
|
|
& pointerToItem it . itParams . flatShieldWlMIX .~ Nothing
|
|
|
|
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)))
|
|
|
|
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
|
|
overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f
|