Add quicksave

src/Dodge/Base.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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