{-# 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
    | 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
    | 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 
    { _placementSpot :: PlacementSpot
    , _psType :: PSType
    , _idPlacement :: Int -> Maybe Placement 
    }
  | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
  | RandomPlacement {_unRandomPlacement :: State StdGen Placement}

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

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

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

ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 = Placement (PS (V2 0 0) 0)

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

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

addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl (PlacementUsingPos p f) = PlacementUsingPos p (fmap (addPlmnt pl) f)
addPlmnt pl (RandomPlacement rp) = RandomPlacement $ fmap (addPlmnt pl) rp
addPlmnt pl (Placement ps pt f) = Placement ps pt (fmap g f)
  where
    g Nothing = Just pl
    g (Just pl') = Just $ addPlmnt pl pl'

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