diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 1c38d78b8..923e9378e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -113,6 +113,7 @@ data ScreenLayer , _scDefaultEff :: World -> Maybe World , _scOptionFlag :: OptionScreenFlag } + | ColumnsScreen String [(String,String)] | InputScreen String | TerminalScreen Int [(Int,String)] | WaitScreen diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 722212acf..7139f5d50 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -1,6 +1,4 @@ -{- | -Deals with keyboard events. --} +{- | Deals with keyboard events. -} module Dodge.Event.Keyboard ( handleKeyboardEvent ) diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index b7f1a0334..48401f507 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -15,6 +15,7 @@ handlePressedKeyInMenu mState scode = case mState of OptionScreen { _scOptions = mos, _scDefaultEff = defeff} -> optionListToEffects mos defeff scode DisplayScreen {} -> popScreen + ColumnsScreen {} -> popScreen WaitScreen {} -> Just TerminalScreen 0 _ -> popScreen TerminalScreen _ m -> Just . ( menuLayers %~ ( (TerminalScreen 0 m : ) . tail) ) diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 2665b766e..2e289f5a9 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -1,4 +1,10 @@ module Dodge.Menu + ( scodeToChar + , popScreen + , pushScreen + , pauseMenu + , gameOverMenu + ) where import Dodge.Data import Dodge.Save @@ -12,7 +18,7 @@ import Dodge.Initialisation import Preload.Update import Dodge.Base.Window import Dodge.SoundLogic -import Picture +--import Picture import Control.Lens optionMenu :: ScreenLayer @@ -28,12 +34,12 @@ optionsOptions = , Toggle ScancodeG (pushScreen graphicsMenu) (const "GRAPHICS") , Toggle ScancodeP (pushScreen gameplayOptionsMenu) (const "GAMEPLAY") ] -levelMenuOptions :: [MenuOption] -levelMenuOptions = - [ InvisibleToggle ScancodeEscape (const Nothing) - , InvisibleToggle ScancodeO (pushScreen optionMenu) - , InvisibleToggle ScancodeC (pushScreen displayControls) - ] +--levelMenuOptions :: [MenuOption] +--levelMenuOptions = +-- [ InvisibleToggle ScancodeEscape (const Nothing) +-- , InvisibleToggle ScancodeO (pushScreen optionMenu) +-- , InvisibleToggle ScancodeC (pushScreen displayControls) +-- ] gameplayOptionsMenu :: ScreenLayer gameplayOptionsMenu = OptionScreen { _scTitle = const "OPTIONS:GAMEPLAY" @@ -151,8 +157,8 @@ startNewGame w = Just $ w scodeToChar :: Scancode -> Char scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber -charToScode :: Char -> Scancode -charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum +--charToScode :: Char -> Scancode +--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum updateFramebufferSize :: World -> World updateFramebufferSize w = w & sideEffects %~ up @@ -164,43 +170,30 @@ updateFramebufferSize w = w & sideEffects %~ up pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w') f $ w' & preloadData .~ pdata -levelMenu :: Int -> ScreenLayer -levelMenu x = OptionScreen - { _scTitle = const $ "LEVEL "++ show x - , _scOptions = levelMenuOptions - , _scDefaultEff = unpause . storeLevel - , _scOptionFlag = NormalOptions - } +--levelMenu :: Int -> ScreenLayer +--levelMenu x = OptionScreen +-- { _scTitle = const $ "LEVEL "++ show x +-- , _scOptions = levelMenuOptions +-- , _scDefaultEff = unpause . storeLevel +-- , _scOptionFlag = NormalOptions +-- } unpause :: World -> Maybe World unpause w = Just . resumeSound $ w {_menuLayers = []} displayControls :: ScreenLayer -displayControls = DisplayScreen - {_scDisplay = \w -> pictures - [color (withAlpha 0.5 black) $ polygon $ screenBox w - ,tst (-100) 100 0.4 "CONTROLS" - ,controlsList - ] - } - where - tst x y sc t = translate x y $ scale sc sc $ color white $ text t +displayControls = ColumnsScreen "CONTROLS" listControls -controlsList :: Picture -controlsList = pictures $ concat $ zipWith butAndEff - [("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") +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") ] - [60,30..] - where - butAndEff (btext,etext) y = - [translate (-250) y $ scale 0.15 0.15 $ color white $ text btext - ,translate 0 y $ scale 0.15 0.15 $ color white $ text etext - ] - diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 0f3c9d410..22085a1fd 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -11,6 +11,7 @@ import Dodge.Data import Dodge.Base.Window import Picture import Dodge.Menu +import Padding menuScreen :: World @@ -23,6 +24,7 @@ menuScreen w screen = case screen of (InputScreen s) -> drawOptions w ('>':s) [] (TerminalScreen t xs ) -> displayStringList w $ map snd $ filter (( > t) . fst) xs (DisplayScreen sd ) -> sd w + (ColumnsScreen title pairs) -> drawTwoColumnsScreen w title pairs displayStringList :: World -> [String] -> Picture displayStringList w ss = pictures @@ -33,6 +35,26 @@ displayStringList w ss = pictures hw = halfWidth w ys = [0,22..] f y s = translate (10-hw) y . scale 0.15 0.15 $ text s + +drawTwoColumnsScreen + :: World + -> String + -> [(String,String)] + -> Picture +drawTwoColumnsScreen w title lps = pictures + [darkenBackground w + ,drawTitle w title + ,drawTwoColumns w lps + ] + +drawTwoColumns :: World -> [(String,String)] -> Picture +drawTwoColumns w lps = pictures $ zipWith f [hh-100,hh-130..] lps + where + f y (s1,s2) = translate (50-hw) y $ sc $ rightPad ln '.' s1 ++ s2 + sc = scale 0.15 0.15 . color white . text + hh = halfHeight w + hw = halfWidth w + ln = maximum (map (length . fst) lps) + 3 drawOptions :: World @@ -40,8 +62,8 @@ drawOptions -> [MenuOption] -- ^ Options -> Picture drawOptions w title ops = pictures $ - [darkenBackground - ,theTitle] + [darkenBackground w + ,drawTitle w title] ++ zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) (map (menuOptionToString w) ops') [hh-100,hh-150 ..] where @@ -49,8 +71,16 @@ drawOptions w title ops = pictures $ notInvisible InvisibleToggle {} = False notInvisible _ = True placeString x y sc t = translate x y $ scale sc sc $ color white $ text t - darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox w - theTitle = placeString (-hw + 30) (hh - 50) 0.4 title + hh = halfHeight w + hw = halfWidth w + +darkenBackground :: World -> Picture +darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox + +drawTitle :: World -> String -> Picture +drawTitle w = placeString (-hw + 30) (hh - 50) 0.4 + where + placeString x y sc t = translate x y $ scale sc sc $ color white $ text t hh = halfHeight w hw = halfWidth w diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 94aedfe43..c34961bc1 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -1,5 +1,9 @@ module Dodge.Save - where + ( storeLevel + , loadStoredLevel + , doQuicksave + ) + where import Dodge.Data import Data.Maybe @@ -12,7 +16,7 @@ storeLevel w = case _storedLevel w of _ -> w loadStoredLevel :: World -> World -loadStoredLevel w = fromMaybe w $ _storedLevel w +loadStoredLevel w = fromMaybe w $ _storedLevel w <&> quicksaveLevel .~ _quicksaveLevel w doQuicksave :: World -> World doQuicksave w = w & quicksaveLevel ?~ clearKeys w