diff --git a/src/Dodge/Data/ForegroundShape.hs b/src/Dodge/Data/ForegroundShape.hs index 93dc3fd4e..f163cace1 100644 --- a/src/Dodge/Data/ForegroundShape.hs +++ b/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) diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index 5e9e4f1e0..d5458a334 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/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) diff --git a/src/Dodge/Data/Prop.hs b/src/Dodge/Data/Prop.hs index 14a349089..9908e3a00 100644 --- a/src/Dodge/Data/Prop.hs +++ b/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 diff --git a/src/Dodge/Default/ForegroundShape.hs b/src/Dodge/Default/ForegroundShape.hs index 3b359daac..8eecc7acf 100644 --- a/src/Dodge/Default/ForegroundShape.hs +++ b/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 diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index ae25eabc5..816674394 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/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 - (gwWorld . cWorld . lWorld . foreShapes) - fsID - (mvFS p rot fs) - w + (0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs) 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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 40aba441e..f76ce250a 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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) diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 3e960c77e..69cc98313 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/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 diff --git a/src/Dodge/Wire.hs b/src/Dodge/Wire.hs index 6bf337abd..c00db2e07 100644 --- a/src/Dodge/Wire.hs +++ b/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