{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

module Dodge.Data.GenWorld (
    module Dodge.Data.GenWorld,
    module Dodge.Data.Room,
    module Dodge.Data.RoomCluster,
    module Dodge.Data.World,
) where

import Color
import Control.Lens
import Control.Monad.State
import qualified Data.Set as S
import Data.Tile
import Dodge.Data.Room
import Dodge.Data.RoomCluster
import Dodge.Data.World
import Geometry.Data
import qualified IntMapHelp as IM
import System.Random

data GenWorld = GenWorld
    { _gwWorld :: World
    , _genPlacements :: IM.IntMap [(Placement, Int)]
    , _genRooms :: IM.IntMap Room
    }

---- 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
    | 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 ''GenWorld
makeLenses ''Room
makeLenses ''RoomType
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement