Slight cleanup of placement spots
This commit is contained in:
+4
-7
@@ -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''
|
||||
|
||||
+32
-6
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user