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

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



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

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'
