Tweak drawing of backpack equipment

src/Dodge/Base/Collide.hs

@@ -128,14 +128,6 @@ visibleWalls sp ep =
         . overlapSegWalls sp ep
         . wlsNearSeg sp ep
 
---visibleWalls :: Point2 -> Point2 -> World -> StreamOf (Point2,Wall)
---{-# INLINE visibleWalls #-}
---visibleWalls sp ep = S.take 1 <=<  -- hlint, was using join and fmap
---    ( S.span (not . wlIsOpaque . snd)
---    . sortStreamOn (dist sp . fst)
---    . overlapSegWalls sp ep
---    . wlsNearSeg sp ep    )
-
 allVisibleWalls :: World -> [(Point2, Wall)]
 {-# INLINE allVisibleWalls #-}
 allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20

src/Dodge/Creature/HandPos.hs

@@ -167,12 +167,11 @@ translateToChest cr
     | twists cr = rotateSP (-1)
     | otherwise = id
 
-translateToBack :: Creature -> SPic -> SPic
+translateToBack :: Creature -> Point3 -> SPic -> SPic
-translateToBack cr
+translateToBack cr p
-    | oneH cr = rotateSP 0.5
+    | oneH cr = rotateSP 0.5 . translateSP p
-    --    | twists cr = translateSPf 0 5 . rotateSP (-1)
+    | twists cr = rotateSP (-1.5) . translateSP (p - V3 5 0 0)
-    | twists cr = rotateSP (-1)
+    | otherwise = translateSP p
-    | otherwise = id
 
 shoulderSP :: SPic -> SPic
 shoulderSP = translateSPz 20

src/Dodge/Data/Item/Combine.hs

@@ -112,6 +112,7 @@ data EquipItemType
 
     | JETPACK
     | FUELPACK
+    | BATTERYPACK
 
     | AUTODETECTOR Detector
     deriving (Eq,Ord,Show,Read)

src/Dodge/Item.hs

@@ -43,6 +43,7 @@ itemFromEquipType et = case et of
     SPEEDLEGS -> speedLegs
     JUMPLEGS -> jumpLegs
     JETPACK -> jetPack
+    BATTERYPACK -> batteryPack
     FUELPACK -> fuelPack
     AUTODETECTOR d -> autoDetector d
 

src/Dodge/Item/Draw.hs

@@ -5,6 +5,7 @@ module Dodge.Item.Draw (
     heldItemOffset,
 ) where
 
+import Geometry.Data
 import Control.Lens
 import Data.Maybe
 import Dodge.Creature.HandPos
@@ -16,18 +17,14 @@ import ShapePicture
 itemEquipPict :: Creature -> Item -> SPic
 itemEquipPict cr it = case it ^. itUse of
     HeldUse{} | _itIsHeld it -> overPosSP (heldItemOffset it cr) (itemSPic it)
-    ituse -> case ituse ^? equipEffect of
+    ituse -> fromMaybe mempty $ do
-        Just _ -> pictureOnEquip (itemSPic it) cr it
+        attachpos <- ituse ^? equipEffect . eeAttachPos
-        Nothing -> mempty
+        i <- it ^? itLocation . ipInvID
+        epos <- cr ^? crInvEquipped . ix i
+        return $ equipPosition epos cr attachpos (itemSPic it)
 
-pictureOnEquip :: SPic -> Creature -> Item -> SPic
+equipPosition :: EquipPosition -> Creature -> Point3 -> SPic -> SPic
-pictureOnEquip sp cr itm = fromMaybe mempty $ do
+equipPosition epos cr p sh = case epos of
-    i <- itm ^? itLocation . ipInvID
-    epos <- cr ^? crInvEquipped . ix i
-    return $ equipPosition epos cr sp
-
-equipPosition :: EquipPosition -> Creature -> SPic -> SPic
-equipPosition epos cr sh = case epos of
     OnLeftWrist -> translateToLeftWrist cr sh
     OnRightWrist -> translateToRightWrist cr sh
     OnLegs ->
@@ -35,5 +32,5 @@ equipPosition epos cr sh = case epos of
             <> translateToRightLeg cr (mirrorSPxz sh)
     OnHead -> translateToHead cr sh
     OnChest -> translateToChest cr sh
-    OnBack -> translateToBack cr sh
+    OnBack -> translateToBack cr p sh
     OnSpecial -> sh

src/Dodge/Item/Draw/SPic.hs

@@ -40,17 +40,15 @@ equipItemSPic et _ = case et of
     POWERLEGS -> legsSPic yellow
     SPEEDLEGS -> legsSPic green
     JUMPLEGS -> legsSPic red
-    JETPACK ->
+    JETPACK -> noPic $ colorSH yellow backpackShape
-        (,) emptySH $
+    BATTERYPACK -> noPic $ colorSH blue backpackShape
-            setDepth 20 $
-                pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-4) (-4)]
     FUELPACK ->
