diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index aaaf00603..2b6b925b5 100644 --- a/src/Dodge/Base.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 7f079c5ff..1c38d78b8 100644 --- a/src/Dodge/Data.hs +++ 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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 8de01af6b..342d1f047 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 292df9a26..7544fa21f 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 504d5366e..23d758f66 100644 --- a/src/Dodge/Floor.hs +++ b/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] diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index c97aaa536..6c2f0e647 100644 --- a/src/Dodge/Layout.hs +++ b/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 diff --git a/src/Dodge/LevelGen/Pathing.hs b/src/Dodge/LevelGen/Pathing.hs index dbc355559..7517118ea 100644 --- a/src/Dodge/LevelGen/Pathing.hs +++ b/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' diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs index 6d0614d5c..fc71c89e9 100644 --- a/src/Dodge/LevelGen/TriggerDoor.hs +++ b/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 diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 20ab12586..12899e3d7 100644 --- a/src/Dodge/Menu.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index bd913c64d..1c467e939 100644 --- a/src/Dodge/Update.hs +++ b/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) diff --git a/src/Sound.hs b/src/Sound.hs index 06c747aff..33720279c 100644 --- a/src/Sound.hs +++ b/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