Add forgotten files, many updates concerning turrets and shields

src/Dodge/Item/Draw.hs

@@ -55,8 +55,8 @@ pictureWeaponOnAimItem p cr posInInv
     drawnWep        = translateSPf (1.2 * _crRad cr) 0 p
     twistWep        = translateSPf (0.5 * _crRad cr) 0 p
     oneHandWep      = translateSPf (1.5 * _crRad cr) 0 p
-    holsteredWep    = translateSPf (_crRad cr) 0 (rotateSP (sRot + 1.2) p)
-    holsteredTwoFlat    = translateSPf (_crRad cr) 0 (rotateSP (2*sRot) p)
+    holsteredWep    = translateSPf (_crRad cr) 0 (rotateSP (strideRot cr + 1.2) p)
+    holsteredTwoFlat    = translateSPf (_crRad cr) 0 (rotateSP (twoFlatHRot cr) p)
     holsteredOneHandWep = translateSPf (_crRad cr * 0.7 + handPos) (_crRad cr * negate 0.7) p
     handPos = case cr^? crStance . carriage of
         Just (Walking x LeftForward) -> f x * 50
@@ -65,13 +65,21 @@ pictureWeaponOnAimItem p cr posInInv
     isTwisting = _itAimStance theIt == TwoHandTwist
     isOneHand = _itAimStance theIt == OneHand
     isTwoHandFlat = _itAimStance theIt == TwoHandFlat
-    sRot = case cr ^? crStance . carriage of
+    f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
+    sLen = _strideLength $ _crStance cr
+
+strideRot :: Creature -> Float
+strideRot cr = case cr ^? crStance . carriage of
         Just (Walking x LeftForward)  -> f x
         Just (Walking x RightForward) -> - f x
         _ -> 0
+  where
     f i = 0.1 * fromIntegral (sLen - i) / fromIntegral sLen
     sLen = _strideLength $ _crStance cr
 
+twoFlatHRot :: Creature -> Float
+twoFlatHRot cr = 2*strideRot cr
+
 pictureItem
     :: SPic 
     -> Creature 

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

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -188,12 +188,13 @@ moveLaser phaseV pos dir w pt
     xp = pos +.+ 800 *.* unitVectorAtAngle dir
     f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2])
     f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
+    --f seenWs x y = case find (h' seenWs) $ thingsHitExceptCr Nothing x y w of
         Just (p,Right wl) 
-            | _wlOpacity wl == SeeThrough -> f' p $ f (wl:seenWs) p (h x y wl p)
+            | _wlOpacity wl == SeeThrough -> addPoint p $ f (wl:seenWs) p (h x y wl p)
             | otherwise -> (Just (p,Right wl), [p])
         Just (p,obj) -> (Just (p,obj), [p])
         Nothing -> (Nothing, [y])
-    f' p (x,ps') = (x,p:ps')
+    addPoint p (x,ps') = (x,p:ps')
     h x y wl p 
         | isEntering = p +.+ rotateV angleRef normalDist
         | otherwise = p +.+ rotateV angleRef' normalDist'