88 lines
2.6 KiB
Haskell
88 lines
2.6 KiB
Haskell
module Dodge.Item.BackgroundEffect (
|
|
itEffectOnPickup,
|
|
itEffectOnDrop,
|
|
rootNotrootEff,
|
|
createShieldWall,
|
|
removeShieldWall,
|
|
) where
|
|
|
|
import Linear
|
|
import Control.Lens
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Creature.Test
|
|
import Dodge.Data.World
|
|
import Dodge.Default.Wall
|
|
import Dodge.Item.HeldOffset
|
|
import Dodge.Item.Location
|
|
import Dodge.Wall.Create
|
|
import Dodge.Wall.Delete
|
|
import Dodge.Wall.Move
|
|
import Geometry.Vector
|
|
|
|
cancelExamineInventory :: World -> World
|
|
cancelExamineInventory = hud . subInventory %~ f
|
|
where
|
|
f ExamineInventory = NoSubInventory
|
|
f x = x
|
|
|
|
rootNotrootEff ::
|
|
(Item -> Creature -> World -> World) ->
|
|
(Item -> Creature -> World -> World) ->
|
|
Item ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
rootNotrootEff f g it
|
|
| it ^? itLocation . ilIsRoot == Just True = f it
|
|
| otherwise = g it
|
|
|
|
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 =cr ^. crPos . _xy
|
|
rad = crRad (cr ^. crType) + 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
|
|
|
|
itEffectOnPickup :: Item -> Creature -> World -> World
|
|
itEffectOnPickup _ _ = id
|
|
|
|
itEffectOnDrop :: Item -> Creature -> World -> World
|
|
itEffectOnDrop itm cr w = case itm ^. itType of
|
|
HELD MINIGUNX{} -> w & pointerToItemID (_itID itm) . itParams . wTime .~ 0
|
|
HELD MACHINEPISTOL{} ->
|
|
w & pointerToItemID (_itID itm) . itParams
|
|
.~ WarmTime 0 False Nothing
|
|
ITEMSCAN -> cancelExamineInventory w
|
|
HELD FLATSHIELD -> removeShieldWall itm cr w
|
|
_ -> w
|
|
|
|
shieldWall :: Int -> Wall
|
|
shieldWall crid =
|
|
defaultWall
|
|
{ --_wlColor = yellow
|
|
_wlOpacity = SeeAbove
|
|
, _wlMaterial = Metal
|
|
, _wlRotateTo = False
|
|
, _wlStructure = CreaturePart crid -- shieldWallDamage
|
|
-- , _wlPathFlag = mempty
|
|
}
|
|
-- & wlPathFlag .~ mempty
|