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

import Control.Lens
import Control.Monad.State
import System.Random
data PSType = PutCrit {_unPutCrit :: Creature}
    | PutMachine Color [Point2] Machine
    | PutLS LightSource
    | PutButton Button
    | PutProp Prop
    | PutFlIt Item
    | PutPressPlate PressPlate
    | PutBlock [Int] Color [Point2]
    | PutCoordinate Point2
    | PutTrigger (World -> Bool)
    | PutLineBlock Wall 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 }
    | PSLnk { _psLinkTest :: (Point2,Float) -> Bool
            , _psLinkShift :: (Point2,Float) -> (Point2,Float)
            , _psFallback :: Maybe Placement
            }
    | PSRoomRand { _psRoomRandPointNum :: Int }
data Placement = Placement 
    { _plSpot   :: PlacementSpot
    , _plType   :: PSType
    , _plID     :: Maybe Int
    , _plIDCont :: Int -> Maybe Placement 
    }
  | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
  | RandomPlacement {_unRandomPlacement :: State StdGen Placement}

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

sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a) 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

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

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

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'

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