Implement randomised markings on sensors

src/Dodge/LevelGen/Data.hs

@@ -4,10 +4,12 @@ module Dodge.LevelGen.Data where
 import Dodge.Data
 import Picture
 import Geometry
+--import Color
 import Shape.Data
 import Data.Tile
 
 import qualified Data.Set as S
+import qualified Data.Map.Strict as M
 import Control.Lens
 import Control.Monad.State
 import System.Random
@@ -16,7 +18,7 @@ import qualified Data.IntMap.Strict as IM
 --import Data.Bifunctor
 
 data PSType = PutCrit {_unPutCrit :: Creature}
-    | PutMachine Color [Point2] Machine
+    | PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine }
     | PutLS LightSource
     | PutButton Button
     | PutProp Prop
@@ -34,6 +36,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutShape Shape
     | PutWorldUpdate (PlacementSpot -> World -> World)
     | PutNothing
+    | PutUsingGenParams (GenWorld -> (GenWorld,PSType))
     | PutID { _putID :: Int}
 -- maybe there is a monadic implementation of this?
 -- add room effect for any placement spot?
@@ -56,6 +59,7 @@ data Placement
         , _plMID    :: Maybe Int
         , _plIDCont :: Placement -> Maybe Placement 
         }
+    | PlacementGenUpdate (GenParams -> Placement -> (GenParams, Placement)) Placement
     | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
     | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
     | PickOnePlacement Int Placement
@@ -152,6 +156,20 @@ data RoomPosType
     | RoomPosOffPath
     | RoomPosExLink
   deriving (Eq,Ord,Show)
+data DecorationShape = PlusDecoration | SquareDecoration | CircleDecoration
+    | ThreeLineDecoration
+  deriving (Eq,Ord,Enum,Show)
+
+newtype GenParams = GenParams
+    { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)
+    }
+
+data GenWorld = GenWorld
+    { _gWorld       :: World
+    , _gPlacements  :: IM.IntMap [(Placement,Int)]
+    , _gRooms       :: IM.IntMap Room
+    , _gParams      :: GenParams
+    }
 
 makeLenses ''Room
 makeLenses ''PSType
@@ -161,6 +179,8 @@ makeLenses ''RoomLink
 makeLenses ''RoomPos
 makeLenses ''RoomPosType
 makeLenses ''RPLinkStatus
+makeLenses ''GenWorld
+makeLenses ''GenParams
 
 spNoID :: PlacementSpot -> PSType -> Placement
 spNoID ps pst = Placement ps pst Nothing (const Nothing)
@@ -231,6 +251,7 @@ addPlmnt pl pl2 = case pl2 of
     (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
     (Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
     PickOnePlacement {} -> error "not written how to combine PickOnePlacement with others yet"
+    PlacementGenUpdate {} -> error "not written how to combine PlacementGenUpdate with others yet"
   where
     g Nothing = Just pl
     g (Just pl') = Just $ addPlmnt pl pl'

src/Dodge/LevelGen/LevelStructure.hs

@@ -1,24 +1,33 @@
-{-# LANGUAGE TemplateHaskell #-}
+--{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.LevelGen.LevelStructure where
+module Dodge.LevelGen.LevelStructure 
+    ( module Dodge.LevelGen.Data
+    , worldToGenWorld
+    ) where
 import Dodge.LevelGen.Data
 --import Dodge.Tree.Compose.Data
 import Dodge.Data
+import Dodge.RandomHelp
+import Color
 
 --import Data.Tree
 import qualified Data.IntMap.Strict as IM
-import Control.Lens
---import System.Random
+import qualified Data.Map.Strict as M
+--import Control.Lens
+import Control.Monad.State
+import System.Random
 
-data GenWorld = GenWorld
-    { _gWorld       :: World
-    , _gPlacements  :: IM.IntMap [(Placement,Int)]
-    , _gRooms       :: IM.IntMap Room
-    }
 worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
 worldToGenWorld rms w = GenWorld 
     { _gWorld = w
     , _gPlacements = IM.empty
     , _gRooms = rms
+    , _gParams = evalState generateGenParams (_randGen w)
     }
-makeLenses ''GenWorld
+
+generateGenParams :: RandomGen g => State g GenParams
+generateGenParams = do
+    cols <- shuffle [Red .. Orange]
+    shps <- shuffle [PlusDecoration ..]
+    return . GenParams . M.fromList . zip [Flaming,Lasering,Electrical]
+        $ zip cols shps