-        (,) emptySH $
+        noPic $ colorSH yellow $ upperPrismPoly 10 $ polyCirc 3 5
-            setDepth 20 $
-                --pictures [color yellow $ polygon $ reverse $ rectNSWE 5 (-5) (-11) (-3)]
-                pictures [color yellow $ polygon $ reverse $ polyCirc 3 5]
     AUTODETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
 
+backpackShape :: Shape
+backpackShape = upperPrismPoly 10 $ rectNSWE 5 (-5) (-4) 4
+
 leftItemSPic :: LeftItemType -> Item -> SPic
 leftItemSPic lt _ = case lt of
     BLINKER -> defSPic

src/Dodge/Item/Equipment.hs

@@ -10,11 +10,13 @@ module Dodge.Item.Equipment (
     headLamp,
     jetPack,
     fuelPack,
+    batteryPack,
     speedLegs,
     jumpLegs,
     flameShield,
 ) where
 
+import Geometry.Data
 import Dodge.Data.CamouflageStatus
 import Dodge.Data.Item
 import Dodge.Default
@@ -50,17 +52,26 @@ wristArmour =
         & itUse . equipEffect . eeOnRemove .~ EoffWristShield
         & itType . iyBase .~ EQUIP WRISTARMOUR
 
+batteryPack :: Item
+batteryPack =
+    defaultEquipment
+        & itUse . equipEffect . eeSite .~ GoesOnBack
+        & itType . iyBase .~ EQUIP BATTERYPACK
+        & itUse . equipEffect . eeAttachPos .~ V3 (-8) 0 10
+
 fuelPack :: Item
 fuelPack =
     defaultEquipment
         & itUse . equipEffect . eeSite .~ GoesOnBack
         & itType . iyBase .~ EQUIP FUELPACK
+        & itUse . equipEffect . eeAttachPos .~ V3 (-9) 0 10
 
 jetPack :: Item
 jetPack =
     defaultEquipment
         & itUse . equipEffect . eeSite .~ GoesOnBack
         & itType . iyBase .~ EQUIP JETPACK
+        & itUse . equipEffect . eeAttachPos .~ V3 (-8) 0 10
 
 brainHat :: Item
 brainHat =

src/Dodge/Item/Info.hs

@@ -110,6 +110,7 @@ equipInfo eit = case eit of
 
     JETPACK -> "A DEVICE ENABLING FLIGHT."
     FUELPACK -> "A LIQUID CONTAINER WITH ATTACHED HOSE."
+    BATTERYPACK -> "A COLLECTION OF BATTERIES WITH A UNIVERSAL ADAPTER."
 
     AUTODETECTOR d -> "A DEVICE THAT DETECTS "++detectorInfo d ++" IN AN EXPANDING RADIUS. PULSES AUTOMATICALLY. "
 

src/Dodge/Update.hs

@@ -653,11 +653,6 @@ ppEvents w = IM.foldl' (flip $ \pp -> doPressPlateEvent (_ppEvent pp) pp) w $ w
 updateSeenWalls :: World -> World
 updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w)
 
---  where
---    f w' !i -- = w' & walls . ix i . wlSeen .~ True
---        = w' { _walls = IM.adjust mw i $ _walls w' }
---    mw wl = wl {_wlSeen = True}
-
 markWallSeen :: World -> Int -> World
 markWallSeen w i = w & cWorld . lWorld . seenWalls . at i .~ Just ()
 --markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i