module Dodge.Menu ( scodeToChar , popScreen , pushScreen , pauseMenu , gameOverMenu ) where import Dodge.Data import Dodge.PreloadData import Dodge.Save import Dodge.Config.Update import SDL import SDL.Internal.Numbered --import Preload.Update import Dodge.Base.Window import Dodge.SoundLogic import Dodge.LevelGen import Control.Lens import System.Random optionMenu :: ScreenLayer optionMenu = OptionScreen { _scTitle = const "OPTIONS" , _scOptions = optionsOptions , _scDefaultEff = popScreen , _scOptionFlag = NormalOptions } optionsOptions :: [MenuOption] optionsOptions = [ anOption ScancodeV soundMenu "VOLUME" , anOption ScancodeG graphicsMenu "GRAPHICS" , anOption ScancodeP gameplayMenu "GAMEPLAY" , anOption ScancodeD debugMenu "DEBUG OPTIONS" ] where anOption scode submenu t = Toggle scode (pushScreen submenu) (const t) debugMenu :: ScreenLayer debugMenu = OptionScreen { _scTitle = const "OPTIONS:GAMEPLAY" , _scOptions = debugMenuOptions , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } debugMenuOptions :: [MenuOption] debugMenuOptions = [ doption ScancodeF debug_seconds_frame "SHOW SECONDS/FRAME" _debug_seconds_frame , doption ScancodeC debug_noclip "NOCLIP" _debug_noclip , doption ScancodeS debug_cr_status "SHOW CREATURE STATUS" _debug_cr_status , doption ScancodeV debug_view_boundaries "SHOW VIEW BOUNDARIES" _debug_view_boundaries , doption ScancodeP debug_pathing "SHOW PATHING" _debug_pathing ] where doption scode l t rec = Toggle scode (Just . (uvWorld . config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w))) gameplayMenu :: ScreenLayer gameplayMenu = OptionScreen { _scTitle = const "OPTIONS:GAMEPLAY" , _scOptions = gameplayMenuOptions , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } gameplayMenuOptions :: [MenuOption] gameplayMenuOptions = [ option ScancodeR rotate_to_wall "ROTATE TO WALL" _rotate_to_wall , option ScancodeS show_sound "SHOW VISUAL SOUNDS" _show_sound ] where option scode l t rec = Toggle scode (Just . (uvWorld . config . l %~ not)) (\w -> t ++ ":" ++ show (rec $ _config (_uvWorld w))) soundMenu :: ScreenLayer soundMenu = OptionScreen { _scTitle = const "OPTIONS:VOLUME" , _scOptions = soundMenuOptions , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } soundMenuOptions :: [MenuOption] soundMenuOptions = [ Toggle2 ScancodeY (master dec . sw) ScancodeU (master inc . sw) (\w -> "MASTER VOLUME:" ++ mavol (_uvWorld w)) , Toggle2 ScancodeH (soundEffs dec . sw) ScancodeJ (soundEffs inc . sw) (\w -> "EFFECTS VOLUME:" ++ snvol (_uvWorld w)) , Toggle2 ScancodeN (music dec . sw) ScancodeM (music inc . sw) (\w -> "MUSIC VOLUME:" ++ muvol (_uvWorld w)) ] where dec x = max 0 (x - 0.1) inc x = min 1 (x + 0.1) --sw w = w & sideEffects %~ (setVol (_config w) : ) sw w = w & uvWorld . sideEffects %~ setVolThen (_config (_uvWorld w)) master g = Just . (uvWorld . config . volume_master %~ g) soundEffs g = Just . (uvWorld . config . volume_sound %~ g) music g = Just . (uvWorld . 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 :: World -> World writeConfig w = w & sideEffects %~ saveConfig (_config w) graphicsMenu :: ScreenLayer graphicsMenu = OptionScreen { _scTitle = const "OPTIONS:GRAPHICS" , _scOptions = graphicsMenuOptions , _scDefaultEff = popScreen . over uvWorld writeConfig , _scOptionFlag = NormalOptions } graphicsMenuOptions :: [MenuOption] graphicsMenuOptions = [ Toggle ScancodeW (Just . (uvWorld . config . wall_textured %~ not)) wtextstring , Toggle ScancodeS upf resostring , Toggle ScancodeD (Just . (uvWorld . config . cloud_shadows %~ not)) cshadstring ] where wtextstring w = "WALL TEXTURES:" ++ show (_wall_textured $ _config (_uvWorld w)) resostring w = "RESOLUTION: 1/" ++ show (_resolution_factor $ _config (_uvWorld w)) upf w = Just $ over uvWorld updateFramebufferSize $ w & uvWorld . config . resolution_factor %~ cycleResolution cshadstring w = "CLOUD SHADOWS:" ++ show (_cloud_shadows $ _config (_uvWorld 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 { _scTitle = const "GAME OVER" , _scOptions = pauseMenuOptions , _scDefaultEff = Just , _scOptionFlag = GameOverOptions } pauseMenu :: ScreenLayer pauseMenu = OptionScreen { _scTitle = const "PAUSED" , _scOptions = pauseMenuOptions , _scDefaultEff = unpause , _scOptionFlag = NormalOptions } pauseMenuOptions :: [MenuOption] pauseMenuOptions = [ Toggle ScancodeN startNewGame (const "NEW LEVEL") , Toggle ScancodeR (Just . loadSaveSlot LevelStartSlot) (const "RESTART") , Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS") , Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS") , InvisibleToggle ScancodeEscape (const Nothing) ] startNewGame :: Universe -> Maybe Universe startNewGame w = Just $ w & menuLayers .~ [WaitScreen (const "GENERATING...") 1] & uvWorld . sideEffects .~ uvWorld (uvWorldSideEffects i (_uvWorld w)) where i = fst $ random (_randGen (_uvWorld w)) uvWorldSideEffects :: Int -> World -> b -> IO World uvWorldSideEffects i w = const (generateWorldFromSeed i <&> config .~ _config w) -- | hacky scodeToChar :: Scancode -> Char scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber --charToScode :: Char -> Scancode --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum updateFramebufferSize :: World -> World updateFramebufferSize w = w & sideEffects %~ sideEffectUpdatePreload divRes x y where (x,y) = (round $ getWindowX w, round $ getWindowY w) divRes = w ^. config . resolution_factor --levelMenu :: Int -> ScreenLayer --levelMenu x = OptionScreen -- { _scTitle = const $ "LEVEL "++ show x -- , _scOptions = levelMenuOptions -- , _scDefaultEff = unpause . storeLevel -- , _scOptionFlag = NormalOptions -- } unpause :: Universe -> Maybe Universe unpause w = Just . resumeSound $ w & menuLayers .~ [] displayControls :: ScreenLayer displayControls = ColumnsScreen "CONTROLS" listControls listControls :: [(String,String)] listControls = [("wasd", "MOVEMENT") ,("[rmb]", "AIM") ,("[rmb+lmb]", "SHOOT OR USE ITEM") ,("[wheelscroll]" , "SELECT ITEM" ) ,("[space]" , "PICKUP ITEM" ) ,("m" , "DISPLAY MAP" ) ,("f" , "DROP ITEM" ) ,("c[esc]" , "PAUSE" ) ,("qe" , "ROTATE CAMERA") ,("F5" , "QUICKSAVE") ,("F9" , "QUICKLOAD") ]