From 763b77192899898275d0b48c25d12dcde112f7d6 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 6 Dec 2021 23:44:10 +0000 Subject: [PATCH] Cleanup, fix menu lock on restarting level after game over --- src/Dodge/Combine.hs | 7 ++-- src/Dodge/Creature/Inanimate.hs | 2 +- src/Dodge/Creature/YourControl.hs | 2 +- src/Dodge/Data.hs | 5 --- src/Dodge/Default/World.hs | 1 - src/Dodge/Event.hs | 2 +- src/Dodge/Item/Random.hs | 2 +- src/Dodge/Item/Weapon/BulletGun/Cane.hs | 11 +++--- src/Dodge/LightSource.hs | 7 +++- src/Dodge/Menu.hs | 31 ++++++++------- src/Dodge/Particle/Spark.hs | 24 +++++++++++- src/Dodge/Room/Start.hs | 14 +++---- src/Dodge/Save.hs | 7 ++-- src/Dodge/Update.hs | 30 +++++++-------- src/Dodge/World.hs | 3 +- src/Dodge/WorldEvent.hs | 51 +------------------------ src/Dodge/WorldEvent/Flash.hs | 6 +-- src/SimpleTrie.hs | 2 +- 18 files changed, 88 insertions(+), 119 deletions(-) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index d8f6e6ad0..1a6b95965 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -23,8 +23,9 @@ import Data.Maybe import Data.List (scanl',sortOn) combinationsTrie :: Trie (Int,CombineType) Item -combinationsTrie = foldr (uncurry insertInTrie) emptyTrie - $ map (first (sortOn snd)) itemCombinations +combinationsTrie = foldr (uncurry insertInTrie . first (sortOn snd)) + emptyTrie + itemCombinations -- this can probably be improved by going through accessing the combinations -- trie going through each combine type in your inventory in order, rather than @@ -34,7 +35,7 @@ lookupItems' :: [(CombineType,Int,Int)] -> [ ([Int],Item) ] lookupItems' xs = lookupItems (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie lookupItems :: [(CombineType,Int,Int)] -> Trie (Int,CombineType) Item -> [ ([Int],Item) ] -lookupItems [] t = maybeToList $ fmap ([],) $ _trieMVal t +lookupItems [] t = maybeToList $ ([],) <$> _trieMVal t lookupItems ((ct,i,n):xs) t = do n' <- [1..min n 4] let is = replicate n' i diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 5b021fda4..7e1f82283 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -13,6 +13,7 @@ import Dodge.WorldEvent.Explosion import Dodge.Creature.Picture --import Dodge.Creature.Stance.Data import Dodge.Picture.Layer +import Dodge.Particle.Spark import Dodge.Default import Dodge.Creature.State import Dodge.LightSource @@ -26,7 +27,6 @@ import Geometry --import Geometry.Vector3D import Polyhedra import Shape -import Dodge.WorldEvent import Dodge.SoundLogic import System.Random diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 4f68c0df6..e0cf67f76 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -34,7 +34,7 @@ wasdWithAiming wasdWithAiming w speed i cr | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr - | (isReloading && SDL.ButtonRight `S.member` _mouseButtons w) + | isReloading && SDL.ButtonRight `S.member` _mouseButtons w = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr | otherwise = theMovement $ theTurn $ removeTwist cr where diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bb41ec1ba..7ec9d6c6e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -105,7 +105,6 @@ data World = World , _pathGraph :: ~(Gr Point2 Float) , _pathGraphP :: ~[(Point2,Point2)] , _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)])) - , _worldFlags :: S.Set WorldFlag , _carteDisplay :: !Bool , _carteCenter :: !Point2 , _carteZoom :: !Float @@ -273,10 +272,6 @@ data CrMvType , _mvTurnJit :: Float , _mvAimSpeed :: Float -> Float } -data WorldFlag - = ResetLevel Int - | GameOver - deriving (Eq,Ord) data Button = Button { _btPict :: Button -> SPic , _btPos :: Point2 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 4f6763a57..56ddd32e7 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -57,7 +57,6 @@ defaultWorld = World , _decorations = IM.empty --, _savedWorlds = M.empty -- , _menuLayers = [] - , _worldFlags = S.empty , _clickMousePos = V2 0 0 , _pathGraph = Data.Graph.Inductive.Graph.empty , _pathGraphP = [] diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 60e31c851..2b0684092 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -128,7 +128,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of (_, TopInventory) -- functions that modify the inventory should be centralised so that -- this lock can be sensibly applied, perhaps - | _crInvLock (_creatures w IM.! (_yourID w)) -> w + | _crInvLock (_creatures w IM.! _yourID w) -> w | rbDown -> case yourItem w ^? _Just . itScroll of Nothing -> closeObjScrollDir y w Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w) diff --git a/src/Dodge/Item/Random.hs b/src/Dodge/Item/Random.hs index b06dd97f8..16b2e64ff 100644 --- a/src/Dodge/Item/Random.hs +++ b/src/Dodge/Item/Random.hs @@ -7,4 +7,4 @@ import Control.Monad.State import System.Random randBlockBreakWeapon :: RandomGen g => State g Item -randBlockBreakWeapon = takeOne [pistol,ltAutoGun,spreadGun,autoGun] +randBlockBreakWeapon = takeOne [bangStick 1,bangCane] diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index 2a7212850..0250433cf 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -102,9 +102,9 @@ bangCaneX i = bangCane ,_muzPos = 15 } , _dimSPic = \it -> noPic $ - (colorSH red $ foldMap - (\y -> upperPrismPoly 3 $ map (+.+ V2 0 y) $ rectXH 15 2) - $ map (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5)) [0..i-1] + colorSH red (foldMap + ((\y -> upperPrismPoly 3 $ map (+.+ V2 0 y) $ rectXH 15 2) + . (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))) [0..i-1] ) <> caneClipX i it } } & itUse . useAim . aimSpeed .~ 0.4 @@ -124,8 +124,9 @@ caneStickSoundChoice it caneClipX :: Int -> Item -> Shape caneClipX i it = case it ^? itConsumption . ammoLoaded of Just la | la > 0 -> foldMap - (\y -> translateSH (V3 5 0 3) . upperPrismPoly 1 $ map (+.+ V2 0 y) $ square 1.5) - $ map (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5)) [0..la-1] + ( (\y -> translateSH (V3 5 0 3) . upperPrismPoly 1 $ map (+.+ V2 0 y) $ square 1.5) + . (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))) + [0..la-1] _ -> mempty diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index 52b22a1bb..44aaf0cbd 100644 --- a/src/Dodge/LightSource.hs +++ b/src/Dodge/LightSource.hs @@ -9,13 +9,13 @@ module Dodge.LightSource , lsPosCol , lsPosRad , lsColPosID + , makeTlsTimeRadColPos ) where import Dodge.Data import Geometry.Data import Dodge.Default - -import Control.Lens +import LensHelp lsPosRad :: Point3 -> Float -> LightSource lsPosRad = lsColPosRad 0.75 @@ -83,3 +83,6 @@ tlsTimeRadColPos t rmax col (V3 x y z) = TLS | _tlsTime tls <= 0 = Nothing | otherwise = Just $ tls & tlsTime -~ 1 + +makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World +makeTlsTimeRadColPos i rad (V3 r g b) p = tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index b1d8cecfd..a26f09bea 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -4,8 +4,7 @@ module Dodge.Menu , pushScreen , pauseMenu , gameOverMenu - ) - where + ) where import LensHelp import Dodge.Menu.OptionType import Dodge.Menu.PushPop @@ -22,8 +21,8 @@ import Dodge.LevelGen --import Control.Lens import System.Random -slTitleOptions :: String -> [MenuOption] -> ScreenLayer -slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig) +pauseMenu :: ScreenLayer +pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer slTitleOptionsEff title ops eff = OptionScreen @@ -33,6 +32,18 @@ slTitleOptionsEff title ops eff = OptionScreen , _scOptionFlag = NormalOptions } +pauseMenuOptions :: [MenuOption] +pauseMenuOptions = + [ Toggle ScancodeN (return . startNewGame) (const "NEW LEVEL") + , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (const "RESTART") + , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") + , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") + , InvisibleToggle ScancodeEscape (return . const Nothing) + ] + +slTitleOptions :: String -> [MenuOption] -> ScreenLayer +slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig) + optionMenu :: ScreenLayer optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen @@ -69,7 +80,6 @@ gameplayMenuOptions = , makeBoolOption ScancodeS show_sound "SHOW VISUAL SOUNDS" ] - soundMenu :: ScreenLayer soundMenu = slTitleOptions "OPTIONS:VOLUME" @@ -114,17 +124,6 @@ gameOverMenu = OptionScreen , _scOptionFlag = GameOverOptions } -pauseMenu :: ScreenLayer -pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause) - -pauseMenuOptions :: [MenuOption] -pauseMenuOptions = - [ Toggle ScancodeN (return . startNewGame) (const "NEW LEVEL") - , Toggle ScancodeR (return . Just . loadSaveSlot LevelStartSlot) (const "RESTART") - , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") - , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") - , InvisibleToggle ScancodeEscape (return . const Nothing) - ] startNewGame :: Universe -> Maybe Universe startNewGame w = Just $ w & menuLayers .~ [WaitScreen (const "GENERATING...") 1] diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Particle/Spark.hs index 67495cd65..9e55e6da6 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/src/Dodge/Particle/Spark.hs @@ -1,6 +1,7 @@ module Dodge.Particle.Spark ( colSpark , colSpark' + , createBarrelSpark ) where import Dodge.Data @@ -9,10 +10,31 @@ import Dodge.Particle.Bullet.Update import Dodge.WorldEvent.HitEffect import Color import Geometry +import LensHelp import System.Random -import Control.Lens +--import Control.Lens +createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> World +createBarrelSpark pos dir maycid time colid w = w + & instantParticles .:~ spark + where + spark = BulletPt + { _ptDraw = drawBul + , _ptUpdate = mvBullet + , _btVel' = rotateV dir (V2 5 0) + , _btDrag = 0.9 + , _btColor' = numColor colid + , _btTrail' = [pos] + , _btPassThrough' = maycid + , _btWidth' = 1 + , _btTimer' = time + , _btHitEffect' = destroyOnImpact sparkEff noEff + } + sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep + where + sp = head (_btTrail' bt) + ep = sp +.+ _btVel' bt colSpark :: Int -> Color -> Point2 -> Float -> World -> World colSpark = colSpark' 0.7 colSpark' :: Float -> Int -> Color -> Point2 -> Float -> World -> World diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 1cad717bd..5d23ec40f 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -65,13 +65,13 @@ room2 :: RandomGen g => Int -> State g (SubCompTree Room) room2 = lasCenSensEdge startRoom :: RandomGen g => Int -> State g (SubCompTree Room) -startRoom _ = join $ uncurry takeOneWeighted $ unzip - [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom] --- , (,) 1 rezBoxesWp --- , (,) 1 rezBoxesThenWeaponRoom --- , (,) 1 rezBoxThenWeaponRoom --- , (,) 1 rezBoxesWpCrit --- , (,) 1 $ runPastStart i +startRoom i = join $ uncurry takeOneWeighted $ unzip +-- [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom] + [ (,) (1::Float) rezBoxesWp + , (,) 1 rezBoxesThenWeaponRoom + , (,) 1 rezBoxThenWeaponRoom + , (,) 1 rezBoxesWpCrit + , (,) 1 $ runPastStart i ] runPastStart :: RandomGen g => Int -> State g (SubCompTree Room) diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index ccf81ce36..58b97b832 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -2,8 +2,7 @@ module Dodge.Save ( saveWorldInEmptySlot , loadSaveSlot , doQuicksave - ) - where + ) where import Dodge.Data import qualified Data.Map.Strict as M @@ -20,7 +19,9 @@ saveWorldInSlot :: SaveSlot -> Universe -> Universe saveWorldInSlot slot w = w & savedWorlds %~ M.insert slot (clearKeys (_uvWorld w)) loadSaveSlot :: SaveSlot -> Universe -> Universe -loadSaveSlot slot u = maybe u (\w -> u & uvWorld .~ w) $ M.lookup slot (_savedWorlds u) +loadSaveSlot slot u = maybe u + (\w -> u & menuLayers .~ [] & uvWorld .~ w) + $ M.lookup slot (_savedWorlds u) doQuicksave :: Universe -> Universe doQuicksave = saveWorldInSlot QuicksaveSlot diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d10cae319..3d240c87f 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,6 +6,7 @@ module Dodge.Update ( updateUniverse ) where import Dodge.Data +import Dodge.Menu import Dodge.Hammer import Dodge.Block import Dodge.Distortion @@ -24,27 +25,26 @@ import Data.Maybe import Data.Function import qualified Data.IntMap.Strict as IM import qualified Data.Map.Strict as M +--import qualified Data.Set as S import Control.Lens import Data.Monoid import System.Random +{- For most menus the only way to change the world is using event handling. -} updateUniverse :: Universe -> Universe -updateUniverse w = case _menuLayers w of --- (TerminalScreen t xs:mls) -> w & menuLayers .~ (TerminalScreen (max (t-1) 0) xs:mls) +updateUniverse u = case _menuLayers u of (WaitScreen s i : _) - | i < 1 -> w & over uvWorld (dbArg _worldEvents) - | otherwise -> w & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) - (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> - -- updateParticles - -- . updateProjectiles - -- . updateLightSources - -- $ updateClouds - w - (_ : _) -> w - [] -> over uvWorld (functionalUpdate (_config w)) w + | i < 1 -> u & over uvWorld (dbArg _worldEvents) + | otherwise -> u & menuLayers %~ ( (WaitScreen s (i-1) :) . tail ) + (OptionScreen {_scOptionFlag = GameOverOptions} : _) -> u & uvWorld %~ + ( updateParticles + . updateProjectiles + . updateLightSources + . updateClouds ) + (_ : _) -> u + [] -> over uvWorld (functionalUpdate (_config u)) u -{- | The update step. -For most menus the only way to change the world is using event handling. -} +{- | The update step. -} functionalUpdate :: Configuration -> World -> World functionalUpdate cfig w = checkEndGame . (worldClock +~ 1) @@ -176,7 +176,7 @@ markWallSeen w wl = w { _walls = IM.adjust mw (_wlID wl) $ _walls w } checkEndGame :: World -> World checkEndGame w - | _crHP (you w) < 1 = undefined -- haltSound $ w {_menuLayers = [gameOverMenu]} + | _crHP (you w) < 1 = w & sideEffects %~ ( . (menuLayers .~ [gameOverMenu])) | otherwise = w updateClouds :: World -> World diff --git a/src/Dodge/World.hs b/src/Dodge/World.hs index 6a8e5a4f0..7474f5a41 100644 --- a/src/Dodge/World.hs +++ b/src/Dodge/World.hs @@ -2,5 +2,4 @@ Placeholder... not sure of its purpose, but might deal with pure world change functions. The world datatype itself is very intertwined with the creature, weapon, etc datatypes. -} -module Dodge.World - where +module Dodge.World where diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 6dd381dd2..5cac16816 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -1,61 +1,14 @@ module Dodge.WorldEvent - ( module Dodge.WorldEvent - , module Dodge.WorldEvent.Flash + ( module Dodge.WorldEvent.Flash , module Dodge.WorldEvent.ThingsHit , module Dodge.WorldEvent.Cloud , module Dodge.WorldEvent.HitEffect , module Dodge.WorldEvent.Explosion , module Dodge.WorldEvent.SpawnParticle - ) - where -import Dodge.Particle.Bullet.Draw -import Dodge.Particle.Bullet.Update + ) where import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.SpawnParticle -import Dodge.LightSource -import Dodge.Creature.State.Data -import Dodge.Data -import Geometry -import Color -import LensHelp - ---import Control.Lens -import System.Random -import qualified Data.IntMap.Strict as IM - -createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> World -createBarrelSpark pos dir maycid time colid w = w - & worldEvents %~ (( over particles (spark :) . sparkFlashAt pos') . ) - where - spark = BulletPt - { _ptDraw = drawBul - , _ptUpdate = mvBullet - , _btVel' = rotateV dir (V2 5 0) - , _btDrag = 0.9 - , _btColor' = numColor colid - , _btTrail' = [pos] - , _btPassThrough' = maycid - , _btWidth' = 1 - , _btTimer' = time - , _btHitEffect' = destroyOnImpact sparkEff noEff - } - x = fst $ randomR (0,20) $ _randGen w - pos' = pos +.+ rotateV dir (V2 x 0) - sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep - where - sp = head (_btTrail' bt) - ep = sp +.+ _btVel' bt - -damCrsOnLine :: Int -> Point2 -> Point2 -> World -> World -damCrsOnLine dam p1 p2 = creatures %~ IM.map damIfOnLine - where - damIfOnLine cr - | circOnSeg p1 p2 (_crPos cr) (_crRad cr) = cr & crHP -~ dam - | otherwise = cr - -makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World -makeTlsTimeRadColPos i rad (V3 r g b) p = tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 37ee6011d..847ac7c1e 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -9,8 +9,7 @@ glow : continuous, potentially long, fading, slow changes in alpha flicker : potentially long, moving, abrupt changes in alpha -} module Dodge.WorldEvent.Flash - ( sparkFlashAt - , explosionFlashAt + ( explosionFlashAt , laserGunFlashAt , teslaGunFlashAt , muzFlareAt @@ -64,9 +63,6 @@ explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc | x < 10 = 1 / (10 - fromIntegral x) | otherwise = 1 -sparkFlashAt :: Point2 -> World -> World -sparkFlashAt _ = id - flameFlicker :: Particle -> World -> World flameFlicker pt | _btTimer' pt `mod` 5 == 0 = tempLightSources .:~ theLight diff --git a/src/SimpleTrie.hs b/src/SimpleTrie.hs index d322b2eea..b8176707f 100644 --- a/src/SimpleTrie.hs +++ b/src/SimpleTrie.hs @@ -16,7 +16,7 @@ singletonTrie (k:ks) x = Trie Nothing $ singleton k $ singletonTrie ks x singletonTrie [] x = Trie (Just x) empty insertInTrie :: Ord a => [a] -> b -> Trie a b -> Trie a b -insertInTrie [] x = trieMVal .~ Just x +insertInTrie [] x = trieMVal ?~ x insertInTrie (k:ks) x = trieChildren %~ insertWith f k (singletonTrie ks x) where f _ = insertInTrie ks x