From 7c4a853d707699ff50de9ee3431a6209ade067dd Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 2 Jun 2022 19:06:00 +0100 Subject: [PATCH] Remove GenWorld datatype --- src/Dodge/Data.hs | 7 +- src/Dodge/Layout.hs | 69 ++++++++++--------- src/Dodge/LevelGen.hs | 2 +- src/Dodge/LevelGen/LevelStructure.hs | 6 +- src/Dodge/Placement/Instance/Sensor.hs | 2 +- src/Dodge/Placement/PlaceSpot.hs | 70 ++++++++++---------- src/Dodge/Placement/PlaceSpot/Block.hs | 18 +++-- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 22 +++--- src/Dodge/Randify.hs | 6 +- 9 files changed, 95 insertions(+), 107 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8eeef14b9..697487d6c 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1371,7 +1371,7 @@ data PSType = PutCrit {_unPutCrit :: Creature} | PutShape Shape | PutWorldUpdate (PlacementSpot -> World -> World) | PutNothing - | PutUsingGenParams (GenWorld -> (GenWorld,PSType)) + | PutUsingGenParams (World -> (World,PSType)) | PutID { _putID :: Int} -- maybe there is a monadic implementation of this? -- add room effect for any placement spot? @@ -1505,10 +1505,6 @@ data RoomPosType | RoomPosLab Int deriving (Eq,Ord,Show) -data GenWorld = GenWorld - { _gWorld :: World - } - makeLenses ''CreatureState makeLenses ''Damage makeLenses ''DamageEffect @@ -1588,4 +1584,3 @@ makeLenses ''RoomLink makeLenses ''RoomPos makeLenses ''RoomPosType makeLenses ''RPLinkStatus -makeLenses ''GenWorld diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 27601dbb0..964765211 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -36,10 +36,10 @@ import Data.Maybe import Data.Function import Control.Monad.State -generateLevelFromRoomList :: IM.IntMap Room -> World -> GenWorld -generateLevelFromRoomList gr' w = over gWorld initWallZoning - . over gWorld randomCompass - . over gWorld setupWorldBounds +generateLevelFromRoomList :: IM.IntMap Room -> World -> World +generateLevelFromRoomList gr' w = initWallZoning + . randomCompass + . setupWorldBounds . placeWires . doAfterPlacements . doInPlacements @@ -61,26 +61,26 @@ generateLevelFromRoomList gr' w = over gWorld initWallZoning randomCompass :: World -> World randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w) -putFloorTiles :: GenWorld -> GenWorld -putFloorTiles gw = gw & gWorld . floorTiles .~ floorsFromGenWorld gw +putFloorTiles :: World -> World +putFloorTiles gw = gw & floorTiles .~ floorsFromGenWorld gw -setFloors :: GenWorld -> GenWorld +setFloors :: World -> World setFloors = putFloorTiles . setTiles -- note the order of traversal of the rooms is important -- hence the reverse -- this is not ideal: should do this in some more sensible way -setTiles :: GenWorld -> GenWorld -setTiles gw = foldr setTile gw . reverse . IM.elems $ _genRooms $ _gWorld gw +setTiles :: World -> World +setTiles gw = foldr setTile gw . reverse . IM.elems $ _genRooms $ gw -setTile :: Room -> GenWorld -> GenWorld +setTile :: Room -> World -> World setTile r gw = case _rmFloor r of Tiled {} -> gw - InheritFloor -> gw & gWorld . genRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly] + InheritFloor -> gw & genRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly] where t = case _rmMParent r of Nothing -> Tile poly (V2 0 0) (V2 1 0) 16 - Just pid -> head $ _tiles $ _rmFloor $ _genRooms (_gWorld gw) IM.! pid + Just pid -> head $ _tiles $ _rmFloor $ _genRooms gw IM.! pid poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat $ _rmPolys r shuffleRoomPos :: RandomGen g => Room -> State g Room @@ -88,9 +88,8 @@ shuffleRoomPos rm = do newPos <- shuffle $ _rmPos rm return $ rm & rmPos .~ newPos -placeWires :: GenWorld -> GenWorld -placeWires w = w - & gWorld .~ foldr placeRoomWires (_gWorld w) (_genRooms $ _gWorld w) +placeWires :: World -> World +placeWires w = foldr placeRoomWires ( w) (_genRooms w) placeRoomWires :: Room -> World -> World placeRoomWires rm w = IM.foldr ($) w @@ -118,43 +117,43 @@ placeWire rm (WallWire p _ h1) (WallWire q _ h2) = foregroundShape rightpleftq x = isRHS rmcen p x && isLHS rmcen q x rs = _rmShift rm -doAfterPlacements :: GenWorld -> GenWorld -doAfterPlacements gw = foldr doAfterPlacement gw (_genPlacements $ _gWorld gw) +doAfterPlacements :: World -> World +doAfterPlacements gw = foldr doAfterPlacement gw (_genPlacements gw) -doAfterPlacement :: [(Placement,Int)] -> GenWorld -> GenWorld +doAfterPlacement :: [(Placement,Int)] -> World -> World doAfterPlacement pmntis gw = gRandify gw $ do (pmnt,i) <- takeOne pmntis - let (newgw,rm) = fst $ placeSpot (gw,_genRooms (_gWorld gw) IM.! i) pmnt - return $ newgw & gWorld . genRooms . ix i .~ rm + let (newgw,rm) = fst $ placeSpot (gw,_genRooms ( gw) IM.! i) pmnt + return $ newgw & genRooms . ix i .~ rm -doInPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld +doInPlacements :: ( IM.IntMap [Placement],World) -> World doInPlacements (im,w) = - let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_genRooms $ _gWorld w) - in gw & gWorld . genRooms .~ rms + let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_genRooms w) + in gw & genRooms .~ rms -doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room) +doRoomInPlacements :: IM.IntMap [Placement] -> World -> Room -> (World, Room) doRoomInPlacements im w rm = foldr f (w,rm) $ _rmInPmnt rm where f (InPlacement plf i) (w',r') = fst $ placeSpot (w',r') (plf $ im IM.! i) -doOutPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld) -doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_genRooms $ _gWorld w) - in (pmnts,gw & gWorld . genRooms .~ rms) +doOutPlacements :: World -> ( IM.IntMap [Placement], World) +doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_genRooms w) + in (pmnts,gw & genRooms .~ rms) -doRoomOutPlacements :: (IM.IntMap [Placement], GenWorld) +doRoomOutPlacements :: (IM.IntMap [Placement], World) -> Room - -> ( (IM.IntMap [Placement], GenWorld) , Room ) + -> ( (IM.IntMap [Placement], World) , Room ) doRoomOutPlacements imw r = foldr f ( imw, r ) $ _rmOutPmnt r where f (OutPlacement pl i) ( (im,w) , rm ) = let ((neww,newrm),plmnts) = placeSpot (w,rm) pl in ((IM.insert i plmnts im, neww) , newrm ) -doIndividualPlacements :: GenWorld -> GenWorld -doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_genRooms $ _gWorld gw) - in gw' & gWorld . genRooms .~ rms +doIndividualPlacements :: World -> World +doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_genRooms gw) + in gw' & genRooms .~ rms -doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room) +doRoomPlacements :: World -> Room -> (World, Room) doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm setupWorldBounds :: World -> World @@ -236,8 +235,8 @@ gameRoomFromRoom rm = GameRoom floorsFromRooms :: [Room] -> [(Point3,Point3)] floorsFromRooms = concatMap (concatMap tileToRenderList . getTiles . _rmFloor . doRoomShift) -floorsFromGenWorld :: GenWorld -> [(Point3,Point3)] -floorsFromGenWorld = floorsFromRooms . IM.elems . _genRooms . _gWorld +floorsFromGenWorld :: World -> [(Point3,Point3)] +floorsFromGenWorld = floorsFromRooms . IM.elems . _genRooms getTiles :: Floor -> [Tile] getTiles fl = case fl of diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 95ebbf922..17af67d28 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -22,7 +22,7 @@ generateWorldFromSeed :: Int -> IO World generateWorldFromSeed i = do writeFile "attemptedSeeds" "" (roomList,bounds) <- layoutLevelFromSeed 0 i - return $ saveLevelStartSlot $ _gWorld (generateLevelFromRoomList roomList + return $ saveLevelStartSlot $ (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}) & roomClipping .~ bounds diff --git a/src/Dodge/LevelGen/LevelStructure.hs b/src/Dodge/LevelGen/LevelStructure.hs index 831d8909c..1577c3fa1 100644 --- a/src/Dodge/LevelGen/LevelStructure.hs +++ b/src/Dodge/LevelGen/LevelStructure.hs @@ -18,13 +18,11 @@ import qualified Data.Map.Strict as M import Control.Monad.State import System.Random -worldToGenWorld :: IM.IntMap Room -> World -> GenWorld -worldToGenWorld rms w = GenWorld - { _gWorld = w & genParams .~ gparams +worldToGenWorld :: IM.IntMap Room -> World -> World +worldToGenWorld rms w = w & genParams .~ gparams & genRooms .~ rms -- , _gPlacements = IM.empty -- , _gRooms = rms - } where gparams = evalState generateGenParams (_randGen w) diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index f8bc81641..c73a7de10 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -24,7 +24,7 @@ damageSensor damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $ \lsid -> Just $ spNoID ps $ PutUsingGenParams $ \gw -> (,) gw $ PutMachine yellow (reverse $ square wdth) defaultMachine - { _mcDraw = sensorSPic wdth $ _sensorCoding (_genParams $ _gWorld gw) M.! dt + { _mcDraw = sensorSPic wdth $ _sensorCoding (_genParams gw) M.! dt , _mcUpdate = \mc -> upf mc . sensorUpdate dt mc , _mcSensor = SensorToggleAmount False 0 , _mcLSs = [lsid] diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index a6bb88b05..1b9137f86 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -31,10 +31,10 @@ import Data.Bifunctor -- when placing a placement, we update the world and the room and assign an id -- to the placement -placeSpot :: (GenWorld,Room) -> Placement -> ( (GenWorld,Room), [Placement] ) +placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] ) placeSpot (w,rm) plmnt = case plmnt of - pl@Placement{_plGenUpdate = Just f} -> let (gp,pl') = f (_genParams $ _gWorld w) pl - in placeSpot (w & gWorld . genParams .~ gp,rm) pl' + pl@Placement{_plGenUpdate = Just f} -> let (gp,pl') = f (_genParams w) pl + in placeSpot (w & genParams .~ gp,rm) pl' Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback Placement{} -> placePlainPSSpot w rm plmnt shift @@ -44,15 +44,15 @@ placeSpot (w,rm) plmnt = case plmnt of where shift = _rmShift rm -placePickOne :: Int -> Placement -> Room -> GenWorld -> GenWorld -placePickOne i pl rm w = w & gWorld . genPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))] +placePickOne :: Int -> Placement -> Room -> World -> World +placePickOne i pl rm w = w & genPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))] -placeRandomPlacement :: State StdGen Placement -> GenWorld -> Room -> ((GenWorld,Room),[Placement]) -placeRandomPlacement rplmnt w rm = placeSpot (w & gWorld . randGen .~ g,rm) plmnt' +placeRandomPlacement :: State StdGen Placement -> World -> Room -> ((World,Room),[Placement]) +placeRandomPlacement rplmnt w rm = placeSpot (w & randGen .~ g,rm) plmnt' where - (plmnt', g) = runState rplmnt (_randGen $ _gWorld w) + (plmnt', g) = runState rplmnt (_randGen w) -placePlainPSSpot :: GenWorld -> Room -> Placement -> DPoint2 -> ((GenWorld,Room),[Placement]) +placePlainPSSpot :: World -> Room -> Placement -> DPoint2 -> ((World,Room),[Placement]) placePlainPSSpot w rm plmnt shift = let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w newplmnt = plmnt & plMID ?~ i @@ -62,13 +62,13 @@ placePlainPSSpot w rm plmnt shift = in (wr,newplmnt:newplmnts) -- this should be tidied up -placeSpotUsingLink :: GenWorld +placeSpotUsingLink :: World -> Room -> Placement -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) -> (RoomPos -> Room -> Room) -> Maybe Placement - -> ((GenWorld, Room), [Placement]) + -> ((World, Room), [Placement]) placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos rm) of Just (ps,rmposs) -> placeSpot (w, eff (head rmposs) $ rm & rmPos .~ rmposs) (plmnt & plSpot .~ ps) Nothing -> case fallback of @@ -81,13 +81,13 @@ placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos r Just (ps,rmpos) -> Just ( ps,rmpos:poss) placeSpotRoomRand :: Room -> Int -> (DPoint2 -> PlacementSpot) - -> Placement -> GenWorld -> ((GenWorld,Room),[Placement]) + -> Placement -> World -> ((World,Room),[Placement]) placeSpotRoomRand rm i f plmnt w = - let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen (_gWorld w) - in placeSpot (w & gWorld . randGen .~ g,rm) (plmnt & plSpot .~ f ps) + let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w + in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ f ps) -- the Int here is some id that is assigned when the placement is placed -placeSpotID :: PlacementSpot -> PSType -> GenWorld -> (Int, GenWorld) +placeSpotID :: PlacementSpot -> PSType -> World -> (Int, World) placeSpotID ps pt w = case pt of PutTrigger cnd -> plNewID triggers cnd w PutMod mdi -> plNewUpID modifications mdID mdi w @@ -110,7 +110,7 @@ placeSpotID ps pt w = case pt of PutShape sh -> placeShape sh p rot w PutNothing -> (0,w) PutID i -> (i, w) - PutWorldUpdate f -> (0,w & gWorld %~ f ps) + PutWorldUpdate f -> (0,w & f ps) PutUsingGenParams f -> let (w',pt') = f w in placeSpotID ps pt' w' where @@ -119,17 +119,17 @@ placeSpotID ps pt w = case pt of rot = _psRot ps doShift = shiftPointBy (p,rot) -placeShape :: Shape -> Point2 -> Float -> GenWorld -> (Int, GenWorld) +placeShape :: Shape -> Point2 -> Float -> World -> (Int, World) placeShape sh p rot w = - (0, w & gWorld . foregroundShape %~ ((uncurryV translateSHf p . rotateSH rot) sh <>)) + (0, w & foregroundShape %~ ((uncurryV translateSHf p . rotateSH rot) sh <>)) -evaluateRandPS :: State StdGen PSType -> PlacementSpot -> GenWorld -> (Int,GenWorld) -evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set (gWorld . randGen) g w) +evaluateRandPS :: State StdGen PSType -> PlacementSpot -> World -> (Int,World) +evaluateRandPS rgen ps w = placeSpotID ps evaluatedType (set randGen g w) where - (evaluatedType, g) = runState rgen (_randGen $ _gWorld w) + (evaluatedType, g) = runState rgen (_randGen w) -placeWallPoly :: [Point2] -> Wall -> GenWorld -> GenWorld -placeWallPoly ps wl = gWorld %~ (rmCrossPaths . over walls (addWalls ps wl)) +placeWallPoly :: [Point2] -> Wall -> World -> World +placeWallPoly ps wl = (rmCrossPaths . over walls (addWalls ps wl)) where rmCrossPaths w = foldr (uncurry removePathsCrossing) w $ loopPairs ps @@ -148,21 +148,21 @@ addPane wl l wls = IM.insert wlid (wl { _wlLine = l, _wlID = wlid }) wls -- new index as well plNewID :: ALens' World (IM.IntMap a) -> a - -> GenWorld - -> (Int,GenWorld) -plNewID l x w = (i,w & gWorld . l #%~ IM.insert i x) + -> World + -> (Int,World) +plNewID l x w = (i,w & l #%~ IM.insert i x) where - i = IM.newKey $ _gWorld w ^# l + i = IM.newKey $ w ^# l -- | place an new object into an intmap and update its id plNewUpID :: ALens' World (IM.IntMap a) -> ALens' a Int -> a - -> GenWorld - -> (Int,GenWorld) -plNewUpID l li x w = (i,w & gWorld . l #%~ IM.insert i (x & li #~ i)) + -> World + -> (Int,World) +plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i)) where - i = IM.newKey $ _gWorld w ^# l + i = IM.newKey $ w ^# l mvProp :: Point2 -> Float -> Prop -> Prop mvProp p a = (pjRot +~ a) . (pjPos %~ ( (p +.+) . rotateV a )) @@ -180,13 +180,13 @@ mvPP p rot pp = pp {_ppPos = p,_ppRot = rot} mvCr :: Point2 -> Float -> Creature -> Creature mvCr p rot cr = cr {_crPos = p,_crOldPos = p,_crDir = rot} -plMachine :: Color -> [Point2] -> Machine -> Point2 -> Float -> GenWorld -> (Int,GenWorld) +plMachine :: Color -> [Point2] -> Machine -> Point2 -> Float -> World -> (Int,World) plMachine color wallpoly mc p rot gw = (mcid - , gw & gWorld . machines %~ addMc - & gWorld . walls %~ placeMachineWalls color wallpoly mcid wlid + , gw & machines %~ addMc + & walls %~ placeMachineWalls color wallpoly mcid wlid ) where - w' = _gWorld gw + w' = gw mcid = IM.newKey $ _machines w' wlid = IM.newKey $ _walls w' wlids = IS.fromList [wlid .. wlid + length wallpoly - 1] diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index ef8ce5621..627420cd7 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -54,11 +54,10 @@ addBlock (p:ps) wl hp hps bm w ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl) addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon" -placeBlock :: [Point2] -> Int -> Wall -> [Int] -> BlockMaterial -> GenWorld -> (Int,GenWorld) -placeBlock poly i wl is bm gw - = (0, gw & gWorld .~ foldr (uncurry removePathsCrossing) wWithBlock pairs) +placeBlock :: [Point2] -> Int -> Wall -> [Int] -> BlockMaterial -> World -> (Int,World) +placeBlock poly i wl is bm w + = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs) where - w = _gWorld gw pairs = loopPairs poly wWithBlock = addBlock poly wl i is bm w @@ -70,13 +69,12 @@ placeLineBlock -> Float -- ^ Block depth -> Point2 -- ^ Start point (symmetric) -> Point2 -- ^ End point (symmetric) - -> GenWorld - -> (Int, GenWorld) + -> World + -> (Int, World) placeLineBlock basePane bm blockWidth depth a b gw = ( 0 - , gw & gWorld .~ removePathsCrossing a b (foldr insertWall (insertBlocks w) listWalls) + , removePathsCrossing a b (foldr insertWall (insertBlocks gw) listWalls) ) where - w = _gWorld gw psOnLine = divideLineOddNumPoints blockWidth a b halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1) blockCenPs = snd $ evenOddSplit psOnLine @@ -85,8 +83,8 @@ placeLineBlock basePane bm blockWidth depth a b gw = ( 0 cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints linesAt p = loopPairs $ cornersAt p - wlid = IM.newKey $ _walls w - blid = IM.newKey $ _blocks w + wlid = IM.newKey $ _walls gw + blid = IM.newKey $ _blocks gw insertBlock i = over blocks $ IM.insert (i+blid) Block { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i , _blHPs = [5,5], _blShadows = shadowsAt i, _blMaterial = bm} diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index f788496c1..92d00027b 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -21,12 +21,11 @@ plDoor :: Color -> (World -> Bool) -- ^ Opening condition -> [(Point2,Point2)] -- ^ Door positions, closed to open. -- Bumped out up and down by 9, not widened - -> GenWorld - -> (Int,GenWorld) -plDoor col cond pss gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor)) + -> World + -> (Int,World) +plDoor col cond pss gw = (drid, (addWalls gw & doors %~ addDoor)) where - w = _gWorld gw - drid = IM.newKey $ _doors w + drid = IM.newKey $ _doors gw addDoor = IM.insert drid $ Door { _drID = drid , _drWallIDs = IS.fromList wlids @@ -38,7 +37,7 @@ plDoor col cond pss gw = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor)) , _drClosePos = last pss } nsteps = length pss - 1 - wlids = take 4 [IM.newKey $ _walls w ..] + wlids = take 4 [IM.newKey $ _walls gw ..] wlps' = uncurry (rectanglePairs 9) $ head pss addWalls w' = foldl' (addDoorWall col False) w' $ zip wlids wlps' @@ -106,13 +105,12 @@ plSlideDoor -> Point2 -> Point2 -> Float - -> GenWorld - -> (Int, GenWorld) + -> World + -> (Int, World) plSlideDoor isPathable col cond shiftOffset a b speed gw - = (drid, gw & gWorld .~ (addWalls w & doors %~ addDoor)) + = (drid, (addWalls gw & doors %~ addDoor)) where - w = _gWorld gw - drid = IM.newKey $ _doors w + drid = IM.newKey $ _doors gw addDoor = IM.insert drid $ Door { _drID = drid , _drWallIDs = IS.fromList wlids @@ -127,7 +125,7 @@ plSlideDoor isPathable col cond shiftOffset a b speed gw pairs = rectanglePairs 9 a b shiftedPairs = map (bimap shiftLeft shiftLeft) pairs shiftLeft = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a))) - wlids = take 4 [IM.newKey $ _walls w ..] + wlids = take 4 [IM.newKey $ _walls gw ..] -- old code that may help with pathing --import Dodge.LevelGen.Pathing --import Data.Graph.Inductive hiding ((&)) diff --git a/src/Dodge/Randify.hs b/src/Dodge/Randify.hs index 544109f83..01fbe9346 100644 --- a/src/Dodge/Randify.hs +++ b/src/Dodge/Randify.hs @@ -6,6 +6,6 @@ import System.Random import Control.Monad.State import Control.Lens -gRandify :: GenWorld -> State StdGen GenWorld -> GenWorld -gRandify gw mw = let (gw',g) = runState mw (_randGen $ _gWorld gw) - in gw' & gWorld . randGen .~ g +gRandify :: World -> State StdGen World -> World +gRandify gw mw = let (gw',g) = runState mw (_randGen gw) + in gw' & randGen .~ g