diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index cec5b11dc..e81c9013a 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -59,15 +59,22 @@ generateLevelFromRoomList gr w -- the idea is to allow use of link coordinates for placements -- though the implementation is clunky +-- this should PutNothing if there are no links available +-- first it takes the random placements and derandomises them +-- then it deals with link placement spots assignPlacementSpots :: StdGen -> Room -> (StdGen, [((Point2,Float),Placement)]) assignPlacementSpots g rm = (g', map (_rmShift rm,) $ plmnts ++ plmnts') where - (lnkplmnts, plmnts) = partition islnk (_rmPS rm) + (randPlmnts, detPlmnts) = partition isRand (_rmPS rm) + isRand RandomPlacement{} = True + isRand _ = False + (unrandPlmnts, g'') = runState (mapM _unRandomPlacement randPlmnts) g + (lnkplmnts, plmnts) = partition islnk (unrandPlmnts ++ detPlmnts) islnk Placement{_placementSpot=PSLnk{}} = True islnk _ = False - (shuffledLnks,g') = runState (shuffle $ _rmLinks rm) g + (shuffledLnks,g') = runState (shuffle $ _rmLinks rm) g'' (_,plmnts') = mapAccumR f (map (invShiftLinkBy $ _rmShift rm) shuffledLnks) lnkplmnts - f lnks plmnt = + f lnks plmnt = let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks thepair = _psLinkShift (_placementSpot plmnt) x in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt) diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 169851b33..fe748e872 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -28,12 +28,17 @@ placeSpot w (shift, plmnt@Placement{}) = let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) (_psType plmnt) w in maybe w' (curry (placeSpot w') shift) (_idPlacement plmnt i) placeSpot w (shift, PlacementUsingPos p subpl) = placeSpot w (shift, subpl (shiftPoint3By shift p)) +-- random placements SHOULD be dealt with already (see assignPlacementSpots) +placeSpot w (shift, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (shift, plmnt) + where + (plmnt, g) = runState rplmnt (_randGen w) shiftPlacement :: (Point2,Float) -> Placement -> Placement shiftPlacement shift (Placement ps pt f) = Placement (shiftPSBy shift ps) pt (fmap (fmap $ shiftPlacement shift) f) shiftPlacement shift (PlacementUsingPos p f) = PlacementUsingPos (shiftPoint3By shift p) (fmap (shiftPlacement shift) f) +shiftPlacement shift (RandomPlacement rpl) = RandomPlacement $ fmap (shiftPlacement shift) rpl shiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot shiftPSBy (pos,rot) ps = ps diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 13eb61e45..e29bff344 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -39,6 +39,7 @@ data Placement = Placement , _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) diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index 302dd3259..f7ef4f726 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/src/Dodge/LevelGen/Switch.hs @@ -11,7 +11,6 @@ import Picture import ShapePicture import Shape import Geometry ---import Geometry.Data import qualified Data.IntMap.Strict as IM import Control.Lens diff --git a/src/Dodge/Placements/LightSource.hs b/src/Dodge/Placements/LightSource.hs index 373773fc0..fa47a28c7 100644 --- a/src/Dodge/Placements/LightSource.hs +++ b/src/Dodge/Placements/LightSource.hs @@ -4,10 +4,12 @@ import Dodge.Data import Dodge.LightSources.Lamp import Dodge.LevelGen.Data import Dodge.Room.Foreground +import Dodge.Placements.Spot import Geometry import Dodge.Creature.Inanimate import Shape.Data import Dodge.Default +import Dodge.RandomHelp mountLightOnShape :: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape @@ -82,6 +84,19 @@ mountLightAID = mountLightOnShape f mountLightA :: Point2 -> Point3 -> Placement mountLightA = redMID mountLightAID +mountLightACond :: ((Point2,Float) -> Bool) -> Placement +mountLightACond f = updatePSToLevel 2 (const thePS) $ mountLightA 0 (V3 0 (-40) 40) + where + thePS = PSLnk f (\(p,a)->(p,a)) + +mountLightVCond :: ((Point2,Float) -> Bool) -> Placement +mountLightVCond f = updatePSToLevel 2 (const thePS) $ mountLightV 0 (V3 0 (-20) 40) + where + thePS = PSLnk f id + +mntLightCond :: ((Point2,Float) -> Bool) -> Placement +mntLightCond f = RandomPlacement $ takeOne [mountLightVCond f,mountLightACond f] + mountLightVID :: LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement mountLightVID = mountLightOnShape f where diff --git a/src/Dodge/Placements/Spot.hs b/src/Dodge/Placements/Spot.hs index 035f22b45..51771505e 100644 --- a/src/Dodge/Placements/Spot.hs +++ b/src/Dodge/Placements/Spot.hs @@ -13,11 +13,14 @@ updatePSToLevel :: Int -> (PlacementSpot -> PlacementSpot) -> Placement -> Place updatePSToLevel 0 _ plmnt = plmnt updatePSToLevel i f (PlacementUsingPos p pl) = PlacementUsingPos p (fmap (updatePSToLevel i f) pl) updatePSToLevel i f (Placement ps pt pl) = Placement (f ps) pt (fmap (fmap (updatePSToLevel (i-1) f)) pl) +updatePSToLevel i f (RandomPlacement rplmnt) = RandomPlacement $ fmap (updatePSToLevel i f) rplmnt setLocalPS :: PlacementSpot -> Placement -> Placement setLocalPS ps (Placement _ pt f) = Placement ps pt f +setLocalPS ps (RandomPlacement rplmnt) = RandomPlacement (fmap (setLocalPS ps) rplmnt) setLocalPS _ plmnt = plmnt updatePS :: (PlacementSpot -> PlacementSpot) -> Placement -> Placement updatePS f (Placement ps pt iplmnt) = Placement (f ps) pt ((fmap . fmap $ updatePS f) iplmnt) updatePS f (PlacementUsingPos p plmnt) = PlacementUsingPos p (fmap (updatePS f) plmnt) +updatePS f (RandomPlacement rplmnt) = RandomPlacement (fmap (updatePS f) rplmnt) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index af29cf8d4..2274eaf5f 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -48,7 +48,7 @@ roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] , _rmLinks = lnks , _rmPath = concatMap doublePair pth - , _rmPS = [mountLightA (V2 (x/2) 0) (V3 (x/2) 40 50)] + , _rmPS = [] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] , _rmFloor = [Tile { _tilePoly = rectNSWE y 0 0 x @@ -68,7 +68,10 @@ roomRect x y xn yn = defaultRoom pth = linksAndPath lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn) {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size. -} roomRectAutoLinks :: Float -> Float -> Room -roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60) +roomRectAutoLinks x y = (roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)) + {_rmPS = plmnts} + where + plmnts = [mntLightCond (const True)] {- Combines two rooms into one room. Combines into one big bound, concatenates the rest. -} combineRooms :: Room -> Room -> Room