Refactor, try to limit dependencies

src/Dodge/Data.hs

@@ -1,27 +1,22 @@
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {- |
 Contains base datatypes that cannot be seperated into
 different modules because they are interdependent;
 circular imports are probably not a good idea.
-
-WARNING: orphan instances concerning Aeson classes and SDL datatypes have been introduced.
-The warnings have been disabled.
 -}
 module Dodge.Data (
-    module Dodge.Data,
+    module Dodge.Data.World,
+    module Dodge.Data.WorldEffect,
     module Dodge.Data.ArcStep,
+    module Dodge.Data.Config,
     module Dodge.Data.Zoning,
     module Dodge.Data.Distortion,
     module Dodge.Data.Material,
-    module Dodge.Data.SoundOrigin,
+    module Dodge.Data.GenWorld,
+    module Dodge.Data.Universe,
     module Dodge.Data.Hammer,
-    module Dodge.Data.RightButtonOptions,
-    module Dodge.Data.Config,
     module MaybeHelp,
     module Dodge.Data.RoomCluster,
     module Dodge.Data.Room,
@@ -32,272 +27,22 @@ module Dodge.Data (
     module Dodge.Data.MountedObject,
 ) where
 
-import Color
-import Control.Lens
-import Control.Monad.State
-import qualified Data.Map.Strict as M
-import Data.Preload
-import qualified Data.Set as S
-import qualified Data.Text as T
-import Data.Tile
-import Dodge.Config.KeyConfig
+import Dodge.Data.Config
+import Dodge.Data.WorldEffect
 import Dodge.Data.ActionPlan
 import Dodge.Data.ArcStep
 import Dodge.Data.CWorld
-import Dodge.Data.Config
 import Dodge.Data.CrWlID
 import Dodge.Data.CreatureEffect
 import Dodge.Data.Distortion
+import Dodge.Data.GenWorld
 import Dodge.Data.Hammer
 import Dodge.Data.Material
 import Dodge.Data.MountedObject
 import Dodge.Data.ObjectType
-import Dodge.Data.RightButtonOptions
 import Dodge.Data.Room
 import Dodge.Data.RoomCluster
-import Dodge.Data.SoundOrigin
+import Dodge.Data.Universe
+import Dodge.Data.World
 import Dodge.Data.Zoning
-import Geometry.Data
-import qualified IntMapHelp as IM
 import MaybeHelp
-import Picture.Data
-import SDL (MouseButton, Scancode)
-import Sound.Data
-import Streaming
-import System.Random
-
-type CRUpdate' = Creature -> World -> (World -> World, Creature)
-
-data Universe = Universe
-    { _uvWorld :: World
-    , _preloadData :: PreloadData
-    , _menuLayers :: [ScreenLayer]
-    , _savedWorlds :: M.Map SaveSlot World
-    , _keyConfig :: KeyConfigSDL
-    , _uvIOEffects :: Universe -> IO Universe
-    , _uvConfig :: Configuration
-    , _uvTestString :: Universe -> [String]
-    }
-
-data GenWorld = GenWorld
-    { _gwWorld :: World
-    , _genPlacements :: IM.IntMap [(Placement, Int)]
-    , _genRooms :: IM.IntMap Room
-    }
-
-data World = World
-    { _cWorld :: CWorld
-    , _randGen :: StdGen
-    , _toPlaySounds :: M.Map SoundOrigin Sound
-    , _playingSounds :: M.Map SoundOrigin Sound
-    , _mousePos :: Point2
-    , _keys :: S.Set Scancode
-    , _mouseButtons :: M.Map MouseButton Bool
-    , _hammers :: M.Map WorldHammer HammerPosition
-    , _testFloat :: Float
-    , _lLine :: (Point2, Point2)
-    , _rLine :: (Point2, Point2)
-    , _lSelect :: Point2
-    , _rSelect :: Point2
-    , _backspaceTimer :: Int
-    , _timeFlow :: TimeFlowStatus
-    , _rbOptions :: RightButtonOptions
-    }
-
-data TimeFlowStatus
-    = RewindingNow
-    | RewindingLastFrame
-    | NormalTimeFlow
-    deriving (Eq, Ord, Show, Read)
-
-data WorldHammer
-    = SubInvHam
-    | DoubleMouseHam
-    deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
-data SaveSlot
-    = QuicksaveSlot
-    | LevelStartSlot
-    | SaveSlotNum Int
-    deriving (Eq, Ord, Show, Read)
-
-data OptionScreenFlag = NormalOptions | GameOverOptions
-    deriving (Eq, Ord, Show, Read)
-
-data ScreenLayer
-    = OptionScreen
-        { _scTitle :: Universe -> String
-        , _scOptions :: [MenuOption]
-        , _scDefaultEff :: Universe -> IO (Maybe Universe)
-        , _scOptionFlag :: OptionScreenFlag
-        , _scOptionsOffset :: Int
-        }
-    | ColumnsScreen
-        { _scTitle :: Universe -> String
-        , _scColumns :: [(String, String)]
-        }
-    | InputScreen
-        { _scInput :: T.Text
-        , _scFooter :: String
-        }
-    | WaitScreen
-        { _scWaitMessage :: Universe -> String
-        , _scWaitTime :: Int
-        }
-    | DisplayScreen
-        { _scDisplay :: Universe -> Picture
-        }
-
-data MenuOption
-    = Toggle
-        { _moEff :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> Either String (String, String)
-        , _moKey :: Scancode
-        }
-    | Toggle2
-        { _moKey1 :: Scancode
-        , _moEff1 :: Universe -> IO (Maybe Universe)
-        , _moKey2 :: Scancode
-        , _moEff2 :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> Either String (String, String)
-        }
-    | InvisibleToggle
-        { _moKey :: Scancode
-        , _moEff :: Universe -> IO (Maybe Universe)
-        }
-
-data IntID a = IntID Int a
-
-type HitEffect' =
-    Flame ->
-    Stream (Of (Point2, Either Creature Wall)) Identity () ->
-    World ->
-    (World, Maybe Flame)
-
----- ROOM DATATYPES
-data PSType
-    = PutCrit {_unPutCrit :: Creature}
-    | PutMachine {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall}
-    | PutLS LightSource
-    | PutButton {_putButton :: Button}
-    | PutProp Prop
-    | PutTerminal {_unputTerminal :: Terminal}
-    | PutFlIt {_putItem :: Item}
-    | PutPPlate PressPlate
-    | PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2]}
-    | PutCoord Point2
-    | PutMod Modification
-    | PutTrigger Bool
-    | PutLineBlock
-        { _putWall :: Wall
-        , _putWidth :: Float
-        , _putStartPoint :: Point2
-        , _putEndPoint :: Point2
-        }
-    | PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
-    | PutSlideDr Door Wall EdgeObstacle Float Point2 Point2
-    | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
-    | RandPS (State StdGen PSType)
-    | PutForeground ForegroundShape
-    | PutDecoration Picture
-    | PutWorldUpdate (PlacementSpot -> World -> World)
-    | PutNothing
-    | PutUsingGenParams (World -> (World, PSType))
-    | PutID {_putID :: Int}
-
--- maybe there is a monadic implementation of this?
--- add room effect for any placement spot?
-data PlacementSpot
-    = PS {_psPos :: Point2, _psRot :: Float}
-    | PSNoShiftCont {_psPos :: Point2, _psRot :: Float}
-    | PSPos
-        { _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
-        , _psRoomEff :: RoomPos -> Room -> Room
-        , _psFallback :: Maybe Placement
-        }
-    | PSRoomRand
-        { _psRoomRandPointNum :: Int
-        , _psRandShift :: (Point2, Float) -> PlacementSpot
-        }
-
--- TODO attempt to unify/simplify this union type
-data Placement
-    = Placement
-        { _plOrder :: Int
-        , _plSpot :: PlacementSpot
-        , _plType :: PSType
-        , _plMID :: Maybe Int
-        , _plIDCont :: World -> Placement -> Maybe Placement
-        }
-    | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
-    | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
-    | PickOnePlacement Int Placement
-
-{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
-Link pairs contain a position and rotation to attach to another room;
-0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc.
-TODO : Explain path, does it need both directions?
-Placement spots allow things to be put in the room during level generation.
-Room bounds between a new room and previously placed rooms are checked during level generation,
-assigning no bounds will allow rooms to overlap.  -}
-data Room = Room
-    { _rmPolys :: [[Point2]]
-    , _rmLinks :: [RoomLink]
-    , --  the Int is the number of previous outlinks that have been assigned
-      _rmLinkEff ::
-        RoomLink -> -- child link
-        Room -> -- child room
-        Int -> -- child number
-        RoomLink -> -- parent link
-        Room -> -- parent room
-        Room
-    , _rmPos :: [RoomPos]
-    , _rmPath :: S.Set (Point2, Point2)
-    , _rmPmnts :: [Placement]
-    , _rmInPmnt :: [InPlacement]
-    , _rmOutPmnt :: [OutPlacement]
-    , _rmBound :: [[Point2]]
-    , _rmFloor :: Floor
-    , _rmName :: String
-    , _rmShift :: (Point2, Float)
-    , _rmViewpoints :: [Point2]
-    , _rmRandPSs :: [State StdGen (Point2, Float)]
-    , _rmStartWires :: IM.IntMap RoomWire
-    , _rmEndWires :: IM.IntMap RoomWire
-    , _rmConnectsTo :: S.Set RoomLinkType -> Bool
-    , _rmMID :: Maybe Int
-    , _rmMParent :: Maybe Int
-    , _rmChildren :: [Int]
-    , _rmType :: RoomType
-    , _rmClusterStatus :: ClusterStatus
-    }
-
-data OutPlacement = OutPlacement
-    { _opPlacement :: Placement
-    , _opPlacementID :: Int
-    }
-
-data InPlacement = InPlacement
-    { _ipPlacement :: [Placement] -> Placement
-    , _ipPlacementID :: Int
-    }
-
-makeLenses ''World
-
-makeLenses ''Universe
-makeLenses ''ScreenLayer
-makeLenses ''GenWorld
-
------ ROOM LENSES
-
-makeLenses ''Room
-makeLenses ''RoomType
-makeLenses ''PSType
-makeLenses ''PlacementSpot
-makeLenses ''Placement
-
-_itUseAimStance :: Item -> AimStance
-_itUseAimStance = _aimStance . _useAim . _itUse
-
-crSel :: Creature -> Int
-crSel = _iselPos . _crInvSel