Remove parameters from machine damage sensors

src/Dodge/Data/Machine.hs

@@ -38,11 +38,8 @@ data Machine = Machine
     , _mcDamage :: [Damage]
     , _mcType :: MachineType
     , _mcMounts :: M.Map ObjectType Int
---    , _mcCloseSound :: Maybe SoundID
     , _mcWidth :: Float
     }
-    --deriving (Eq, Show, Read) --, Generic)
-    --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data MachineType
     = McStatic
@@ -50,8 +47,6 @@ data MachineType
     | McDamSensor DamageSensor
     | McProxSensor ProximitySensor
     | McTurret {_mctTurret :: Turret}
-    --deriving (Eq, Show, Read) --, Generic)
-    --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data Turret = Turret
     { _tuWeapon :: Int
@@ -59,8 +54,6 @@ data Turret = Turret
     , _tuFireTime :: Int
     , _tuDir :: Float
     }
-    --deriving (Eq, Show, Read) --, Generic)
-    --hderiving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''MachineType
 makeLenses ''Machine

src/Dodge/Data/Machine/Sensor.hs

@@ -8,29 +8,23 @@ module Dodge.Data.Machine.Sensor (
     module Dodge.Data.Machine.Sensor.Type,
 ) where
 
-import Geometry.Data
-import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.GenParams
 import Dodge.Data.Item.Combine
 import Dodge.Data.Machine.Sensor.Type
+import Geometry.Data
 
 data DamageSensor = DamSensor
-        { _sensToggle :: Bool
-        , _sensAmount :: Int
-        , _sensType :: SensorType
-        , _sensDraw :: (PaletteColor, DecorationShape)
-        , _sensThreshold :: Int
-        }
+    { _sensAmount :: Int
+    , _sensType :: SensorType
+    , _sensThreshold :: Int
+    }
 
 data ProximitySensor = ProxSensor
-        { _proxRequirement :: ProximityRequirement
-        , _proxToggle :: Bool
-        }
-
---deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    { _proxRequirement :: ProximityRequirement
+    , _proxToggle :: Bool
+    }
 
 data ProximityRequirement
     = RequireHealth {_proxReqMinHealth :: Int}

src/Dodge/Default.hs

@@ -40,7 +40,6 @@ defaultMachine =
         , _mcDamage = []
         , _mcType = McStatic
         , _mcMounts = mempty
---        , _mcCloseSound = Nothing
         , _mcWidth = 10
         }
 

src/Dodge/Machine/Draw.hs

@@ -1,9 +1,9 @@
-module Dodge.Machine.Draw ( drawMachine) where
+module Dodge.Machine.Draw (drawMachine) where
 
+import Dodge.Data.CWorld
 import Dodge.Terminal.Color
 import Control.Lens
 import Data.Maybe
-import Dodge.Data.LWorld
 import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import Dodge.Placement.TopDecoration
@@ -11,18 +11,27 @@ import Geometry
 import Picture
 import Shape
 import ShapePicture
+import qualified Data.Map.Strict as M
 
-drawMachine :: LWorld -> Machine -> SPic
-drawMachine lw mc = case _mcType mc of
+drawMachine :: CWorld -> Machine -> SPic
+drawMachine cw mc = case _mcType mc of
     McStatic -> mempty
     McTerminal -> terminalSPic lw mc
     McTurret tu -> drawBaseMachine 20 mc <> drawTurret lw tu mc
-    McDamSensor se -> drawBaseMachine 25 mc <> drawDamSensor se mc
+    McDamSensor se -> drawBaseMachine 25 mc <> drawDamSensor gp se mc
     McProxSensor se -> drawBaseMachine 25 mc <> drawProxSensor se mc
+  where
+    lw = cw ^. lWorld
+    gp = cw ^. cwGen . cwgParams . sensorCoding
 
-drawDamSensor :: DamageSensor -> Machine -> SPic
-drawDamSensor sens = case sens of
-    DamSensor{_sensDraw = pcds} -> sensorSPic pcds
+drawDamSensor :: M.Map SensorType (PaletteColor, DecorationShape) 
+    -> DamageSensor -> Machine -> SPic
+drawDamSensor gp sens mc = --case sens of
+    --DamSensor{_sensDraw = pcds} -> sensorSPic pcds
+    fold $ do
+        let st = sens ^. sensType
+        x <- gp ^? ix st
+        return $ sensorSPic x mc
 
 drawProxSensor :: ProximitySensor -> Machine -> SPic
 drawProxSensor sens = case sens of
@@ -70,8 +79,7 @@ drawTurret lw tu mc = fold $ do
     return $ overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
 
 sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
-sensorSPic (pc, ds) mc =
-    noPic $ decorationToShape ds w w 25 col col
+sensorSPic (pc, ds) mc = noPic $ decorationToShape ds w w 25 col col
   where
     col = paletteToColor pc
     w = _mcWidth mc

src/Dodge/Placement/Instance/Sensor.hs

@@ -5,7 +5,6 @@ module Dodge.Placement.Instance.Sensor (
 
 import Color
 import Control.Lens
-import qualified Data.Map.Strict as M
 import Dodge.Data.GenWorld
 import Dodge.Default
 import Dodge.LevelGen.PlacementHelper
@@ -27,10 +26,9 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
                     & mcType
                         .~ McDamSensor
                             ( DamSensor
-                                False
                                 0
                                 dt
-                                (_sensorCoding (_cwgParams $ _cwGen (_cWorld gw)) M.! dt)
+--                                (_sensorCoding (_cwgParams $ _cwGen (_cWorld gw)) M.! dt)
                                 (damageTypeThreshold dt)
                             )
                 )

src/Dodge/Render/ShapePicture.hs

@@ -33,7 +33,7 @@ worldSPic cfig u =
                 (filtOn _crPos _creatures)
         <> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos _floorItems))
         <> foldup btSPic (filtOn _btPos _buttons)
-        <> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
+        <> foldup (mcSPic (u ^. uvWorld . cWorld)) (filtOn _mcPos _machines)
         <> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms)
   where
     w = _uvWorld u
@@ -131,7 +131,7 @@ btSPic bt =
     uncurryV translateSPxy (_btPos bt) $
         rotateSP (_btRot bt) (drawButton bt)
 
-mcSPic :: LWorld -> Machine -> SPic
-mcSPic lw mc =
+mcSPic :: CWorld -> Machine -> SPic
+mcSPic cw mc =
     uncurryV translateSPxy (_mcPos mc) $
-        rotateSP (_mcDir mc) (drawMachine lw mc)
+        rotateSP (_mcDir mc) (drawMachine cw mc)

src/Geometry/ConvexPoly.hs

@@ -11,7 +11,6 @@ module Geometry.ConvexPoly (
     --    , centroid
     pointsToPoly,
     convexPolysOverlap,
---    pointInPolyPoints,
 ) where
 
 import Control.Lens
@@ -51,9 +50,6 @@ convexPolysOverlap cp1 cp2 =
     dist (_cpCen cp1) (_cpCen cp2) < _cpRad cp1 + _cpRad cp2
         && polyPointsOverlap (_cpPoints cp1) (_cpPoints cp2)
 
---pointInConvexPoly :: Point2 -> ConvexPoly -> Bool
---pointInConvexPoly p cp = dist p (_cpCen cp) < _cpRad cp
---    && pointInPolyPoints p (_cpPoints cp)
 
 -- | Test whether two polygons intersect or if one is contained in the other.
 polyPointsOverlap :: [Point2] -> [Point2] -> Bool