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

Remove explicit scancode from menu items

Browse Source
This commit is contained in:
justin
2022-11-04 08:42:30 +00:00
parent 6e7cd14f49
commit c263012b61
11 changed files with 81 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Input.hs
+1
View File
@@ -17,6 +17,7 @@ data PressType = InitialPress
data Input = Input
{ _mousePos :: Point2
, _mouseMoving :: Bool
, _pressedKeys :: M.Map Scancode PressType
, _mouseButtons :: M.Map MouseButton Bool
, _scrollAmount :: Int
src/Dodge/Data/SelectionList.hs
+2
View File
@@ -16,6 +16,7 @@ data SelectionList = SelectionList
, _slSelPos :: Maybe Int
, _slCursorType :: CursorType
, _slWidth :: SelectionWidth
, _slLength :: Int
}
data SelectionWidth = FixedSelectionWidth Int
@@ -28,6 +29,7 @@ data SelectionItem = SelectionItem
{ _siPictures :: [Picture]
, _siHeight :: Int
, _siIsSelectable :: Bool
, _siWidth :: Int
, _siColor :: Color
, _siOffX :: Int
}
src/Dodge/Data/Universe.hs
+2 -5
View File
@@ -81,17 +81,14 @@ data MenuOption
= Toggle
{ _moEff :: Universe -> Universe
, _moString :: Universe -> MenuOptionDisplay
, _moKey :: Scancode
}
| Toggle2
{ _moKey1 :: Scancode
, _moEff1 :: Universe -> Universe
, _moKey2 :: Scancode
{ _moEff1 :: Universe -> Universe
, _moEff2 :: Universe -> Universe
, _moString :: Universe -> MenuOptionDisplay
}
| InvisibleToggle
{ _moKey :: Scancode
{ _moChar :: Scancode
, _moEff :: Universe -> Universe
}
src/Dodge/Default/World.hs
+4 -2
View File
@@ -10,12 +10,14 @@ import qualified IntMapHelp as IM
import System.Random
defaultInput :: Input
defaultInput = Input
defaultInput =
Input
{ _clickMousePos = V2 0 0
, _textInput = mempty
, _pressedKeys = mempty
, _mouseButtons = mempty
, _mousePos = V2 0 0
, _mouseMoving = False
, _scrollAmount = 0
, _previousScrollAmount = 0
, _hammers = defaultWorldHammers
@@ -24,7 +26,7 @@ defaultInput = Input
, _rLine = (0, 0)
, _lSelect = 0
, _rSelect = 0
}
}
defaultWorld :: World
defaultWorld =
src/Dodge/Event/Input.hs
+2 -1
View File
@@ -31,10 +31,11 @@ handleKeyboardEvent kev = case keyboardEventKeyMotion kev of
handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input
handleMouseMotionEvent mmev cfig =
mousePos
(mousePos
.~ V2
(fromIntegral x - 0.5 * _windowX cfig)
(0.5 * _windowY cfig - fromIntegral y)
) . (mouseMoving .~ True)
where
P (V2 x y) = mouseMotionEventPos mmev
src/Dodge/Event/Menu.hs
+23 -33
View File
@@ -1,5 +1,5 @@
module Dodge.Event.Menu (
optionListToEffects,
--optionListToEffects,
) where
import Control.Lens
@@ -8,36 +8,26 @@ 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
--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
menuOptionToEffects :: MenuOption -> [(Scancode, Universe -> Universe)]
menuOptionToEffects Toggle{_moKey = k, _moEff = eff} = [(k, eff)]
menuOptionToEffects InvisibleToggle{_moKey = k, _moEff = eff} = [(k, eff)]
menuOptionToEffects
Toggle2
{ _moKey1 = k1
, _moEff1 = eff1
, _moKey2 = k2
, _moEff2 = eff2
} = [(k1, eff1), (k2, eff2)]
src/Dodge/Menu.hs
+3 -15
View File
@@ -31,7 +31,6 @@ splashMenu =
splashMenuOptions :: [MenuOption]
splashMenuOptions =
basicKeyOptions
[ Toggle ( loadSaveSlot (SaveSlotNum 0)) displaycontinue
, Toggle id (\u -> MODString $ show $ u ^? uvScreenLayers . _head . scSelPos . _Just)
, Toggle id (\u -> MODString $ shortShow $ u ^. uvWorld . input . mousePos)
@@ -55,7 +54,6 @@ pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions unpause
pauseMenuOptions :: [MenuOption]
pauseMenuOptions =
basicKeyOptions
[ Toggle popScreen (opText "CONTINUE")
, Toggle (startNewGameInSlot 0) (opText "NEW GAME")
, Toggle reloadLevelStart (opText "RESTART")
@@ -84,7 +82,7 @@ seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
[ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD") ScancodeA
[ Toggle (uvIOEffects .~ trySeedFromClipboard) (const $ MODString "PASTE NUMBER FROM CLIPBOARD")
-- , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
]
@@ -106,11 +104,11 @@ optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
optionsOptions :: [MenuOption]
optionsOptions =
basicKeyOptions
[ makeSubmenuOption soundMenu $ MODString "VOLUME"
, makeSubmenuOption graphicsMenu $ MODString "GRAPHICS"
, makeSubmenuOption gameplayMenu $ MODString "GAMEPLAY"
, makeSubmenuOption debugMenu $ MODString "DEBUG OPTIONS"
, Toggle popScreen $ const $ MODString "BACK"
]
debugMenu :: ScreenLayer
@@ -121,12 +119,9 @@ debugMenu =
debugMenuOptions :: [MenuOption]
debugMenuOptions =
zipWith
($)
(map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" id])
$ map Scancode [4 ..]
where
f :: DebugBool -> Scancode -> MenuOption
f :: DebugBool -> MenuOption
f bd =
Toggle
(uvConfig . debug_booleans . at bd %~ toggleJust)
@@ -156,13 +151,9 @@ gameplayMenu =
gameplayMenuOptions :: [MenuOption]
gameplayMenuOptions =
basicKeyOptions
[ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
]
basicKeyOptions :: [Scancode -> c] -> [c]
basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 ..]
soundMenu :: ScreenLayer
soundMenu =
slTitleOptions
@@ -178,9 +169,7 @@ soundMenuOptions =
where
theoption scod1 stype scod2 str voltype =
Toggle2
scod1
(change dec stype)
scod2
(change inc stype)
(\w -> MODStringOption str (leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
change g vt uv = uv & uvConfig . vt %~ g
@@ -197,7 +186,6 @@ graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
graphicsMenuOptions :: [MenuOption]
graphicsMenuOptions =
basicKeyOptions
[ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize)
, makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
src/Dodge/Menu/Option.hs
+5 -9
View File
@@ -3,7 +3,6 @@ module Dodge.Menu.Option
import Dodge.ScodeToChar
import Padding
import Picture.Base
import Color
import Dodge.Data.CardinalPoint
import Dodge.Data.SelectionList
import Dodge.Data.Universe
@@ -31,13 +30,14 @@ makeOptionsSelectionList mselpos u mos = SelectionList
, _slSelPos = mselpos
, _slCursorType = BorderCursor (Set.fromList [North,South,West])
, _slWidth = FixedSelectionWidth 15
, _slLength = length $ optionsToSelections u mos
}
optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
optionsToSelections u ops = map colStrToSelItem colstrs
where
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) visibleops)
colstrs = map (menuOptionToString u maxOptionLength) visibleops
colstrs = zipWith (menuOptionToString u maxOptionLength) ['A'..] visibleops
visibleops = filter notInvisible ops
notInvisible InvisibleToggle{} = False
notInvisible _ = True
@@ -47,6 +47,7 @@ colStrToSelItem (col,str) = SelectionItem
{ _siPictures = [color col $ text str]
, _siHeight = 1
, _siIsSelectable = True
, _siWidth = length str
, _siColor = col
, _siOffX = 0
}
@@ -56,8 +57,8 @@ optionValueOffset u mo = case _moString mo u of
MODStringOption s _ -> length s
_ -> 0
menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText)
menuOptionToString :: Universe -> Int -> Char -> MenuOption -> (Color, String)
menuOptionToString w padAmount char mo = (thecol, (char:":") ++ optionText)
where
thecol = case _moString mo w of
MODBlockedString{} -> greyN 0.5
@@ -65,8 +66,3 @@ menuOptionToString w padAmount mo = (thecol, theKeys ++ optionText)
optionText = case _moString mo w of
MODStringOption s t -> rightPad padAmount '.' s ++ t
x -> _modString x
theKeys = case mo of
Toggle{_moKey = k} -> stc k : ":"
Toggle2{_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
_ -> undefined
stc = scodeToChar
src/Dodge/Render/HUD.hs
+17 -10
View File
@@ -78,16 +78,17 @@ subInvSelectionList = SelectionList
inventorySelectionList :: World -> [SelectionItem]
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
++ [SelectionItem displayFreeSlots 1 False white 0]
++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0]
++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects)
where
cr = you w
inv = _crInv cr
nfreeslots = crNumFreeSlots cr
displayFreeSlots = case nfreeslots of
0 -> [color invDimColor . text $ " INVENTORY FULL"]
1 -> [color invDimColor . text $ " +1 FREE SLOT"]
x -> [color invDimColor . text $ " +" ++ show x ++ " FREE SLOTS"]
thetext = case nfreeslots of
0 -> " INVENTORY FULL"
1 -> " +1 FREE SLOT"
x -> " +" ++ show x ++ " FREE SLOTS"
displayFreeSlots = [color invDimColor $ text thetext]
inventoryCursorPos :: SubInventory -> World -> Maybe Int
inventoryCursorPos subinv w = case subinv of
@@ -316,11 +317,14 @@ combineListSelection w = subInvSelectionList & slItems .~ combineListSelectionIt
combineListSelectionItems :: World -> [SelectionItem]
combineListSelectionItems w = case combineListSelectionItems' w of
[] -> [SelectionItem [text "NO POSSIBLE COMBINATIONS"] 1 False white 0]
[] -> [SelectionItem [text thetext] 1 False (length thetext) white 0]
xs -> xs
where
thetext = "NO POSSIBLE COMBINATIONS"
combineListSelectionItems' :: World -> [SelectionItem]
combineListSelectionItems' w = map (picsToSelectable . itemText . snd) $ combineItemListYou w
combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w
ammoTweakSelectionItems :: Maybe Item -> [SelectionItem]
ammoTweakSelectionItems = textSelItems . ammoTweakStrings
@@ -349,6 +353,7 @@ closeObjectToSelectionItem n e = SelectionItem
{ _siPictures = pics
, _siHeight = length pics
, _siIsSelectable = True
, _siWidth = 15
, _siColor = col
, _siOffX = 2
}
@@ -447,23 +452,25 @@ mapWall cfig thehud wl =
mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0
picsToSelectable :: [Picture] -> SelectionItem
picsToSelectable pics = SelectionItem
picsToSelectable :: Int -> [Picture] -> SelectionItem
picsToSelectable wdth pics = SelectionItem
{ _siPictures = pics
, _siHeight = length pics
, _siIsSelectable = True
, _siWidth = wdth
, _siColor = white
, _siOffX = 0
}
textSelItems :: [String] -> [SelectionItem]
textSelItems = map (picsToSelectable . (:[]) . text)
textSelItems = map (picsToSelectable 15 . (:[]) . text)
invSelectionItem :: Creature -> (Int,Item) -> SelectionItem
invSelectionItem cr (i,it) = SelectionItem
{ _siPictures = pics
, _siHeight = length pics
, _siIsSelectable = True
, _siWidth = 15
, _siColor = col
, _siOffX = 0
}
src/Dodge/Render/MenuScreen.hs
+2 -5
View File
@@ -5,17 +5,14 @@ module Dodge.Render.MenuScreen (
) where
import Dodge.Menu.Option
import Dodge.Data.CardinalPoint
import Dodge.Render.List
import Dodge.Data.SelectionList
import qualified Data.Text as T
import Dodge.Base.Window
import Dodge.Data.Universe
import Dodge.ScodeToChar
import Dodge.WindowLayout
import Padding
import Picture
import qualified Data.Set as Set
menuScreen' :: Universe -> ScreenLayer -> Picture
menuScreen' w screen = case screen of
@@ -95,8 +92,8 @@ drawOptions u title ops off mselpos footer =
x | x < length ops -> take (availableMenuLines cfig) (drop off visibleops)
_ -> visibleops
ops'' = case availableMenuLines cfig of
x | x < length ops -> map (menuOptionToString u maxOptionLength) ops' ++ [(white, "SPACE: MORE OPTIONS")]
_ -> map (menuOptionToString u maxOptionLength) ops'
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
src/Dodge/Update.hs
+20 -5
View File
@@ -66,6 +66,7 @@ import SDL
import Sound.Data
import StrictHelp
import qualified Data.Text as T
import ListHelp
updateUniverse :: Universe -> Universe
updateUniverse u =
@@ -93,16 +94,29 @@ gotoTerminal w = case _uvScreenLayers w of
optionScreenUpdates :: Universe -> Universe
optionScreenUpdates u = case u ^? uvScreenLayers . _head of
Just (OptionScreen {_scOptions = mos, _scSelPos = mselpos}) -> mouseOverSelectionList
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
Just False -> fromMaybe u $ do
i <- mi
mo <- mos !? i
return $ _moEff mo u
_ -> u
mouseOverSelectionList :: SelectionList -> Universe -> Universe
mouseOverSelectionList sl u
| x > xl && x < xr = u & uvScreenLayers . _head . scSelPos .~ Just (ceiling $ y' / 50)
| x > xl && x < xr && ylower == yupper && mmoving
&& ylower >= 0 && ylower < _slLength sl = u & uvScreenLayers . _head . scSelPos ?~ yupper
| otherwise = u
where
y' = hh - (75 + y + _slPosY sl)
mmoving = u ^. uvWorld . input . mouseMoving
ylower = ceiling $ (hh - (75 + y + _slPosY sl)) / 50
yupper = floor $ (hh - (15 + y + _slPosY sl)) / 50
xl = _slPosX sl - hw
xr = xl + _slScale sl * 15 * 9
V2 x y = u ^. uvWorld . input . mousePos
@@ -113,8 +127,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 $
foldl' (\u' scode -> optionListToEffects defeff scode mos u') u (M.keys $ M.filter (== InitialPress) pkeys)
Just OptionScreen{_scOptions = mos, _scDefaultEff = defeff} -> optionScreenUpdates . menuWheelEvents $ 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
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u-- M.foldlWithKey' (updateKeyInTerminal tmid) u pkeys
@@ -126,6 +140,7 @@ updateUniverseLast :: Universe -> Universe
updateUniverseLast =
over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
. over uvWorld (input . pressedKeys . each %~ f)
. over uvWorld (input . mouseMoving .~ False)
where
f LongPress = LongPress
f _ = ShortPress