Cleanup
This commit is contained in:
@@ -24,6 +24,7 @@ data GenWorld = GenWorld
|
|||||||
{ _gwWorld :: World
|
{ _gwWorld :: World
|
||||||
, _genRooms :: IM.IntMap Room
|
, _genRooms :: IM.IntMap Room
|
||||||
, _genPmnt :: IM.IntMap Placement
|
, _genPmnt :: IM.IntMap Placement
|
||||||
|
, _genInts :: IM.IntMap Int
|
||||||
}
|
}
|
||||||
|
|
||||||
---- ROOM DATATYPES
|
---- ROOM DATATYPES
|
||||||
@@ -56,7 +57,7 @@ data PSType
|
|||||||
| PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
|
| PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
|
||||||
| RandPS (State StdGen PSType)
|
| RandPS (State StdGen PSType)
|
||||||
| PutForeground ForegroundShape
|
| PutForeground ForegroundShape
|
||||||
| PutWorldUpdate (PlacementSpot -> GenWorld -> GenWorld)
|
| PutWorldUpdate (Room -> PlacementSpot -> GenWorld -> GenWorld)
|
||||||
| PutNothing
|
| PutNothing
|
||||||
| PutID {_putID :: Int}
|
| PutID {_putID :: Int}
|
||||||
| PutChasm {_putChasmPoly :: [Point2]}
|
| PutChasm {_putChasmPoly :: [Point2]}
|
||||||
@@ -107,7 +108,6 @@ data Room = Room
|
|||||||
, _rmPath :: S.Set (Point2, Point2)
|
, _rmPath :: S.Set (Point2, Point2)
|
||||||
, _rmPmnts :: [Placement]
|
, _rmPmnts :: [Placement]
|
||||||
, _rmInPmnt :: [GenWorld -> Placement]
|
, _rmInPmnt :: [GenWorld -> Placement]
|
||||||
-- , _rmOutPmnt :: IM.IntMap Placement
|
|
||||||
, _rmBound :: [[Point2]]
|
, _rmBound :: [[Point2]]
|
||||||
, _rmFloor :: Floor
|
, _rmFloor :: Floor
|
||||||
, _rmName :: String
|
, _rmName :: String
|
||||||
|
|||||||
@@ -17,6 +17,7 @@ worldToGenWorld rms w =
|
|||||||
{ _gwWorld = w & cWorld . cwGen . cwgParams .~ evalState generateGenParams (_randGen w)
|
{ _gwWorld = w & cWorld . cwGen . cwgParams .~ evalState generateGenParams (_randGen w)
|
||||||
, _genRooms = rms
|
, _genRooms = rms
|
||||||
, _genPmnt = mempty
|
, _genPmnt = mempty
|
||||||
|
, _genInts = mempty
|
||||||
}
|
}
|
||||||
|
|
||||||
generateGenParams :: RandomGen g => State g GenParams
|
generateGenParams :: RandomGen g => State g GenParams
|
||||||
|
|||||||
@@ -17,7 +17,7 @@ import LensHelp
|
|||||||
putTerminalImediateAccess :: Color -> Machine -> Terminal -> Placement
|
putTerminalImediateAccess :: Color -> Machine -> Terminal -> Placement
|
||||||
putTerminalImediateAccess = putTerminalFull f
|
putTerminalImediateAccess = putTerminalFull f
|
||||||
where
|
where
|
||||||
f tmpl _ _ = Just $ sps0 $ PutWorldUpdate $ const $ over gwWorld $ accessTerminal (tmpl ^?! plMID . _Just)
|
f tmpl _ _ = Just $ sps0 $ PutWorldUpdate $ const $ const $ over gwWorld $ accessTerminal (tmpl ^?! plMID . _Just)
|
||||||
|
|
||||||
putTerminalFull ::
|
putTerminalFull ::
|
||||||
(Placement -> Placement -> Placement -> Maybe Placement) ->
|
(Placement -> Placement -> Placement -> Maybe Placement) ->
|
||||||
@@ -39,7 +39,7 @@ putTerminalFull f col mc tm =
|
|||||||
defaultSensorWall
|
defaultSensorWall
|
||||||
Nothing
|
Nothing
|
||||||
)
|
)
|
||||||
$ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ over gwWorld (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
|
$ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ const $ over gwWorld (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
|
||||||
where
|
where
|
||||||
setids tmpl btpl mcpl w =
|
setids tmpl btpl mcpl w =
|
||||||
w
|
w
|
||||||
|
|||||||
@@ -122,7 +122,7 @@ placeSpotID rm ps pt w = case pt of
|
|||||||
PutWall qs wl -> (0, over gwWorld (placeWallPoly (map doShift qs) wl) w)
|
PutWall qs wl -> (0, over gwWorld (placeWallPoly (map doShift qs) wl) w)
|
||||||
PutNothing -> (0, w)
|
PutNothing -> (0, w)
|
||||||
PutID i -> (i, w)
|
PutID i -> (i, w)
|
||||||
PutWorldUpdate f -> (0, w & f ps)
|
PutWorldUpdate f -> (0, w & f rm ps)
|
||||||
PutChasm ps' -> (0, w & gwWorld . cWorld . chasms .:~ map doShift ps')
|
PutChasm ps' -> (0, w & gwWorld . cWorld . chasms .:~ map doShift ps')
|
||||||
where
|
where
|
||||||
p@(V2 px py) = _psPos ps
|
p@(V2 px py) = _psPos ps
|
||||||
|
|||||||
@@ -120,7 +120,7 @@ addButtonSlowDoor x h rm = do
|
|||||||
(aShape (V2 15 0) (V3 15 xoff 90))
|
(aShape (V2 15 0) (V3 15 xoff 90))
|
||||||
$ \plls plpr ->
|
$ \plls plpr ->
|
||||||
Just $
|
Just $
|
||||||
ptCont (PutWorldUpdate (const $ over gwWorld $ setmount dr plls plpr)) $
|
ptCont (PutWorldUpdate (const $ const $ over gwWorld $ setmount dr plls plpr)) $
|
||||||
const mpl
|
const mpl
|
||||||
setmount pldr plls plpr =
|
setmount pldr plls plpr =
|
||||||
cWorld . lWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
|
cWorld . lWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
|
||||||
|
|||||||
@@ -100,7 +100,7 @@ attachOnward' t1 t2 = MTree (_mtLabel t1) (NodeMTree t1) [MBranch toOnward t2]
|
|||||||
|
|
||||||
toOnward :: Room -> Maybe Room
|
toOnward :: Room -> Maybe Room
|
||||||
toOnward rm
|
toOnward rm
|
||||||
| OnwardCluster `elem` rm ^?! rmClusterStatus . csLinks =
|
| OnwardCluster `elem` rm ^. rmClusterStatus . csLinks =
|
||||||
Just (rm & rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
|
Just (rm & rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user