Remove GenWorld datatype
This commit is contained in:
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user