module Dodge.LevelGen.PlacementHelper where

import Control.Lens
import Data.Maybe
import Dodge.Data.GenWorld
import Geometry

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

psPtJpl :: PlacementSpot -> PSType -> Maybe Placement
psPtJpl ps = Just . psPtPl ps

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

ptCont :: PSType -> (Placement -> Maybe Placement) -> Placement
ptCont = psPtCont (PS 0 0)

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

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

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

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

jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (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 (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 . const

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

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

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

-- the NoShiftCont is necessary when shifting then combining rooms
ps0PushPS :: PSType -> (Placement -> Maybe Placement) -> Placement
ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
    \_ pl -> f pl & _Just . plSpot %~ const (_plSpot pl)

ps0PushPSw :: PSType -> (GenWorld -> Placement -> Maybe Placement) -> Placement
ps0PushPSw pst f = Placement (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
--    (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
    (Placement ps pt mi f) -> Placement ps pt mi (fmap (fmap g) f)
  where
    g Nothing = Just pl
    g (Just pl') = Just $ addPlmnt pl pl'