Remove some deriving clauses

src/Dodge/Data/Beam.hs

@@ -28,12 +28,12 @@ data Beam = Beam
     , _bmOrigin :: Maybe Int
     , _bmType :: BeamType
     }
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data BeamDraw
     = BasicBeamDraw
     | BeamDrawColor Color
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data BeamCombineType
     = FlameBeamCombine
@@ -41,14 +41,14 @@ data BeamCombineType
     | TeslaBeamCombine
     | SplitBeamCombine
     | NoBeamCombine
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data BeamType
     = BeamCombine
         { _beamCombine :: BeamCombineType -- (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World
         }
     | BeamSimple
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''BeamType
 makeLenses ''Beam

src/Dodge/Data/Creature.hs

@@ -73,17 +73,17 @@ data Creature = Creature
     , _crStatistics :: CreatureStatistics
     , _crCamouflage :: CamouflageStatus
     }
-    deriving (Eq, Show, Read) --Generic, Flat)
+    --deriving (Eq, Show, Read) --Generic, Flat)
 
 data CreatureCorpse = MakeDefaultCorpse
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Intention = Intention
     { _targetCr :: Maybe Creature
     , _mvToPoint :: Maybe Point2
     , _viewPoint :: Maybe Point2
     }
-    deriving (Eq, Show, Read) --Generic, Flat)
+    --deriving (Eq, Show, Read) --Generic, Flat)
 
 crSel :: Creature -> Int
 crSel = _iselPos . _crInvSel

src/Dodge/Data/FloorItem.hs

@@ -12,7 +12,7 @@ import Dodge.Data.Item
 import Geometry.Data
 
 data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float, _flItID :: Int}
-    deriving (Eq, Show, Read) --Generic, Flat)
+    --deriving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''FloorItem
 deriveJSON defaultOptions ''FloorItem

src/Dodge/Data/Item.hs

@@ -49,7 +49,7 @@ data Item = Item
     --, _itValue :: ItemValue
     , _itParams :: ItemParams
     }
-    deriving (Eq, Show, Read) --Generic, Flat)
+    --deriving (Eq, Show, Read) --Generic, Flat)
 
 _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _heldAim . _itUse

src/Dodge/Data/Item/Params.hs

@@ -68,13 +68,13 @@ data ItemParams
         }
     | ParamMID {_paramMID :: Maybe Int}
     | BoostPropIX {_boostPropIX :: Maybe Int}
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data ShrinkGunStatus = FullSize | Shrunk
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data GunBarrels
     = MultiBarrel
@@ -87,7 +87,7 @@ data GunBarrels
         , _brlInaccuracy :: Float
         }
     | SingleBarrel {_brlInaccuracy :: Float}
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Nozzle = Nozzle
     { _nzPressure :: Float
@@ -97,13 +97,13 @@ data Nozzle = Nozzle
     , _nzWalkSpeed :: Float
     , _nzLength :: Float
     }
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data BarrelSpread
     = AlignedBarrels
     | SpreadBarrels {_spreadAngle :: Float}
     | RotatingBarrels {_rotatingBarrelInaccuracy :: Float}
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''BarrelSpread
 makeLenses ''ItemParams

src/Dodge/Data/Machine.hs

@@ -43,7 +43,7 @@ data Machine = Machine
     , _mcCloseSound :: Maybe SoundID
     , _mcWidth :: Float
     }
-    deriving (Eq, Show, Read) --, Generic)
+    --deriving (Eq, Show, Read) --, Generic)
     --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data MachineType
@@ -51,7 +51,7 @@ data MachineType
     | McTerminal
     | McSensor Sensor
     | McTurret Turret
-    deriving (Eq, Show, Read) --, Generic)
+    --deriving (Eq, Show, Read) --, Generic)
     --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data Turret = Turret
@@ -60,7 +60,7 @@ data Turret = Turret
     , _tuFireTime :: Int
     , _tuDir :: Float
     }
-    deriving (Eq, Show, Read) --, Generic)
+    --deriving (Eq, Show, Read) --, Generic)
     --hderiving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''Machine

src/Dodge/LevelGen/PlacementHelper.hs

