justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add quicksave

Browse Source
This commit is contained in:
justin
2021-09-13 00:17:45 +01:00
parent 064d43f903
commit 49274064a0
11 changed files with 28 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+1 -2
View File
@@ -208,9 +208,8 @@ collidePointFF = undefined
-- | Looks for overlap of a circle with walls.
-- If found, gives wall
overlapCircWallsReturnWall :: Point2 -> Float -> IM.IntMap Wall -> Maybe Wall
overlapCircWallsReturnWall p rad ws
overlapCircWallsReturnWall p rad
= L.fold (safeMinimumOnMaybeL (fmap (dist p) . f . _wlLine))
ws
where
f (a,b) = intersectSegSeg p (p -.- rad *.* vNormal (normalizeV (a -.- b))) a b
src/Dodge/Data.hs
+2 -1
View File
@@ -77,9 +77,10 @@ data World = World
, _corpses :: Zone [Corpse]
, _clickMousePos :: !Point2
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
, _pathGraphP :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
, _storedLevel :: Maybe World
, _quicksaveLevel :: Maybe World
, _menuLayers :: [ScreenLayer]
, _worldState :: M.Map WorldState Bool
, _worldTriggers :: S.Set WorldTrigger
src/Dodge/Default/World.hs
+2 -1
View File
@@ -53,12 +53,13 @@ defaultWorld = World
, _corpses = Zone IM.empty
, _decorations = IM.empty
, _storedLevel = Nothing
, _quicksaveLevel = Nothing
, _menuLayers = []
, _worldState = M.empty
, _worldTriggers = S.empty
, _clickMousePos = V2 0 0
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _pathGraph' = []
, _pathGraphP = []
, _pathPoints = IM.empty
, _carteDisplay = False
, _carteCenter = V2 0 0
src/Dodge/Event/Keyboard.hs
+8
View File
@@ -40,11 +40,19 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
handlePressedKey :: Bool -> Scancode -> World -> Maybe World
handlePressedKey True _ w = Just w
handlePressedKey _ ScancodeF5 w = Just $ doQuicksave w
handlePressedKey _ ScancodeF9 w = Just $ maybe w doQuicksave (_quicksaveLevel w)
handlePressedKey _ ScancodeSemicolon w = Just $ gotoTerminal w
handlePressedKey _ scode w
| null (_menuLayers w) = handlePressedKeyInGame scode w
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
doQuicksave :: World -> World
doQuicksave w = w & quicksaveLevel ?~ clearKeys w
clearKeys :: World -> World
clearKeys = (keys .~ S.empty) . (mouseButtons .~ S.empty)
handlePressedKeyInGame :: Scancode -> World -> Maybe World
handlePressedKeyInGame scode w
| scode == escapeKey (_keyConfig w) = Nothing
src/Dodge/Floor.hs
+1 -1
View File
@@ -71,7 +71,7 @@ initialRoomTree = do
,[Corridor]
,[Corridor]
-- --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30]
,[SpecificRoom $ pure . Right <$> pure (twinSlowDoorRoom 30 80 200 40)]
,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 30 80 200 40)]
,[Corridor]
,[DoorAno]
,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50]
src/Dodge/Layout.hs
+2 -2
View File
@@ -50,7 +50,7 @@ generateLevelFromRoomList gr w
, _floorTiles = floorsFromRooms rs
, _gameRooms = gameRoomsFromRooms rs
, _pathGraph = path
, _pathGraph' = pairPath
, _pathGraphP = pairPath
}
where
path = pairsToGraph dist pairPath
@@ -87,7 +87,7 @@ generateFromTree :: State StdGen (Tree Room) -> World -> World
generateFromTree t w = updateWallZoning $ placeSpots plmnts
$ w {_walls = wallsFromTree tr
,_pathGraph = path
,_pathGraph' = pairGraph
,_pathGraphP = pairGraph
,_pathPoints = foldl' (flip insertPoint) IM.empty (labNodes path)
}
where
src/Dodge/LevelGen/Pathing.hs
+2 -2
View File
@@ -19,10 +19,10 @@ pairsToGraph f pairs =
in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM nodes' >> insMapEdgesM pairs'
removePathsCrossing :: Point2 -> Point2 -> World -> World
removePathsCrossing a b w = set pathGraph newGraph $ set pathGraph' pg'
removePathsCrossing a b w = set pathGraph newGraph $ set pathGraphP pg'
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
w
where
pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraph' w
pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
newGraph = pairsToGraph dist pg'
src/Dodge/LevelGen/TriggerDoor.hs
+7 -7
View File
@@ -29,17 +29,17 @@ addButtonDoor c btp btr a b speed w
= over buttons (IM.insert bid bt)
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
$ set pathGraph newGraph
$ set pathGraph' newGraphPairs
$ set pathGraphP newGraphPairs
$ putDoubleDoor c cond a b speed w
where
bid = IM.newKey $ _buttons w
cond w' = BtNoLabel == _btState (_buttons w' IM.! bid)
bt = (makeButton c eff) {_btPos = btp, _btRot = btr, _btID = bid}
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b))
$ _pathGraph' w
$ _pathGraphP w
newGraph = pairsToGraph dist newGraphPairs
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
eff w' = over pathGraph' (removedPairs ++)
eff w' = over pathGraphP (removedPairs ++)
. over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
f (x,y) = (x,y,dist x y)
-- this has been repeated at least three times: TO BE UNIFIED, REFACTORED
@@ -47,20 +47,20 @@ addSwitchDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World
addSwitchDoor c btp btr a b speed w = over buttons (IM.insert bid bt)
$ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
$ set pathGraph newGraph
$ set pathGraph' newGraphPairs
$ set pathGraphP newGraphPairs
$ putDoubleDoor c cond a b speed w
where
bid = IM.newKey $ _buttons w
cond w' = BtOn == _btState (_buttons w' IM.! bid)
bt = (makeSwitch c openDoor closeDoor) {_btPos = btp, _btRot = btr, _btID = bid}
(newGraphPairs,removedPairs) = partition (isNothing . uncurry (intersectSegSeg a b))
$ _pathGraph' w
$ _pathGraphP w
newGraph = pairsToGraph dist newGraphPairs
insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
openDoor w' = over pathGraph' (removedPairs ++)
openDoor w' = over pathGraphP (removedPairs ++)
. over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
f (x,y) = (x,y,dist x y)
closeDoor w' = over pathGraph' (\\ removedPairs)
closeDoor w' = over pathGraphP (\\ removedPairs)
. over pathGraph (flip run_ $ delMapEdgesM removedPairs) $ w'
putDoor
src/Dodge/Menu.hs
+1
View File
@@ -145,6 +145,7 @@ startNewGame w = Just $ w
aNewGame = updateFramebufferSize $ generateLevelFromRoomList levx $ initialWorld
& randGen .~ _randGen w
& config .~ _config w
& preloadData .~ _preloadData w
-- | hacky
scodeToChar :: Scancode -> Char
src/Dodge/Update.hs
+1 -1
View File
@@ -270,7 +270,7 @@ rotateToOverlappingWall w = case theWall of
| otherwise = w
where
b = a * (2 / pi)
b' = fromIntegral $ (round b :: Int)
b' = fromIntegral (round b :: Int)
cr = you w
p = _crPos cr
theWall = overlapCircWallsReturnWall p (_crRad cr + 5) (wallsNearPoint p w)
src/Sound.hs
+1 -1
View File
@@ -83,7 +83,7 @@ tryPlay sd s = do
i <- tryGetChannel s
_ <- liftIO $ do
Mix.halt i
Mix.playOn i Mix.Once (sd IM.! (_getSoundID $ _soundChunkID s))
Mix.playOn i Mix.Once (sd IM.! _getSoundID (_soundChunkID s))
return $ s
& soundChannel ?~ i
& soundStatus .~ JustStartedPlaying