From c9c3d8f3921637814d18fb8c8572979f8b790af0 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 22 Aug 2022 10:37:24 +0100 Subject: [PATCH] Remove some deriving clauses --- src/Dodge/Data/Beam.hs | 8 +-- src/Dodge/Data/Creature.hs | 6 +- src/Dodge/Data/FloorItem.hs | 2 +- src/Dodge/Data/Item.hs | 2 +- src/Dodge/Data/Item/Params.hs | 12 ++-- src/Dodge/Data/Machine.hs | 6 +- src/Dodge/LevelGen/PlacementHelper.hs | 95 +++++++++++++++++++++++++++ 7 files changed, 113 insertions(+), 18 deletions(-) create mode 100644 src/Dodge/LevelGen/PlacementHelper.hs diff --git a/src/Dodge/Data/Beam.hs b/src/Dodge/Data/Beam.hs index 3808d696c..9dd47f62e 100644 --- a/src/Dodge/Data/Beam.hs +++ b/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 diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 543a2db52..7ae2de5b0 100644 --- a/src/Dodge/Data/Creature.hs +++ b/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 diff --git a/src/Dodge/Data/FloorItem.hs b/src/Dodge/Data/FloorItem.hs index c549b1d44..1a57374ca 100644 --- a/src/Dodge/Data/FloorItem.hs +++ b/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 diff --git a/src/Dodge/Data/Item.hs b/src/Dodge/Data/Item.hs index 3ae09aaa1..e6d47b609 100644 --- a/src/Dodge/Data/Item.hs +++ b/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 diff --git a/src/Dodge/Data/Item/Params.hs b/src/Dodge/Data/Item/Params.hs index bb715a479..c649a8f75 100644 --- a/src/Dodge/Data/Item/Params.hs +++ b/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 diff --git a/src/Dodge/Data/Machine.hs b/src/Dodge/Data/Machine.hs index b1a3175f6..b0c230a21 100644 --- a/src/Dodge/Data/Machine.hs +++ b/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 diff --git a/src/Dodge/LevelGen/PlacementHelper.hs b/src/Dodge/LevelGen/PlacementHelper.hs new file mode 100644 index 000000000..32de27f72 --- /dev/null +++ b/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'