Allow for placements to use/update the full GenWorld
This commit is contained in:
@@ -78,38 +78,38 @@ placeSpotRoomRand rm i f plmnt w =
|
||||
let (ps, g) = runState (_rmRandPSs rm !! i) $ w ^. gwWorld . randGen
|
||||
in placeSpot (w & gwWorld . randGen .~ g, rm) (plmnt & plSpot .~ f ps)
|
||||
|
||||
placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
|
||||
placeSpotID ps pt gw =
|
||||
let (i, w) = placeSpotID' ps pt (_gwWorld gw)
|
||||
in (i, gw & gwWorld .~ w)
|
||||
--placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
|
||||
--placeSpotID ps pt gw =
|
||||
-- let (i, w) = placeSpotID' ps pt (_gwWorld gw)
|
||||
-- in (i, gw & gwWorld .~ w)
|
||||
|
||||
-- the Int here is some id that is assigned when the placement is placed
|
||||
placeSpotID' :: PlacementSpot -> PSType -> World -> (Int, World)
|
||||
placeSpotID' ps pt w = case pt of
|
||||
PutTrigger cnd -> plNewID (cWorld . lWorld . triggers) cnd w
|
||||
PutMod mdi -> plNewUpID (cWorld . lWorld . modifications) mdID mdi w
|
||||
PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w
|
||||
PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w
|
||||
PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w
|
||||
placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld)
|
||||
placeSpotID ps pt w = case pt of
|
||||
PutTrigger cnd -> plNewID (gwWorld . cWorld . lWorld . triggers) cnd w
|
||||
PutMod mdi -> plNewUpID (gwWorld . cWorld . lWorld . modifications) mdID mdi w
|
||||
PutProp prp -> plNewUpID (gwWorld . cWorld . lWorld . props) prID (mvProp p rot prp) w
|
||||
PutButton bt -> plNewUpID (gwWorld . cWorld . lWorld . buttons) btID (mvButton p rot bt) w
|
||||
PutTerminal tm -> plNewUpID (gwWorld . cWorld . lWorld . terminals) tmID tm w
|
||||
PutFlIt itm ->
|
||||
let i = IM.newKey (w ^. cWorld . lWorld . items)
|
||||
let i = IM.newKey (w ^. gwWorld . cWorld . lWorld . items)
|
||||
in ( i
|
||||
, w
|
||||
& cWorld . lWorld . floorItems . at i ?~ FlIt p rot
|
||||
& cWorld . lWorld . items . at i
|
||||
& gwWorld . cWorld . lWorld . floorItems . at i ?~ FlIt p rot
|
||||
& gwWorld . cWorld . lWorld . items . at i
|
||||
?~ ( itm & itID .~ NInt i
|
||||
& itLocation .~ OnFloor
|
||||
)
|
||||
)
|
||||
PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
|
||||
PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID
|
||||
PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
|
||||
PutForeground fs -> plNewUpID (gwWorld . cWorld . lWorld . foregroundShapes) fsID
|
||||
(mvFS p rot fs) w
|
||||
PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
|
||||
PutLS ls -> plNewUpID (cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
|
||||
PutPPlate pp -> plNewUpID (cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
|
||||
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
|
||||
PutPPlate pp -> plNewUpID (gwWorld . cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
|
||||
RandPS rgn -> evaluateRandPS rgn ps w
|
||||
PutDoor col eo f pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
|
||||
PutCoord cp -> plNewID coordinates (doShift cp) w
|
||||
PutCoord cp -> plNewID (gwWorld . coordinates) (doShift cp) w
|
||||
PutSlideDr wl dr eo off a b ->
|
||||
plSlideDoor wl dr eo off (doShift a) (doShift b) w
|
||||
PutBlock bl wl ps' ->
|
||||
@@ -119,21 +119,21 @@ placeSpotID' ps pt w = case pt of
|
||||
wl
|
||||
w
|
||||
PutLineBlock wl wdth a b -> plLineBlock wl wdth (doShift a) (doShift b) w
|
||||
PutWall qs wl -> (0, placeWallPoly (map doShift qs) wl w)
|
||||
PutWall qs wl -> (0, over gwWorld (placeWallPoly (map doShift qs) wl) w)
|
||||
PutNothing -> (0, w)
|
||||
PutID i -> (i, w)
|
||||
PutWorldUpdate f -> (0, w & f ps)
|
||||
PutChasm ps' -> (0, w & cWorld . chasms .:~ map doShift ps')
|
||||
PutChasm ps' -> (0, w & gwWorld . cWorld . chasms .:~ map doShift ps')
|
||||
where
|
||||
p@(V2 px py) = _psPos ps
|
||||
p' = V3 px py 0
|
||||
rot = _psRot ps
|
||||
doShift = shiftPointBy (p, rot)
|
||||
|
||||
evaluateRandPS :: State StdGen PSType -> PlacementSpot -> World -> (Int, World)
|
||||
evaluateRandPS rgen ps w = placeSpotID' ps evaluatedType (set randGen g w)
|
||||
evaluateRandPS :: State StdGen PSType -> PlacementSpot -> GenWorld -> (Int, GenWorld)
|
||||
evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set (gwWorld . randGen) g w)
|
||||
where
|
||||
(evaluatedType, g) = runState rgen (_randGen w)
|
||||
(evaluatedType, g) = runState rgen (_randGen $ _gwWorld w)
|
||||
|
||||
-- this function is the reason for the warning suppression
|
||||
-- remove the warning suppression if it changes
|
||||
@@ -164,26 +164,27 @@ mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
|
||||
mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
|
||||
|
||||
plMachine ::
|
||||
[Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> World -> (Int, World)
|
||||
[Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> GenWorld -> (Int, GenWorld)
|
||||
plMachine wallpoly mc wl = \case
|
||||
Nothing -> plMachine' wallpoly mc wl
|
||||
Just itm -> plTurret wallpoly mc wl itm
|
||||
|
||||
plTurret :: [Point2] -> Machine -> Wall -> Item -> Point2 -> Float -> World -> (Int, World)
|
||||
plTurret :: [Point2] -> Machine -> Wall -> Item -> Point2 -> Float -> GenWorld
|
||||
-> (Int, GenWorld)
|
||||
plTurret wallpoly mc wl itm p rot gw =
|
||||
( mcid
|
||||
, gw & cWorld . lWorld . machines %~ addMc
|
||||
& cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
|
||||
& cWorld . lWorld . items . at itid ?~ itm'
|
||||
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
|
||||
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
|
||||
& gwWorld . cWorld . lWorld . items . at itid ?~ itm'
|
||||
)
|
||||
where
|
||||
itm' =
|
||||
itm & itID .~ NInt itid
|
||||
& itLocation .~ OnTurret mcid
|
||||
itid = IM.newKey $ gw ^. cWorld . lWorld . items
|
||||
itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
|
||||
col = _mcColor mc
|
||||
mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
|
||||
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
|
||||
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
|
||||
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
|
||||
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
|
||||
addMc =
|
||||
IM.insert
|
||||
@@ -192,16 +193,16 @@ plTurret wallpoly mc wl itm p rot gw =
|
||||
& mcType . mctTurret . tuWeapon .~ itid
|
||||
)
|
||||
|
||||
plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
|
||||
plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> GenWorld -> (Int, GenWorld)
|
||||
plMachine' wallpoly mc wl p rot gw =
|
||||
( mcid
|
||||
, gw & cWorld . lWorld . machines %~ addMc
|
||||
& cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
|
||||
, gw & gwWorld . cWorld . lWorld . machines %~ addMc
|
||||
& gwWorld . cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
|
||||
)
|
||||
where
|
||||
col = _mcColor mc
|
||||
mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
|
||||
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
|
||||
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
|
||||
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
|
||||
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
|
||||
addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids})
|
||||
|
||||
|
||||
Reference in New Issue
Block a user