Simplify Foreground

src/Dodge/Data/ForegroundShape.hs

@@ -10,10 +10,8 @@ import Geometry
 import ShapePicture
 
 data ForegroundShape = ForegroundShape
-    { _fsID :: Int
+    { _fsPos :: Point2
-    , _fsPos :: Point2
     , _fsDir :: Float
-    , _fsRad :: Float -- This should probably be a bounding box
     , _fsSPic :: SPic
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/LWorld.hs

@@ -127,7 +127,7 @@ data LWorld = LWorld
     , _worldEvents :: [WdWd]
     , _delayedEvents :: [(Int, WdWd)]
     , _buttons :: IM.IntMap Button
-    , _foreShapes :: IM.IntMap ForegroundShape
+    , _foreShapes :: [ForegroundShape]
     , _lightSources :: IM.IntMap LightSource
     , _lights :: [LSParam]
     , _seenLocations :: IM.IntMap (WdP2, String)

src/Dodge/Data/Prop.hs

@@ -36,8 +36,6 @@ data Debris = DebrisChunk
     , _dbSpin :: Q.Quaternion Float
     }
 
---data PropType = FallingBlock Material
-
 data PropDraw
     = PropDrawFlatTranslate SPic
     | PropDoubleLampCover Float

src/Dodge/Default/ForegroundShape.hs

@@ -1,6 +1,6 @@
-module Dodge.Default.ForegroundShape where
+module Dodge.Default.ForegroundShape (defaultForeground) where
 
 import Dodge.Data.ForegroundShape
 
 defaultForeground :: ForegroundShape
-defaultForeground = ForegroundShape 0 0 0 0 mempty
+defaultForeground = ForegroundShape 0 0 mempty

src/Dodge/Placement/PlaceSpot.hs

@@ -126,11 +126,7 @@ placeSpotID rid ps pt w = case pt of
             )
     PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs ->
-        plNewUpID
+            (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
-            (gwWorld . cWorld . lWorld . foreShapes)
-            fsID
-            (mvFS p rot fs)
-            w
     PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
     PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
     RandPS _ -> error "RandPS should not be reachable here" --evaluateRandPS rid rgn ps w

src/Dodge/Render/ShapePicture.hs

@@ -29,7 +29,7 @@ worldSPic cfig u =
         -- <> foldup (shiftDraw _blPos _blDir (const $ drawBlock . _blDraw)) 
         <> foldup (shiftDraw _blPos _blDir (const $ noPic . _blDraw)) 
                 (filtOn _blPos _blocks)
-        <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foreShapes)
+        <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
         <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
         <> foldup
             (Prelude.uncurry floorItemSPic)

src/Dodge/Room/Foreground.hs

@@ -136,7 +136,6 @@ putShape sh =
     PutForeground $
         defaultForeground
             & fsPos .~ m
-            & fsRad .~ radBounds bnds
             & fsSPic .~ noPic (uncurryV translateSHxy (- m) sh)
   where
     bnds = shapeBounds sh
@@ -151,9 +150,6 @@ shapeBounds = fromMaybe (0, 0, 0, 0) . boundPoints . shapePoints
 midBounds :: (Float, Float, Float, Float) -> Point2
 midBounds (n, s, e, w) = V2 ((n + s) / 2) ((e + w) / 2)
 
-radBounds :: (Float, Float, Float, Float) -> Float
-radBounds (n, s, e, w) = max (n - s) (e - w) / 2
-
 girderV' ::
     -- | height
     Float ->
@@ -167,7 +163,6 @@ girderV' ::
 girderV' h d w x y =
     defaultForeground
         & fsPos .~ m
-        & fsRad .~ dist m x
         & fsSPic .~ noPic sh
   where
     m = midPoint x y

src/Dodge/Wire.hs

@@ -14,7 +14,6 @@ floorWire :: Point2 -> Point2 -> ForegroundShape
 floorWire a b =
     defaultForeground
         & fsPos .~ m
-        & fsRad .~ dist m a
         & fsSPic .~ noPic (colorSH yellow $ thinHighBar 0 a' b')
   where
     m = midPoint a b
@@ -25,7 +24,6 @@ verticalWire :: Point2 -> Float -> Float -> ForegroundShape
 verticalWire p h1 h2 =
     defaultForeground
         & fsPos .~ p
-        & fsRad .~ 2
         & fsSPic .~ noPic (colorSH yellow $ barPP 1.5 (V3 0 0 h1) (V3 0 0 h2))
 
 putWireEnd :: Int -> (Point2, Float) -> Float -> Room -> Room