diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index e8a7708d3..7f61e1795 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -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 diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 10a31a385..2c71e612b 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -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 } diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 706b0235f..568da4123 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -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 } diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 63d7fd7a9..eba526083 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -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 = diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index 1d8174100..839a7f411 100644 --- a/src/Dodge/Event/Input.hs +++ b/src/Dodge/Event/Input.hs @@ -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 diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index faa2e95b3..fd1a35ef3 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -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)] diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 5df417410..24d7e7949 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -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" diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 0595a97fd..09c57080d 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 2757e9be1..8d395540c 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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 } diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 232539c07..5f5359232 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 8ee64f74d..d3af365fa 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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