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

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
    | PutPressPlate PressPlate
    | PutBlock BlockMaterial [Int] Wall [Point2]
    | PutCoordinate Point2
    | PutMod Modification
    | PutTrigger (World -> Bool)
    | PutLineBlock Wall BlockMaterial Float Float Point2 Point2
    | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
    | PutSlideDoor Bool Color (World -> Bool) Point2 Point2 Float
    | PutDoor Color (World -> Bool) [(Point2,Point2)]
    | RandPS (State StdGen PSType)
    | PutForeground Shape
    | PutWorldUpdate (PlacementSpot -> World -> World)
    | PutNothing
    | PutID { _putID :: Int}
-- maybe there is a monadic implementation of this?
data PlacementSpot 
    = PS { _psPos :: Point2 , _psRot :: Float }
    | PSPos 
        { _psLnkShift       :: RoomPos -> Maybe (PlacementSpot, RoomPos)
        , _psLnkRoomEff     :: RoomPos -> Room -> Room
        , _psLnkFallback    :: Maybe Placement
        }
    | PSRoomRand { _psRoomRandPointNum :: Int }
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}


{- 
The '_rmPolys' list states 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] ]
    , _rmOutLinks  :: [(Point2,Float)] 
    , _rmInLinks :: [(Point2,Float)]
        -- 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  :: [Tile]
    , _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
    }
data RoomLink = RoomLink
    { _rlType   :: RoomLinkType
    , _rlPos    :: Point2
    , _rlDir    :: Float
    } deriving (Eq,Ord)
data RoomLinkType
    = OutLink
    | InLink
    | AnyLink
    | LabLink Int
    deriving (Eq,Ord)
data RoomWire
    = --RoomWire Point2 Float
     WallWire Point2 Float Float
data RoomPos 
    = UsedOutLink Int    Point2  Float
    | UsedInLink Int  Point2 Float
    | UnusedLink Point2 Float
    | PosPl   Point2 Float
    | LabPos  Int    RoomPos
  deriving (Eq,Ord,Show)

makeLenses ''Room
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement

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 . intPlPlPl

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) 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 pst = Just $ sPS (V2 0 0) 0 pst

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 . intPlPlPl

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 plmnt = f $ fromJust (_plMID plmnt)

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

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

jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0PushPS pst f = Just . Placement (PS (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)

ps0jPushPS :: PSType -> Placement -> Placement
ps0jPushPS pst plmnt = Placement (PS (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)
  where
    g Nothing = Just pl
    g (Just pl') = Just $ addPlmnt pl pl'