85 lines
2.7 KiB
Haskell
85 lines
2.7 KiB
Haskell
{-# 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
|