Implement randomised markings on sensors

src/Dodge/Placement/Instance/Sensor.hs

@@ -7,10 +7,12 @@ import Dodge.LightSource
 import Dodge.Data
 import Dodge.LevelGen.Data
 import Dodge.Default
+import Dodge.Placement.TopDecoration
 import Geometry
 import ShapePicture
 import Shape
 
+import qualified Data.Map.Strict as M
 import Control.Lens
 import Data.Either
 
@@ -19,14 +21,13 @@ damageSensor
     -> Float
     -> (Machine -> World -> World)
     -> PlacementSpot -> Placement
-damageSensor damF wdth upf ps = pContID ps (PutLS theLS)
-    $ \lsid -> Just $ spNoID ps $ PutMachine yellow (reverse $ square wdth) defaultMachine
-        { _mcDraw = sensorSPic wdth
-        , _mcUpdate = \mc -> upf mc . sensorUpdate damF mc
+damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
+    $ \lsid -> Just $ spNoID ps $ PutUsingGenParams 
+    $ \gw -> (,) gw $ PutMachine yellow (reverse $ square wdth) defaultMachine
+        { _mcDraw = sensorSPic wdth $ _sensorCoding (_gParams gw) M.! dt
+        , _mcUpdate = \mc -> upf mc . sensorUpdate dt mc
         , _mcLSs = [lsid]
         }
-  where
-    theLS = lsPosCol (V3 0 0 30) 0.1
 
 lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
 lightSensor = damageSensor Lasering
@@ -51,6 +52,9 @@ damageUsing dt dm
     | _dmType dm == dt = Left $ _dmAmount dm
     | otherwise = Right 0
 
-sensorSPic :: Float -> Machine -> SPic
-sensorSPic wdth _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)
+sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic
+sensorSPic wdth (pc,ds) _ = ( (colorSH yellow $ upperPrismPoly 25 (square wdth))
+    <> decorationToShape ds wdth wdth 25 col col
     , mempty )
+  where
+    col = paletteToColor pc

src/Dodge/Placement/Instance/Tank.hs

@@ -1,14 +1,23 @@
-module Dodge.Placement.Instance.Tank where
+module Dodge.Placement.Instance.Tank 
+    ( tankSquareDec
+    , roundTank
+    , roundTankCross
+    ) where
 import Dodge.Data
 --import Dodge.Placement.PlaceSpot
 import Dodge.LevelGen.Data
 import Dodge.Room.Foreground
 import Dodge.Default.Wall
+--import Dodge.Placement.TopDecoration
 import Geometry
 import Shape
 import Color
 --import Quaternion
 
+tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape) 
+    -> Color -> Color -> Placement
+tankSquareDec dec = tankShape (square 20) (dec 20 20 31)
+
 tankShape :: [Point2] -> (Color -> Color -> Shape) -> Color -> Color -> Placement
 tankShape baseshape facade col col' = ps0jPushPS
     (PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')
@@ -25,58 +34,3 @@ roundTankCross :: Color -> Color -> Placement
 roundTankCross = tankShape (polyCirc 4 20) 
     $ \_ c -> colorSH c $ thinHighBar 31 (V2 20 0) (V2 (-20) 0)
         <> thinHighBar 31 (V2 0 20) (V2 0 (-20))
-
-tankRectCross :: Float -> Float -> Color -> Color -> Placement
-tankRectCross = tankRectDecorate $ \ w h _ c -> colorSH c $
-    thinHighBar 31 (V2 w 0) (V2 (-w) 0) 
-    <> thinHighBar 31 (V2 0 h) (V2 0 (-h))
-
-tankSquareCross :: Color -> Color -> Placement
-tankSquareCross = tankRectCross 20 20
-
-tankRectDecorate :: (Float -> Float -> Color -> Color -> Shape) 
-    -> Float -> Float -> Color -> Color -> Placement
-tankRectDecorate f w h = tankShape (rectWH w h) (f w h)
-
-tankRect :: Float -> Float -> Color -> Color -> Placement
-tankRect = tankRectDecorate g 
-  where
-    g w h _ col = colorSH col $ foldMap f 
-        [(w',-w',h',h')
-        ,(w',-w',-h',-h')
-        ,(w',w',h',-h')
-        ,(-w',-w',h',-h')
-        ]
-      where
-        w' = w - 1.5
-        h' = h - 1.5
-        f (a,c,b,d) = thinHighBar 31 (V2 a b) (V2 c d)
-
-tankSquare :: Color -> Color -> Placement
-tankSquare = tankRect 20 20
-
-tankRectEmboss :: Float -> Float -> Color -> Color -> Placement
-tankRectEmboss = tankRectDecorate f
-  where
-    f w h _ c = embossingR
-        <> rotateSH pi embossingR
-        <> colorSH c (thinHighBar 38 (V2 (-0.3*w) 0) (V2 (0.3*w) 0))
-      where
-        w' = 0.3 * w
-        embossingR = colorSH c $ prismPoly 
-            [V3 w h 31,V3 w (0.3*h) 41,V3 w (-0.3*h) 41,V3 w (-h) 31]
-            [V3 w' h 31,V3 w' (0.3*h) 41,V3 w' (-0.3*h) 41,V3 w' (-h) 31]
-
-tankSquareEmboss :: Color -> Color -> Placement
-tankSquareEmboss = tankRectEmboss 20 20
-
-tankRectEmboss4 :: Float -> Float -> Color -> Color -> Placement
-tankRectEmboss4 = tankRectDecorate g
-  where
-    g w h _ c = colorSH c $ foldMap f [(w,h),(-w,h),(w,-h),(-w,-h)]
-      where
-        f (a,b) = translateSH (V3 (a/2) (b/2) 31) embossing
-        embossing = upperPrismPolyHalf 10 $ rectNSEW (h/2) (-h/2) (w/2) (-w/2)
-
-tankSquareEmboss4 :: Color -> Color -> Placement
-tankSquareEmboss4 = tankRectEmboss4 20 20