Rethink item ammo to item consumables, start item type datatype
This commit is contained in:
+38
-69
@@ -6,6 +6,9 @@ module Dodge.Menu
|
||||
, gameOverMenu
|
||||
)
|
||||
where
|
||||
import LensHelp
|
||||
import Dodge.Menu.OptionType
|
||||
import Dodge.Menu.PushPop
|
||||
import Dodge.Data
|
||||
import Dodge.PreloadData
|
||||
import Dodge.Save
|
||||
@@ -16,12 +19,14 @@ import SDL.Internal.Numbered
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.LevelGen
|
||||
|
||||
import Control.Lens
|
||||
--import Control.Lens
|
||||
import System.Random
|
||||
|
||||
titleOptions title ops = titleOptionsEff title ops (return . popScreen . writeConfig)
|
||||
slTitleOptions :: String -> [MenuOption] -> ScreenLayer
|
||||
slTitleOptions title ops = slTitleOptionsEff title ops (popScreen . writeConfig)
|
||||
|
||||
titleOptionsEff title ops eff = OptionScreen
|
||||
slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer
|
||||
slTitleOptionsEff title ops eff = OptionScreen
|
||||
{ _scTitle = const title
|
||||
, _scOptions = ops
|
||||
, _scDefaultEff = eff
|
||||
@@ -29,19 +34,17 @@ titleOptionsEff title ops eff = OptionScreen
|
||||
}
|
||||
|
||||
optionMenu :: ScreenLayer
|
||||
optionMenu = titleOptionsEff "OPTIONS" optionsOptions (return . popScreen)
|
||||
optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
|
||||
|
||||
optionsOptions :: [MenuOption]
|
||||
optionsOptions =
|
||||
[ anOption ScancodeV soundMenu "VOLUME"
|
||||
, anOption ScancodeG graphicsMenu "GRAPHICS"
|
||||
, anOption ScancodeP gameplayMenu "GAMEPLAY"
|
||||
, anOption ScancodeD debugMenu "DEBUG OPTIONS"
|
||||
[ makeSubmenuOption ScancodeV soundMenu "VOLUME"
|
||||
, makeSubmenuOption ScancodeG graphicsMenu "GRAPHICS"
|
||||
, makeSubmenuOption ScancodeP gameplayMenu "GAMEPLAY"
|
||||
, makeSubmenuOption ScancodeD debugMenu "DEBUG OPTIONS"
|
||||
]
|
||||
where
|
||||
anOption scode submenu t = Toggle scode (pushScreen submenu) (const t)
|
||||
debugMenu :: ScreenLayer
|
||||
debugMenu = titleOptions
|
||||
debugMenu = slTitleOptions
|
||||
"OPTIONS:GAMEPLAY"
|
||||
debugMenuOptions
|
||||
debugMenuOptions :: [MenuOption]
|
||||
@@ -54,77 +57,54 @@ debugMenuOptions =
|
||||
]
|
||||
where
|
||||
doption scode l t rec
|
||||
= Toggle scode (Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w))
|
||||
= Toggle scode (return . Just . (config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config w))
|
||||
gameplayMenu :: ScreenLayer
|
||||
gameplayMenu = titleOptions
|
||||
gameplayMenu = slTitleOptions
|
||||
"OPTIONS:GAMEPLAY"
|
||||
gameplayMenuOptions
|
||||
|
||||
gameplayMenuOptions :: [MenuOption]
|
||||
gameplayMenuOptions =
|
||||
[ option ScancodeR rotate_to_wall "ROTATE TO WALL" _rotate_to_wall
|
||||
, option ScancodeS show_sound "SHOW VISUAL SOUNDS" _show_sound
|
||||
[ makeBoolOption ScancodeR rotate_to_wall "ROTATE TO WALL"
|
||||
, makeBoolOption ScancodeS show_sound "SHOW VISUAL SOUNDS"
|
||||
]
|
||||
where
|
||||
option scode l t rec = Toggle scode (Just . (config . l %~ not))
|
||||
(\w -> t ++ ":" ++ show (rec $ _config w))
|
||||
|
||||
|
||||
soundMenu :: ScreenLayer
|
||||
soundMenu = titleOptions
|
||||
soundMenu = slTitleOptions
|
||||
"OPTIONS:VOLUME"
|
||||
soundMenuOptions
|
||||
|
||||
soundMenuOptions :: [MenuOption]
|
||||
soundMenuOptions =
|
||||
[ Toggle2 ScancodeY (master dec . sw)
|
||||
ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol w)
|
||||
, Toggle2 ScancodeH (soundEffs dec . sw)
|
||||
ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol w)
|
||||
, Toggle2 ScancodeN (music dec . sw)
|
||||
ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol w)
|
||||
[ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME:" _volume_master
|
||||
, theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME:" _volume_sound
|
||||
, theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME:" _volume_music
|
||||
]
|
||||
where
|
||||
theoption scod1 stype scod2 str voltype = Toggle2
|
||||
scod1
|
||||
(change dec stype)
|
||||
scod2
|
||||
(change inc stype)
|
||||
(\w -> str ++ show (round $ 10 * voltype (_config w)::Int))
|
||||
change g vt = return . Just . (config . vt %~ g) . sw
|
||||
dec x = max 0 (x - 0.1)
|
||||
inc x = min 1 (x + 0.1)
|
||||
sw w = w & uvWorld . sideEffects %~ setVolThen (_config w)
|
||||
master g = Just . (config . volume_master %~ g)
|
||||
soundEffs g = Just . (config . volume_sound %~ g)
|
||||
music g = Just . (config . volume_music %~ g)
|
||||
cfig w = _config w
|
||||
mavol w = f $ _volume_master $ cfig w
|
||||
snvol w = f $ _volume_sound $ cfig w
|
||||
muvol w = f $ _volume_music $ cfig w
|
||||
f x = show (round $ 10 * x :: Int)
|
||||
|
||||
pushScreen :: ScreenLayer -> Universe -> Maybe Universe
|
||||
pushScreen ml w = Just $ w & menuLayers %~ (ml :)
|
||||
|
||||
popScreen :: Universe -> Maybe Universe
|
||||
popScreen = Just . (menuLayers %~ tail)
|
||||
|
||||
writeConfig :: Universe -> Universe
|
||||
writeConfig w = w & uvWorld . sideEffects %~ saveConfig (_config w)
|
||||
|
||||
graphicsMenu :: ScreenLayer
|
||||
graphicsMenu = titleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
|
||||
graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
|
||||
|
||||
graphicsMenuOptions :: [MenuOption]
|
||||
graphicsMenuOptions =
|
||||
[ Toggle ScancodeW (Just . (config . wall_textured %~ not)) wtextstring
|
||||
, Toggle ScancodeS upf resostring
|
||||
, Toggle ScancodeD (Just . (config . cloud_shadows %~ not)) cshadstring
|
||||
[ makeEnumOption ScancodeS resolution_factor "RESOLUTION" updateFramebufferSize
|
||||
, makeBoolOption ScancodeW wall_textured "WALL TEXTURES"
|
||||
, makeBoolOption ScancodeD cloud_shadows "CLOUD SHADOWS"
|
||||
]
|
||||
where
|
||||
wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config w)
|
||||
resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config w)
|
||||
upf w = Just $ updateFramebufferSize $ w & config . resolution_factor %~ cycleResolution
|
||||
cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config w)
|
||||
|
||||
cycleResolution :: (Eq a, Num a, Num p) => a -> p
|
||||
cycleResolution 1 = 2
|
||||
cycleResolution 2 = 4
|
||||
cycleResolution 4 = 1
|
||||
cycleResolution _ = 1
|
||||
|
||||
gameOverMenu :: ScreenLayer
|
||||
gameOverMenu = OptionScreen
|
||||
@@ -135,15 +115,15 @@ gameOverMenu = OptionScreen
|
||||
}
|
||||
|
||||
pauseMenu :: ScreenLayer
|
||||
pauseMenu = titleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
|
||||
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
|
||||
|
||||
pauseMenuOptions :: [MenuOption]
|
||||
pauseMenuOptions =
|
||||
[ Toggle ScancodeN startNewGame (const "NEW LEVEL")
|
||||
, Toggle ScancodeR (Just . loadSaveSlot LevelStartSlot) (const "RESTART")
|
||||
[ 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 (const Nothing)
|
||||
, InvisibleToggle ScancodeEscape (return . const Nothing)
|
||||
]
|
||||
startNewGame :: Universe -> Maybe Universe
|
||||
startNewGame w = Just $ w
|
||||
@@ -154,10 +134,6 @@ startNewGame w = Just $ w
|
||||
where
|
||||
i = fst $ random (_randGen (_uvWorld w))
|
||||
|
||||
--uvWorldSideEffects :: Int -> Universe -> b -> IO Universe
|
||||
--uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w)
|
||||
|
||||
|
||||
-- | hacky
|
||||
scodeToChar :: Scancode -> Char
|
||||
scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
|
||||
@@ -165,13 +141,6 @@ scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
|
||||
--charToScode :: Char -> Scancode
|
||||
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
|
||||
|
||||
updateFramebufferSize :: Universe -> Universe
|
||||
updateFramebufferSize u = u & uvWorld . sideEffects %~ sideEffectUpdatePreload divRes x y
|
||||
where
|
||||
(x,y) = (round $ _windowX cfig, round $ _windowY cfig)
|
||||
cfig = _config u
|
||||
divRes = u ^. config . resolution_factor
|
||||
|
||||
--levelMenu :: Int -> ScreenLayer
|
||||
--levelMenu x = OptionScreen
|
||||
-- { _scTitle = const $ "LEVEL "++ show x
|
||||
|
||||
Reference in New Issue
Block a user