diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index a78daa055..2bcabb0f6 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -53,7 +53,8 @@ generateLevelFromRoomList gr w where path = pairsToGraph dist pairPath pairPath = concatMap _rmPath rs - plmnts = concat . snd $ mapAccumR assignPlacementSpots (_randGen w) rs + plmnts = concatMap (\rm -> map (rm,) (_rmPS rm)) rs + --plmnts = concat . snd $ mapAccumR assignPlacementSpots (_randGen w) rs rs = zipWith addTile zs . evalState gr $ _randGen w zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w @@ -63,18 +64,14 @@ generateLevelFromRoomList gr w -- first it takes the random placements and derandomises them -- then it deals with link placement spots -- TODO use state monad here -assignPlacementSpots :: StdGen -> Room -> (StdGen, [((Point2,Float),Placement)]) +assignPlacementSpots :: StdGen -> Room -> (StdGen, [(Room,Placement)]) assignPlacementSpots g rm = (g' - , map (_rmShift rm,) + , map (rm,) $ plmnts ++ updatedLnkPlmnts ) where - (randPlmnts, detPlmnts) = partition isRand (_rmPS rm) - isRand RandomPlacement{} = True - isRand _ = False (unrandPlmnts, g'') = runState (mapM (derandPlacement rm) (_rmPS rm)) g (lnkplmnts, plmnts) = partition islnk unrandPlmnts - --(lnkplmnts, plmnts) = partition islnk (unrandPlmnts ++ detPlmnts) islnk Placement{_placementSpot=PSLnk{}} = True islnk _ = False (shuffledLnks,g') = runState (shuffle $ _rmLinks rm) g'' diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index fe748e872..41adbda19 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -13,6 +13,9 @@ import Dodge.LevelGen.Pathing import Dodge.LevelGen.TriggerDoor import Dodge.LevelGen.Data import Dodge.Default.Wall +import Dodge.RandomHelp +import Dodge.Room.Data +import Dodge.Placements.Spot import Geometry import Geometry.Vector3D import Shape @@ -23,16 +26,39 @@ import Control.Monad.State import Control.Lens import qualified Data.IntSet as IS -placeSpot :: World -> ((Point2,Float) , Placement) -> World -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)) +placeSpot :: World -> (Room , Placement) -> World +placeSpot w (rm, plmnt@Placement{_placementSpot=PSRoomRand i}) = + let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w + in placeSpot (w & randGen .~ g) (rm, plmnt & placementSpot .~ uncurry PS ps) +placeSpot w (rm, plmnt@Placement{_placementSpot=PSLnk{}}) + = assignPSToLnk rm plmnt w +placeSpot w (rm, plmnt@Placement{}) = + let (i,w') = placeSpotID (shiftPSBy shift (_placementSpot plmnt)) (_psType plmnt) w + in maybe w' (curry (placeSpot w') rm) (_idPlacement plmnt i) + where + shift = _rmShift rm +placeSpot w (rm, PlacementUsingPos p subpl) = placeSpot w (rm, subpl (shiftPoint3By shift p)) + where + shift = _rmShift rm -- random placements SHOULD be dealt with already (see assignPlacementSpots) -placeSpot w (shift, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (shift, plmnt) +placeSpot w (rm, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (rm, plmnt) where (plmnt, g) = runState rplmnt (_randGen w) +-- ok, this is unsafe, but whatever +assignPSToLnk :: Room -> Placement -> World -> World +assignPSToLnk rm plmnt w = placeSpot (w & randGen .~ g) (rm, updatePS (f lnk) plmnt) + where + rps = _placementSpot plmnt + test = _psLinkTest rps + (lnk:_,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) + $ _randGen w + f x (PSLnk t s) + | t x = uncurry PS $ s x + f _ ps = ps + invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float) + invShiftLinkBy (pos,rot) (p,r) = (invShiftPointBy (pos,rot) p, r - rot) + shiftPlacement :: (Point2,Float) -> Placement -> Placement shiftPlacement shift (Placement ps pt f) = Placement (shiftPSBy shift ps) pt (fmap (fmap $ shiftPlacement shift) f)