Slight cleanup of placement spots

This commit is contained in:
2021-11-07 20:38:40 +00:00
parent 5681a37953
commit 2d98c74ab3
2 changed files with 36 additions and 13 deletions
+32 -6
View File
@@ -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)