@@ -0,0 +1,95 @@
+module Dodge.LevelGen.PlacementHelper where
+
+import Control.Lens
+import Data.Maybe
+import Dodge.Data.GenWorld
+import Geometry
+
+--spNoID
+psPtPl :: PlacementSpot -> PSType -> Placement
+psPtPl ps pst = Placement 10 ps pst Nothing (const . const Nothing)
+
+psPtJpl :: PlacementSpot -> PSType -> Maybe Placement
+psPtJpl ps = Just . psPtPl ps
+
+pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
+pContID ps pt = Placement 10 ps pt Nothing . contToIDCont
+
+psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
+psPtCont ps pt = Placement 10 ps pt Nothing . const
+
+ptCont :: PSType -> (Placement -> Maybe Placement) -> Placement
+ptCont = psPtCont (PS 0 0)
+
+psPt :: PlacementSpot -> PSType -> Placement
+psPt ps pt = Placement 10 ps pt Nothing (const . const Nothing)
+
+sPS :: Point2 -> Float -> PSType -> Placement
+sPS p a pt = Placement 10 (PS p a) pt Nothing (const . const Nothing)
+
+sps :: PlacementSpot -> PSType -> Placement
+sps ps pt = Placement 10 ps pt Nothing (const . const Nothing)
+
+plRRpt :: Int -> PSType -> Placement
+plRRpt i pt = Placement 10 (PSRoomRand i (uncurry PS)) pt Nothing (const . const Nothing)
+
+jsps :: Point2 -> Float -> PSType -> Maybe Placement
+jsps p a pst = Just $ Placement 10 (PS p a) pst Nothing $ const . const Nothing
+
+jsps0 :: PSType -> Maybe Placement
+jsps0 = Just . sPS (V2 0 0) 0
+
+sps0 :: PSType -> Placement
+sps0 = sPS (V2 0 0) 0
+
+jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement
+jspsJ p a pst plm = Just $ Placement 10 (PS p a) pst Nothing $ \_ _ -> Just plm
+
+jsps0J :: PSType -> Placement -> Maybe Placement
+jsps0J pst plm = Just $ Placement 10 (PS (V2 0 0) 0) pst Nothing $ \_ _ -> Just plm
+
+ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
+ps0 pst = Placement 10 (PS (V2 0 0) 0) pst Nothing . contToIDCont
+
+pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
+pt0 pst = Placement 10 (PS (V2 0 0) 0) pst Nothing . const
+
+contToIDCont :: (Int -> Maybe Placement) -> World -> Placement -> Maybe Placement
+contToIDCont f _ = f . fromJust . _plMID
+
+jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement
+jps0' pst = Just . Placement 10 (PS (V2 0 0) 0) pst Nothing . const
+
+jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
+jps0PushPS pst f = Just . Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
+    \_ plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt
+
+ps0j :: PSType -> Placement -> Placement
+ps0j pst plmnt = Placement 10 (PS (V2 0 0) 0) pst Nothing (\_ -> const $ Just plmnt)
+
+psj :: PlacementSpot -> PSType -> Placement -> Placement
+psj ps pst plmnt = Placement 10 ps pst Nothing (\_ -> const $ Just plmnt)
+
+-- the NoShiftCont is necessary when shifting then combining rooms
+ps0jPushPS :: PSType -> Placement -> Placement
+ps0jPushPS pst plmnt = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
+    \_ p -> Just $ plmnt & plSpot .~ _plSpot p
+
+-- the NoShiftCont is necessary when shifting then combining rooms
+ps0PushPS :: PSType -> (Placement -> Maybe Placement) -> Placement
+ps0PushPS pst f = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
+    \_ pl -> f pl & _Just . plSpot %~ const (_plSpot pl)
+
+ps0PushPSw :: PSType -> (World -> Placement -> Maybe Placement) -> Placement
+ps0PushPSw pst f = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
+    \w pl -> f w pl & _Just . plSpot %~ const (_plSpot pl)
+
+addPlmnt :: Placement -> Placement -> Placement
+addPlmnt pl pl2 = case pl2 of
+    (PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
+    (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
+    (Placement i ps pt mi f) -> Placement i ps pt mi (fmap (fmap g) f)
+    PickOnePlacement{} -> error "not written how to combine PickOnePlacement with others yet"
+  where
+    g Nothing = Just pl
+    g (Just pl') = Just $ addPlmnt pl pl'