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

Cleanup

Browse Source
This commit is contained in:
justin
2022-07-27 12:49:23 +01:00
parent 6554d219dc
commit 8d17ce66e9
106 changed files with 2911 additions and 2678 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Menu.hs
+127 -106
View File
@@ -1,66 +1,72 @@
module Dodge.Menu
( scodeToChar
, pauseMenu
, gameOverMenu
) where
import Dodge.Config.Data
import LensHelp
import Dodge.Menu.OptionType
import Dodge.StartNewGame
import Dodge.Menu.PushPop
module Dodge.Menu (
scodeToChar,
pauseMenu,
gameOverMenu,
) where
import Dodge.Config.Update
import Dodge.Data
import Dodge.Menu.OptionType
import Dodge.Menu.PushPop
import Dodge.PreloadData
import Dodge.Save
import Dodge.Config.Update
import Padding
--import SDL.Internal.Numbered
--import Preload.Update
import Dodge.SoundLogic
import Dodge.StartNewGame
import LensHelp
import Padding
--import Dodge.LevelGen
import Text.Read
import SDL
import System.Clipboard
import Text.Read
--import Control.Lens
--import System.Random
slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer
slTitleOptionsEff title ops eff = OptionScreen
{ _scTitle = const title
, _scOptions = ops
, _scDefaultEff = eff
, _scOptionFlag = NormalOptions
, _scOptionsOffset = 0
}
slTitleOptionsEff title ops eff =
OptionScreen
{ _scTitle = const title
, _scOptions = ops
, _scDefaultEff = eff
, _scOptionFlag = NormalOptions
, _scOptionsOffset = 0
}
pauseMenu :: ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
pauseMenuOptions :: [MenuOption]
pauseMenuOptions = basicKeyOptions
[ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
, Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
, Toggle (pushScreen optionMenu ) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "CONTROLS")
]
++
[ InvisibleToggle ScancodeEscape (return . const Nothing)
]
pauseMenuOptions =
basicKeyOptions
[ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
, Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
, Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
, Toggle (pushScreen optionMenu) (opText "OPTIONS")
, Toggle (pushScreen displayControls) (opText "CONTROLS")
]
++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
]
where
opText = const . Left
seedStartMenu :: String -> ScreenLayer
seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
[ Toggle trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") ScancodeA
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
]
trySeedFromClipboard :: Universe -> IO (Maybe Universe)
trySeedFromClipboard u = do
mcstr <- getClipboardString
case mcstr >>= readMaybe of
Nothing -> pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
(u & menuLayers %~ tail)
Nothing ->
pushScreen
(seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
(u & menuLayers %~ tail)
Just i -> return . Just $ startSeedGame i u
slTitleOptions :: String -> [MenuOption] -> ScreenLayer
@@ -70,70 +76,84 @@ optionMenu :: ScreenLayer
optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
optionsOptions :: [MenuOption]
optionsOptions = basicKeyOptions
[ makeSubmenuOption soundMenu $ Left "VOLUME"
, makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
, makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
, makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
]
optionsOptions =
basicKeyOptions
[ makeSubmenuOption soundMenu $ Left "VOLUME"
, makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
, makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
, makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
]
debugMenu :: ScreenLayer
debugMenu = slTitleOptions
"OPTIONS:GAMEPLAY"
debugMenuOptions
debugMenu =
slTitleOptions
"OPTIONS:GAMEPLAY"
debugMenuOptions
debugMenuOptions :: [MenuOption]
debugMenuOptions = zipWith ($)
(map f [minBound..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return] )
$ map Scancode [4..]
debugMenuOptions =
zipWith
($)
(map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return])
$ map Scancode [4 ..]
where
f :: DebugBool -> Scancode -> MenuOption
f bd = Toggle (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? uvConfig . debug_booleans . ix bd))
f bd =
Toggle
(return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
(Right . g bd . (^? uvConfig . debug_booleans . ix bd))
g bd Nothing = (show bd, "False")
g bd _ = (show bd, "True")
g bd _ = (show bd, "True")
-- zipWith ($)
-- [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME"
-- , makeBoolOption debug_noclip "NOCLIP"
-- , makeBoolOption debug_cr_status "SHOW CREATURE STATUS"
-- , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS"
-- , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES"
-- , makeBoolOption debug_pathing "SHOW PATHING"
-- , makeBoolOption debug_show_sound "SHOW VISUAL SOUNDS"
-- , makeBoolOption debug_mouse_position "SHOW MOUSE POSITION"
-- [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME"
-- , makeBoolOption debug_noclip "NOCLIP"
-- , makeBoolOption debug_cr_status "SHOW CREATURE STATUS"
-- , makeBoolOption debug_cr_awareness "SHOW CREATURE AWARENESS"
-- , makeBoolOption debug_view_boundaries "SHOW VIEW BOUNDARIES"
-- , makeBoolOption debug_pathing "SHOW PATHING"
-- , makeBoolOption debug_show_sound "SHOW VISUAL SOUNDS"
-- , makeBoolOption debug_mouse_position "SHOW MOUSE POSITION"
-- , makeBoolOption debug_walls "SHOW WALL INFO"
-- , makeBoolOption debug_remove_LOS "REMOVE LOS"
-- , makeBoolOption debug_cull_more_lights "CULL MORE LIGHTS"
-- ]
-- $ map Scancode [4 ..]
gameplayMenu :: ScreenLayer
gameplayMenu = slTitleOptions
"OPTIONS:GAMEPLAY"
gameplayMenuOptions
gameplayMenu =
slTitleOptions
"OPTIONS:GAMEPLAY"
gameplayMenuOptions
gameplayMenuOptions :: [MenuOption]
gameplayMenuOptions = basicKeyOptions
[ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
]
gameplayMenuOptions =
basicKeyOptions
[ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
]
basicKeyOptions :: [Scancode -> c] -> [c]
basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 .. ]
basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 ..]
soundMenu :: ScreenLayer
soundMenu = slTitleOptions
"OPTIONS:VOLUME"
soundMenuOptions
soundMenu =
slTitleOptions
"OPTIONS:VOLUME"
soundMenuOptions
soundMenuOptions :: [MenuOption]
soundMenuOptions =
[ 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
[ 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 -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w)::Int)))
theoption scod1 stype scod2 str voltype =
Toggle2
scod1
(change dec stype)
scod2
(change inc stype)
(\w -> Right (str, leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g)
dec x = max 0 (x - 0.1)
inc x = min 1 (x + 0.1)
@@ -146,27 +166,28 @@ graphicsMenu :: ScreenLayer
graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
graphicsMenuOptions :: [MenuOption]
graphicsMenuOptions = basicKeyOptions
[ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
]
graphicsMenuOptions =
basicKeyOptions
[ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
]
gameOverMenu :: ScreenLayer
gameOverMenu = OptionScreen
{ _scTitle = const "GAME OVER"
, _scOptions = pauseMenuOptions
, _scDefaultEff = return . Just
, _scOptionFlag = GameOverOptions
, _scOptionsOffset = 0
}
gameOverMenu =
OptionScreen
{ _scTitle = const "GAME OVER"
, _scOptions = pauseMenuOptions
, _scDefaultEff = return . Just
, _scOptionFlag = GameOverOptions
, _scOptionsOffset = 0
}
-- | hacky - no longer used
scodeToChar :: Scancode -> Char
scodeToChar = toEnum . (+ 61) . fromIntegral . unwrapScancode
--charToScode :: Char -> Scancode
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
@@ -176,20 +197,20 @@ unpause w = Just . resumeSound $ w & menuLayers .~ []
displayControls :: ScreenLayer
displayControls = ColumnsScreen (const "CONTROLS") listControls
listControls :: [(String,String)]
listControls :: [(String, String)]
listControls =
[("wasd", "MOVEMENT")
,("[rmb]", "AIM")
,("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED")
,("[lmb]", "USE EQUIPPED")
,("[wheelscroll]" , "SELECT ITEM" )
,("[space]" , "PICKUP ITEM" )
,("m" , "DISPLAY MAP" )
,("f" , "DROP ITEM" )
,("c" , "COMBINE ITEMS" )
,("x" , "TWEAK ITEMS" )
,("c[esc]" , "PAUSE" )
,("qe" , "ROTATE CAMERA")
,("F5" , "QUICKSAVE")
,("F9" , "QUICKLOAD")
[ ("wasd", "MOVEMENT")
, ("[rmb]", "AIM")
, ("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED")
, ("[lmb]", "USE EQUIPPED")
, ("[wheelscroll]", "SELECT ITEM")
, ("[space]", "PICKUP ITEM")
, ("m", "DISPLAY MAP")
, ("f", "DROP ITEM")
, ("c", "COMBINE ITEMS")
, ("x", "TWEAK ITEMS")
, ("c[esc]", "PAUSE")
, ("qe", "ROTATE CAMERA")
, ("F5", "QUICKSAVE")
, ("F9", "QUICKLOAD")
]