{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.LevelGen.Data where
import Dodge.Data
import Picture
import Geometry
import Shape.Data
import Data.Tile

import qualified Data.Set as S
import Control.Lens
import Control.Monad.State
import System.Random
import Data.Maybe
import qualified Data.IntMap.Strict as IM
--import Data.Bifunctor

data PSType = PutCrit {_unPutCrit :: Creature}
    | PutMachine Color [Point2] Machine
    | PutLS LightSource
    | PutButton Button
    | PutProp Prop
    | PutFlIt Item
    | PutPPlate PressPlate
    | PutBlock BlockMaterial Int [Int] Wall [Point2]
    | PutCoord Point2
    | PutMod Modification
    | PutTrigger (World -> Bool)
    | PutLineBlock Wall BlockMaterial Float Float Point2 Point2
    | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
    | PutSlideDr Bool Color (World -> Bool) Point2 Point2 Float
    | PutDoor Color (World -> Bool) [(Point2,Point2)]
    | RandPS (State StdGen PSType)
    | PutShape Shape
    | PutWorldUpdate (PlacementSpot -> World -> World)
    | PutNothing
    | 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
        }
data Placement 
    = Placement
        { _plSpot   :: PlacementSpot
        , _plType   :: PSType
        , _plMID    :: Maybe Int
        , _plIDCont :: 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]
    --, _rmOutLinks      :: [RoomLink]
    --, _rmInLinks      :: [RoomLink]
        -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail
    , _rmLinkEff    :: [(Point2,Float) -> Room -> Room]
    , _rmPos        :: [RoomPos]
    , _rmPath       :: [(Point2, Point2)]
    , _rmPmnts      :: [Placement]
    , _rmPartPmnt   :: Maybe ([Placement] -> Placement)
    , _rmExtPmnt    :: Maybe Placement
    , _rmBound      :: [ [Point2] ]
    , _rmFloor      :: Floor
    , _rmName       :: String
    , _rmShift      :: (Point2, Float)
    , _rmViewpoints :: [Point2]
    , _rmRandPSs    :: [State StdGen (Point2,Float)]
    , _rmLabel      :: Maybe Int
    , _rmTakeFrom   :: Maybe Int
    , _rmStartWires :: IM.IntMap RoomWire
    , _rmEndWires   :: IM.IntMap RoomWire
    , _rmConnectsTo :: S.Set RoomLinkType
    , _rmMID        :: Maybe Int
    , _rmMParent    :: Maybe Int
    , _rmChildren   :: [Int]
    }
data RoomLink = RoomLink
    { _rlType   :: S.Set RoomLinkType
    , _rlPos    :: Point2
    , _rlDir    :: Float
    } deriving (Eq,Ord)
data RoomLinkType
    = OutLink
    | InLink
    | LabLink Int
    | OnEdge CardinalPoint
    | FromSouth Int
    | FromWest Int
    deriving (Eq,Ord,Show)
data CardinalPoint
    = North
    | East
    | South
    | West
    deriving (Eq,Ord,Show)
data RoomWire
    = --RoomWire Point2 Float
     WallWire Point2 Float Float
data RoomPos 
    = UsedOutLink 
        {_rpChildNum  :: Int 
        ,_rpOutRoomID :: Int
        ,_rpPos :: Point2  
        ,_rpDir :: Float
        ,_rpLinkType :: S.Set RoomLinkType
        }
    | UsedInLink 
        {_rpInRoomID :: Int 
        ,_rpPos :: Point2 
        ,_rpDir :: Float
        ,_rpLinkType :: S.Set RoomLinkType
        }
    | UnusedLink
        {_rpPos :: Point2 
        ,_rpDir ::Float
        ,_rpLinkType :: S.Set RoomLinkType
        }
    | UsedLink
        {_rpPos :: Point2 
        ,_rpDir :: Float
        ,_rpLinkType :: S.Set RoomLinkType
        }
    | UsedSpot
        {_rpPos :: Point2 
        ,_rpDir :: Float
        ,_rpType :: S.Set RoomPosType
        }
    | UnusedSpot
        {_rpPos :: Point2 
        ,_rpDir :: Float
        ,_rpType :: S.Set RoomPosType
        }
  deriving (Eq,Ord,Show)

data RoomPosType 
    = RoomPosOnPath
    | RoomPosOffPath
    | RoomPosExLink
  deriving (Eq,Ord,Show)

makeLenses ''Room
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement
makeLenses ''RoomLink
makeLenses ''RoomPos
makeLenses ''RoomPosType

spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing (const Nothing)

pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
pContID ps pt = Placement ps pt Nothing . contToIDCont

psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
psPtCont ps pt = Placement ps pt Nothing

psPt :: PlacementSpot -> PSType -> Placement
psPt ps pt = Placement ps pt Nothing (const Nothing)

sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)

sps :: PlacementSpot -> PSType -> Placement
sps ps pt = Placement ps pt Nothing (const Nothing)

plRRpt :: Int -> PSType -> Placement
plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing (const Nothing)

jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ 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 (PS p a) pst Nothing $ \_ -> Just plm

jsps0J :: PSType -> Placement -> Maybe Placement
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm

ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont

pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing

contToIDCont :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
contToIDCont f = f . fromJust . _plMID

jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont

jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing
    $ \plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt

ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)

psj :: PlacementSpot -> PSType -> Placement -> Placement
psj ps pst plmnt = Placement ps pst Nothing (const $ Just plmnt)

-- the NoShiftCont is necessary when shifting then combining rooms
ps0jPushPS :: PSType -> Placement -> Placement
ps0jPushPS pst plmnt = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing 
    $ \p -> Just $ plmnt & plSpot .~ _plSpot p

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 ps pt mi f) -> Placement ps pt mi (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'