Add forgotten files, many updates concerning turrets and shields

src/Dodge/Item/Equipment.hs

@@ -2,13 +2,23 @@ module Dodge.Item.Equipment
     where
 import Dodge.Data
 import Dodge.Item.Data
+import Dodge.Item.Draw
 import Dodge.Default
+import Dodge.Default.Wall
 import Dodge.Picture.Layer
+import Dodge.Item.Weapon.BatteryGuns
+import Dodge.Creature.Test
+import Dodge.Wall.Reflect
+import Dodge.Wall
+import Dodge.Creature.State.Data
 import Picture
 import Geometry
---import ShapePicture
+import ShapePicture
 import Shape
 
+import qualified Data.IntMap.Strict as IM
+import Control.Lens
+
 magShield :: Item
 magShield = defaultEquipment
     { _itIdentity = MagShield
@@ -43,6 +53,83 @@ frontArmour = defaultEquipment
     }
 flatShield :: Item
 flatShield = defaultEquipment
+    { _itEquipPict = pictureWeaponOnAim flatShieldEquipSPic
+    , _itAimStance = TwoHandFlat
+    , _itEffect = effectOnOffEquip createShieldWall removeShieldWall
+    }
+flatShieldEquipSPic :: Item -> SPic
+flatShieldEquipSPic _ = 
+    ( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10)
+    , mempty
+    )
+effectOnEquip :: (Creature -> Item -> World -> World) -> ItEffect
+effectOnEquip f = ItInvEffectID
+    { _itInvEffect = g f
+    , _itEffectID = Nothing
+    }
+  where
+    g f' _ cr invid w 
+        | _crInvSel cr == invid = f' cr (_crInv (_creatures w IM.! _crID cr) IM.! invid) w
+        | otherwise = w
+
+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
+    }
+
+shieldWallDamage :: DamageType -> Wall -> Int -> World -> World
+shieldWallDamage dt wl crid w = case dt of
+    Lasering {_dmFrom=df,_dmAt=da} -> 
+        w & instantParticles %~ (makeLaserAt 5 (da +.+ normalizeV (df -.- da)) (reflDirWall df da wl) :)
+    d | isMovementDam d -> w & creatures . ix crid . crState . crDamage %~ (d :)
+    _ -> w
+
+createShieldWall :: Creature -> Int -> World -> World
+createShieldWall cr invid w = case _itEffectID $ _itEffect it of
+    Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline}) w
+        in w' & creatures . ix crid . crInv . ix invid . itEffect . itEffectID ?~ 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 _itEffectID $ _itEffect it of
+    Nothing -> w
+    Just wid -> w & deleteWallID wid 
+        & creatures . ix crid . crInv . ix invid . itEffect . itEffectID .~ Nothing
+  where
+    crid = _crID cr
+    it = _crInv (_creatures w IM.! crid) IM.! invid
+
+effectOnOffEquip 
+    :: (Creature -> Int -> World -> World)     -- ^ effect when equiped
+    -> (Creature -> Int -> World -> World)     -- ^ effect when not equiped
+    -> ItEffect
+effectOnOffEquip f f' = ItInvEffectID
+    { _itInvEffect = g
+    , _itEffectID = Nothing
+    }
+  where
+    g _ cr invid w 
+        | _crInvSel cr == invid = f  cr invid w
+        | otherwise             = f' cr invid w
+
 {- | Increases speed, reduces friction, cannot only move forwards. -}
 jetPack :: Item
 jetPack = defaultEquipment