72 lines
2.1 KiB
Haskell
72 lines
2.1 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
|
|
, _psType :: PSType
|
|
}
|
|
data Placement = Placement
|
|
{ _placementSpot :: PlacementSpot
|
|
, _idPlacement :: Int -> Maybe Placement
|
|
}
|
|
| PlacementPos Point3 (Point3 -> 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 pst = Placement (PS (V2 0 0) 0 pst)
|
|
|
|
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)
|
|
|
|
makeLenses ''PSType
|
|
makeLenses ''PlacementSpot
|
|
makeLenses ''Placement
|