290 lines
9.4 KiB
Haskell
290 lines
9.4 KiB
Haskell
module Dodge.Item.Equipment
|
|
( module Dodge.Item.Equipment.Booster
|
|
, magShield
|
|
, powerLegs
|
|
, flatShield
|
|
, wristInvisibility
|
|
, wristArmour
|
|
, brainHat
|
|
, frontArmour
|
|
, headLamp
|
|
, headLamp1
|
|
, jetPack
|
|
, speedLegs
|
|
, jumpLegs
|
|
, flameShield
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Item.Draw
|
|
import Dodge.Item.Equipment.Shape
|
|
import Dodge.Item.Equipment.Booster
|
|
import Dodge.LightSource
|
|
import Dodge.Default
|
|
import Dodge.Default.Wall
|
|
import Dodge.Creature.Test
|
|
import Dodge.Creature.HandPos
|
|
import Dodge.Wall
|
|
import Dodge.Wall.ForceField
|
|
import Dodge.Magnet
|
|
import Picture
|
|
import Geometry
|
|
import ShapePicture
|
|
import Shape
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
--import ShortShow
|
|
|
|
import Data.Maybe
|
|
magShield :: Item
|
|
magShield = defaultEquipment
|
|
{ _itEquipPict = \_ _ -> (,) emptySH blank
|
|
, _itID = Nothing
|
|
, _itAttachment = AttachMInt Nothing
|
|
}
|
|
& itUse . eqEq . eqUse .~ useMagShield
|
|
& itUse . eqEq . eqSite .~ GoesOnWrist
|
|
& itType . iyBase .~ MAGSHIELD
|
|
useMagShield :: Item -> Creature -> World -> World
|
|
useMagShield it cr w = w & magnets . at mgid ?~ themagnet
|
|
where
|
|
themagnet = Magnet
|
|
{_mgID = mgid
|
|
,_mgUpdate = Just . (mgUpdate .~ const Nothing)
|
|
,_mgPos = _crPos cr
|
|
,_mgField = curveAroundField 50 200
|
|
}
|
|
mgid = case it ^? itAttachment . atMInt . _Just of
|
|
Just mgid' -> mgid'
|
|
Nothing -> IM.newKey $ _magnets w
|
|
-- it = _crInv cr IM.! invid
|
|
|
|
flameShield :: Item
|
|
flameShield = defaultEquipment
|
|
{ _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
|
|
, _itID = Nothing
|
|
} & itUse . eqEq . eqSite .~ GoesOnChest
|
|
& itType . iyBase .~ FLAMESHIELD
|
|
{- | Slows you down, blocks forward projectiles. -}
|
|
frontArmour :: Item
|
|
frontArmour = defaultEquipment
|
|
{ _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures
|
|
[color thecol $ thickArc 0 (pi/2) 10 5
|
|
,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
|
|
])
|
|
, _itID = Nothing
|
|
}
|
|
& itUse . eqEq . eqSite .~ GoesOnChest
|
|
& itType . iyBase .~ FRONTARMOUR
|
|
where
|
|
thecol = yellow -- (greyN 0.1)
|
|
|
|
wristArmour :: Item
|
|
wristArmour = defaultEquipment
|
|
{ _itEquipPict = spicForWrist mempty
|
|
, _itID = Nothing
|
|
}
|
|
& itUse . eqEq . eqSite .~ GoesOnWrist
|
|
& itUse . eqEq . eqOnEquip .~ onEquipWristShield
|
|
& itUse . eqEq . eqUse .~ setWristShieldPos
|
|
& itUse . eqEq . eqOnRemove .~ onRemoveWristShield
|
|
& itType . iyBase .~ WRISTARMOUR
|
|
|
|
onEquipWristShield :: Item -> Creature -> World -> World
|
|
onEquipWristShield itm cr w = w
|
|
& creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos itm)) . itUse . eqEq . eqParams .~ EquipID i
|
|
& walls . at i ?~ forceField {_wlID = i}
|
|
& setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
|
|
where
|
|
i = IM.newKey (_walls w)
|
|
|
|
onRemoveWristShield :: Item -> Creature -> World -> World
|
|
onRemoveWristShield itm cr w = w
|
|
& creatures . ix (_crID cr) . crInv . ix (fromJust (_itInvPos 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 = fromJust (_itInvPos 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
|
|
|
|
|
|
flatShield :: Item
|
|
flatShield = defaultEquipment
|
|
{ _itEquipPict = pictureWeaponAim flatShieldEquipSPic
|
|
, _itEffect = effectOnOffHeld createShieldWall removeShieldWall
|
|
-- the above seems to work, but I am not sure why: it may break on edge
|
|
-- cases
|
|
, _itUse = RightUse
|
|
{ _rUse = \_ _ -> id
|
|
, _useDelay = NoDelay
|
|
, _useMods = []
|
|
, _useHammer = NoHammer
|
|
, _useAim = AimParams
|
|
{ _aimWeight = 5
|
|
, _aimRange = 0
|
|
, _aimZoom = ItZoom 20 0.2 1
|
|
, _aimStance = TwoHandFlat
|
|
}
|
|
, _heldScroll = \_ _ -> id
|
|
}
|
|
, _itInvSize = 3
|
|
}
|
|
& itType . iyBase .~ FLATSHIELD
|
|
flatShieldEquipSPic :: Item -> SPic
|
|
flatShieldEquipSPic _ =
|
|
( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10)
|
|
, mempty
|
|
)
|
|
|
|
shieldWall :: Int -> Wall
|
|
shieldWall crid = defaultWall
|
|
{_wlColor = yellow
|
|
,_wlOpacity = SeeAbove
|
|
,_wlPathable = True
|
|
,_wlWalkable = True
|
|
,_wlFireThrough = True
|
|
,_wlReflect = True
|
|
,_wlDraw = 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 :: Creature -> Int -> World -> World
|
|
createShieldWall cr invid w = case _ieMID $ _itEffect it of
|
|
Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
|
|
in w' & creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
|
|
Just wid -> moveWallID wid wlline w
|
|
where
|
|
crid = _crID cr
|
|
it = _crInv (_creatures w IM.! crid) IM.! invid
|
|
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 :: Creature -> Int -> World -> World
|
|
removeShieldWall cr invid w = case _ieMID $ _itEffect it of
|
|
Nothing -> w
|
|
Just wid -> w & deleteWallID wid
|
|
& creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
|
|
where
|
|
crid = _crID cr
|
|
it = _crInv (_creatures w IM.! crid) IM.! invid
|
|
|
|
effectOnOffHeld
|
|
:: (Creature -> Int -> World -> World) -- ^ effect when held
|
|
-> (Creature -> Int -> World -> World) -- ^ effect when not held
|
|
-> ItEffect
|
|
effectOnOffHeld f f' = ItInvEffectID
|
|
{ _ieInv = g
|
|
, _ieMID = Nothing
|
|
}
|
|
where
|
|
g itm cr w
|
|
| crSel cr == invid = f cr invid w
|
|
| otherwise = f' cr invid w
|
|
where
|
|
invid = fromJust $ _itInvPos itm
|
|
|
|
{- | Increases speed, reduces friction, cannot only move forwards. -}
|
|
jetPack :: Item
|
|
jetPack = defaultEquipment
|
|
{ _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
|
|
$ pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-11) (-3) ]
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
} & itUse . eqEq . eqSite .~ GoesOnBack
|
|
& itType . iyBase .~ JETPACK
|
|
|
|
brainHat :: Item
|
|
brainHat = defaultEquipment
|
|
{ _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
}
|
|
& itUse . eqEq . eqSite .~ GoesOnHead
|
|
& itType . iyBase .~ BRAINHAT
|
|
|
|
headLamp1 :: Item
|
|
headLamp1 = defaultEquipment
|
|
{ _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $
|
|
translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1)
|
|
<> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1)
|
|
-- <> (upperPrismPoly 3 $ rectWH 4 4)
|
|
)
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
}
|
|
& itUse . eqEq . eqUse .~ createHeadLamp
|
|
& itUse . eqEq . eqSite .~ GoesOnHead
|
|
& itType . iyBase .~ HEADLAMP1
|
|
headLamp :: Item
|
|
headLamp = defaultEquipment
|
|
{ _itEquipPict = pictureOnEquip (noPic headLampShape)
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
}
|
|
& itUse . eqEq . eqUse .~ createHeadLamp
|
|
& itUse . eqEq . eqSite .~ GoesOnHead
|
|
& itType . iyBase .~ HEADLAMP
|
|
|
|
headLampShape :: Shape
|
|
headLampShape = colorSH yellow $
|
|
translateSH (V3 5 2 4) (upperPrismPoly 4 $ rectWH 4 1)
|
|
<> translateSH (V3 5 2 0) (upperPrismPoly 4 $ rectWH 4 1)
|
|
<> translateSH (V3 5 (-2) 4) (upperPrismPoly 4 $ rectWH 4 1)
|
|
<> translateSH (V3 5 (-2) 0) (upperPrismPoly 4 $ rectWH 4 1)
|
|
|
|
createHeadLamp :: Item -> Creature -> World -> World
|
|
createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
|
|
((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
|
|
|
|
powerLegs :: Item
|
|
powerLegs = defaultEquipment
|
|
{ _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
}
|
|
& itUse . eqEq . eqSite .~ GoesOnLegs
|
|
& itType . iyBase .~ POWERLEGS
|
|
speedLegs :: Item
|
|
speedLegs = powerLegs
|
|
& itType . iyBase .~ SPEEDLEGS
|
|
jumpLegs :: Item
|
|
jumpLegs = powerLegs
|
|
& itType . iyBase .~ JUMPLEGS
|
|
|
|
wristInvisibility :: Item
|
|
wristInvisibility = defaultEquipment
|
|
{ _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
|
|
, _itID = Nothing
|
|
}
|
|
& itUse . eqEq . eqSite .~ GoesOnWrist
|
|
& itUse . eqEq . eqOnEquip .~ overCID (crCamouflage .~ Invisible)
|
|
& itUse . eqEq . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible)
|
|
& itType . iyBase .~ INVISIBILITYEQUIPMENT GoesOnWrist
|
|
|
|
overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
|
|
overCID f _ cr = creatures . ix (_crID cr) %~ f
|