Continue work on menu screens
This commit is contained in:
@@ -87,10 +87,6 @@ data MenuOption
|
||||
, _moEff2 :: Universe -> Universe
|
||||
, _moString :: Universe -> MenuOptionDisplay
|
||||
}
|
||||
| InvisibleToggle
|
||||
{ _moChar :: Scancode
|
||||
, _moEff :: Universe -> Universe
|
||||
}
|
||||
|
||||
data IntID a = IntID Int a
|
||||
|
||||
|
||||
@@ -1,33 +0,0 @@
|
||||
module Dodge.Event.Menu (
|
||||
--optionListToEffects,
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
import Dodge.Data.Universe
|
||||
import Dodge.WindowLayout
|
||||
import SDL
|
||||
|
||||
--optionListToEffects ::
|
||||
-- (Universe -> Universe) ->
|
||||
-- Scancode ->
|
||||
-- [MenuOption] ->
|
||||
-- Universe ->
|
||||
-- Universe
|
||||
--optionListToEffects defaulteff sc mops u = case sc of
|
||||
-- ScancodeSpace ->
|
||||
-- (uvScreenLayers . ix 0 . scOptionsOffset %~ (f . (+ mlines)))
|
||||
-- u
|
||||
-- _ ->
|
||||
-- ( fromMaybe defaulteff
|
||||
-- . lookup sc
|
||||
-- . concatMap menuOptionToEffects
|
||||
-- $ mops
|
||||
-- )
|
||||
-- u
|
||||
-- where
|
||||
-- f x
|
||||
-- | x > length mops = 0
|
||||
-- | otherwise = x
|
||||
-- mlines = availableMenuLines $ _uvConfig u
|
||||
|
||||
+5
-7
@@ -19,7 +19,7 @@ import Dodge.StartNewGame
|
||||
import LensHelp
|
||||
import MaybeHelp
|
||||
import Padding
|
||||
import SDL
|
||||
--import SDL
|
||||
import System.Clipboard
|
||||
import Text.Read
|
||||
import Data.Maybe
|
||||
@@ -63,8 +63,6 @@ pauseMenuOptions =
|
||||
, Toggle id (opText "VIEW CURRENT SEED")
|
||||
, Toggle saveQuit (opText "SAVE AND QUIT")
|
||||
]
|
||||
++ [ InvisibleToggle ScancodeEscape hardQuit
|
||||
]
|
||||
where
|
||||
opText = const . MODString
|
||||
|
||||
@@ -162,12 +160,12 @@ soundMenu =
|
||||
|
||||
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 volume_master "MASTER VOLUME" _volume_master
|
||||
, theoption volume_sound "EFFECTS VOLUME" _volume_sound
|
||||
, theoption volume_music "MUSIC VOLUME" _volume_music
|
||||
]
|
||||
where
|
||||
theoption scod1 stype scod2 str voltype =
|
||||
theoption stype str voltype =
|
||||
Toggle2
|
||||
(change dec stype)
|
||||
(change inc stype)
|
||||
|
||||
@@ -36,11 +36,8 @@ makeOptionsSelectionList mselpos u mos = SelectionList
|
||||
optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
|
||||
optionsToSelections u ops = map colStrToSelItem colstrs
|
||||
where
|
||||
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) visibleops)
|
||||
colstrs = zipWith (menuOptionToString u maxOptionLength) ['A'..] visibleops
|
||||
visibleops = filter notInvisible ops
|
||||
notInvisible InvisibleToggle{} = False
|
||||
notInvisible _ = True
|
||||
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
|
||||
colstrs = zipWith (menuOptionToString u maxOptionLength) ['A'..] ops
|
||||
|
||||
colStrToSelItem :: (Color,String) -> SelectionItem
|
||||
colStrToSelItem (col,str) = SelectionItem
|
||||
|
||||
@@ -89,14 +89,11 @@ drawOptions u title ops off mselpos footer =
|
||||
|
||||
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops')
|
||||
ops' = case availableMenuLines cfig of
|
||||
x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops)
|
||||
_ -> visibleops
|
||||
x | x < length ops -> take (availableMenuLines cfig) (drop off ops)
|
||||
_ -> ops
|
||||
ops'' = case availableMenuLines cfig of
|
||||
x | x < length ops -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops' ++ [(white, "SPACE: MORE OPTIONS")]
|
||||
_ -> zipWith (menuOptionToString u maxOptionLength) ['A'..] ops'
|
||||
visibleops = filter notInvisible ops
|
||||
notInvisible InvisibleToggle{} = False
|
||||
notInvisible _ = True
|
||||
hh = halfHeight cfig
|
||||
hw = halfWidth cfig
|
||||
cfig = _uvConfig u
|
||||
|
||||
+19
-12
@@ -9,7 +9,6 @@ module Dodge.Update (updateUniverse) where
|
||||
import Dodge.Menu.Option
|
||||
import Dodge.Data.SelectionList
|
||||
import Dodge.InputFocus
|
||||
import Dodge.Event.Menu
|
||||
import Color
|
||||
import Control.Applicative
|
||||
import Data.List
|
||||
@@ -92,16 +91,8 @@ gotoTerminal w = case _uvScreenLayers w of
|
||||
(InputScreen{} : _) -> w
|
||||
_ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
|
||||
|
||||
optionScreenUpdates :: Universe -> Universe
|
||||
optionScreenUpdates u = case u ^? uvScreenLayers . _head of
|
||||
Just (OptionScreen {_scOptions = mos, _scSelPos = mselpos}) ->
|
||||
mouseClickSelectionList mos mselpos
|
||||
$ mouseOverSelectionList
|
||||
(makeOptionsSelectionList mselpos u mos) u
|
||||
_ -> u
|
||||
|
||||
mouseClickSelectionList :: [MenuOption] -> Maybe Int -> Universe -> Universe
|
||||
mouseClickSelectionList mos mi u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
|
||||
mouseClickOptionsList :: [MenuOption] -> Maybe Int -> Universe -> Universe
|
||||
mouseClickOptionsList mos mi u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
|
||||
Just False -> fromMaybe u $ do
|
||||
i <- mi
|
||||
mo <- mos !? i
|
||||
@@ -127,7 +118,8 @@ mouseOverSelectionList sl u
|
||||
updateUseInput :: Universe -> Universe
|
||||
updateUseInput u = case u ^? uvScreenLayers . _head of
|
||||
Just (InputScreen thetext _) -> doInputScreenInput thetext u
|
||||
Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff} -> optionScreenUpdates . menuWheelEvents $ u
|
||||
Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff, _scOptionFlag = flag, _scSelPos = mselpos}
|
||||
-> optionScreenUpdate mos defeff flag mselpos u
|
||||
-- foldl' (\u' scode -> optionListToEffects defeff scode mos u') u (M.keys $ M.filter (== InitialPress) pkeys)
|
||||
Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
|
||||
_ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
|
||||
@@ -136,6 +128,21 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
|
||||
where
|
||||
pkeys = u ^. uvWorld . input . pressedKeys
|
||||
|
||||
optionScreenUpdate :: [MenuOption] -> (Universe -> Universe) -> OptionScreenFlag -> Maybe Int
|
||||
-> Universe -> Universe
|
||||
optionScreenUpdate mos defeff _ mselpos u =
|
||||
optionScreenDefEff defeff
|
||||
. mouseClickOptionsList mos mselpos
|
||||
. mouseOverSelectionList
|
||||
(makeOptionsSelectionList mselpos u mos)
|
||||
$ menuWheelEvents
|
||||
u
|
||||
|
||||
optionScreenDefEff :: (Universe -> Universe) -> Universe -> Universe
|
||||
optionScreenDefEff f u = case u ^. uvWorld . input . pressedKeys . at ScancodeEscape of
|
||||
Just InitialPress -> f u
|
||||
_ -> u
|
||||
|
||||
updateUniverseLast :: Universe -> Universe
|
||||
updateUniverseLast =
|
||||
over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
|
||||
|
||||
Reference in New Issue
Block a user