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

Improve mouse menu controls, tweak charmap

Browse Source
This commit is contained in:
justin
2022-12-21 11:33:11 +00:00
parent 860d63df45
commit 03c945d189
12 changed files with 68 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/texture/charMap.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.5 KiB

After

Width:  |  Height:  |  Size: 3.3 KiB

src/Dodge/Base/Window.hs
+2
View File
@@ -54,3 +54,5 @@ screenBox w = rectNSWE hh (- hh) (- hw) hw
where
hw = halfWidth w
hh = halfHeight w
src/Dodge/Data/SelectionList.hs
+2 -1
View File
@@ -20,10 +20,11 @@ data SelectionList = SelectionList
, _slWidth :: SelectionWidth
, _slLength :: Int
, _slSizeRestriction :: SelectionSizeRestriction
, _slSpecialItem :: SpecialSelectionItem
-- , _slSpecialItem :: SpecialSelectionItem
}
data SelectionItemIndex = ListedSelectionItem Int
| DummySelectionItem
| ScrollUpSelectionItem
| ScrollDownSelectionItem
| SpecialSelectionItem
src/Dodge/Data/Universe.hs
+1
View File
@@ -5,6 +5,7 @@
module Dodge.Data.Universe (
module Dodge.Data.Universe,
module Dodge.Data.SelectionList,
module Dodge.Data.Config,
module Dodge.Data.World,
module Data.Preload,
src/Dodge/Menu/Option.hs
+16 -14
View File
@@ -1,7 +1,7 @@
module Dodge.Menu.Option
where
--import Dodge.ScodeToChar
import Data.Maybe
--import Data.Maybe
import Dodge.WindowLayout
import Padding
import Picture.Base
@@ -18,11 +18,13 @@ slTitleOptionsEff title ops defstr eff u =
, _scOptions = ops
, _scMaybeOption = fmap (Toggle eff . const . MODString) defstr
, _scOptionFlag = NormalOptions
, _scSelectionList = makeOptionsSelectionList (Just 0) u ops defstr
, _scSelectionList = makeOptionsSelectionList (Just 0) u ops
}
makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> Maybe String -> SelectionList
makeOptionsSelectionList mselpos u mos defstr = SelectionList
--makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> Maybe String -> SelectionList
--makeOptionsSelectionList mselpos u mos defstr = SelectionList
makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList
makeOptionsSelectionList mselpos u mos = SelectionList
{ _slPosX = 50
, _slPosY = 50
, _slOffset = 0
@@ -36,16 +38,16 @@ makeOptionsSelectionList mselpos u mos defstr = SelectionList
, _slLength = length $ optionsToSelections u mos
, _slSizeRestriction = SelectionSizeRestriction (availableMenuLines cfig) overflowit overflowit
(SSRFromScreenBottom 5)
, _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do
str <- defstr
return $ BottomSelectionItem SelectionItem
{ _siPictures = [color white $ text str]
, _siHeight = 1
, _siIsSelectable = True
, _siWidth = length str
, _siColor = white
, _siOffX = 0
}
-- , _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do
-- str <- defstr
-- return $ BottomSelectionItem SelectionItem
-- { _siPictures = [color white $ text str]
-- , _siHeight = 1
-- , _siIsSelectable = True
-- , _siWidth = length str
-- , _siColor = white
-- , _siOffX = 0
-- }
}
where
cfig = u ^. uvConfig
src/Dodge/Render/HUD.hs
-3
View File
@@ -43,7 +43,6 @@ drawInGameHUD :: SubInventory -> Universe -> Picture
drawInGameHUD subinv uv =
pictures
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
, listPicturesAt (halfWidth cfig) 0 cfig $ map text (_uvTestString uv uv)
, inventoryDisplay subinv cfig w
]
where
@@ -64,7 +63,6 @@ defaultSelectionList = SelectionList
, _slWidth = FixedSelectionWidth 15
, _slLength = 0
, _slSizeRestriction = NoSelectionSizeRestriction
, _slSpecialItem = NoSpecialSelectionItem
}
subInvSelectionList :: SelectionList
@@ -81,7 +79,6 @@ subInvSelectionList = SelectionList
, _slWidth = FixedSelectionWidth 15
, _slLength = 0
, _slSizeRestriction = NoSelectionSizeRestriction
, _slSpecialItem = NoSpecialSelectionItem
}
inventorySelectionList :: World -> [SelectionItem]
src/Dodge/Render/List.hs
+1 -1
View File
@@ -23,7 +23,7 @@ drawSelectionList cfig sl =
(_slPosX sl)
(_slPosY sl)
cfig
(_slOffset sl)
0 --(_slOffset sl)
(makeSelectionListPictures sl)
<> drawSelectionCursor cfig sl
src/Dodge/Render/MenuScreen.hs
+14 -15
View File
@@ -1,7 +1,6 @@
{- The menu picture. -}
module Dodge.Render.MenuScreen (
menuScreen,
menuScreen',
drawMenuScreen,
) where
--import LensHelp
@@ -15,8 +14,8 @@ import Dodge.Data.Universe
import Padding
import Picture
menuScreen' :: Configuration -> ScreenLayer -> Picture
menuScreen' cfig screen = case screen of
drawMenuScreen :: Configuration -> ScreenLayer -> Picture
drawMenuScreen cfig screen = case screen of
OptionScreen{_scTitle = titf, _scSelectionList = selpos} ->
drawOptions cfig titf selpos "Use keys to navigate the menu"
-- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
@@ -24,12 +23,12 @@ menuScreen' cfig screen = case screen of
-- (DisplayScreen sd) -> sd w
(ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs
menuScreen :: Configuration -> ScreenLayer -> Picture
menuScreen cfig screen = case screen of
OptionScreen{_scTitle = titf, _scSelectionList = selpos} ->
drawOptions cfig titf selpos "Use keys to navigate the menu"
(InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
(ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs
--menuScreen :: Configuration -> ScreenLayer -> Picture
--menuScreen cfig screen = case screen of
-- OptionScreen{_scTitle = titf, _scSelectionList = selpos} ->
-- drawOptions cfig titf selpos "Use keys to navigate the menu"
-- (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
-- (ColumnsScreen titf pairs) -> drawTwoColumnsScreen cfig titf pairs
--displayStringList :: World -> [String] -> Picture
--displayStringList w ss = pictures
@@ -72,8 +71,8 @@ drawInputMenu ::
Picture
drawInputMenu cfig title footer =
pictures
[ --darkenBackground cfig
drawTitle cfig title
[ darkenBackground cfig
, drawTitle cfig title
, drawFooterText cfig red footer
]
@@ -88,14 +87,14 @@ drawOptions ::
Picture
drawOptions cfig title sl footer =
pictures
[ --darkenBackground cfig
drawTitle cfig title
[ darkenBackground cfig
, drawTitle cfig title
, drawFooterText cfig red footer
, drawSelectionList cfig sl
]
darkenBackground :: Configuration -> Picture
darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
darkenBackground cfig = winScale cfig . color (withAlpha 0.5 black) . polygon . reverse . screenBox $ cfig
drawTitle :: Configuration -> String -> Picture
drawTitle cfig = winScale cfig . translate (30 - hw) (hh-50) . scale 0.4 0.4 . text
src/Dodge/Render/Picture.hs
+9 -5
View File
@@ -13,14 +13,18 @@ import Geometry
import Picture
fixedCoordPictures :: Universe -> Picture
fixedCoordPictures u =
drawConcurrentMessage u <> customMouseCursor cfig (u ^. uvWorld . input) <> case u ^. uvScreenLayers of
[] -> drawHUD u
(lay : _) -> setDepth (-1) (menuScreen' cfig lay)
-- <> (setDepth (-1) . winScale cfig $ menuScreen cfig lay)
fixedCoordPictures u = drawMenuOrHUD cfig u
<> drawConcurrentMessage u
<> customMouseCursor cfig (u ^. uvWorld . input)
<> listPicturesAt (halfWidth cfig) 0 cfig (map text (_uvTestString u u))
where
cfig = _uvConfig u
drawMenuOrHUD :: Configuration -> Universe -> Picture
drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
[] -> drawHUD u
(lay : _) -> drawMenuScreen cfig lay
drawConcurrentMessage :: Universe -> Picture
drawConcurrentMessage u =
stackPicturesAt
src/Dodge/SelectionList.hs
+7 -4
View File
@@ -1,16 +1,19 @@
module Dodge.SelectionList where
--import Color
import Dodge.Data.SelectionList
import LensHelp
setShownSelectionItems :: SelectionList -> SelectionList
setShownSelectionItems sl = case sl ^? slSizeRestriction of
Just (SelectionSizeRestriction maxlines topit botit _)
Just (SelectionSizeRestriction maxlines _ botit _)
| length allitems <= maxlines -> sl & slShownItems .~ allitems
| otherwise -> if offset > 0
then sl & slShownItems .~ ((topit,ScrollUpSelectionItem) : take (maxlines - 2) (drop offset allitems))
else sl & slShownItems .~ (take (maxlines - 2) allitems ++ [(botit,ScrollDownSelectionItem)])
-- | offset > length allitems + 3 - maxlines -> sl
| otherwise ->
sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
++ [(botit,ScrollDownSelectionItem)]
_ -> sl & slShownItems .~ allitems
where
-- dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem)
offset = sl ^. slOffset
allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. slItems) [0..]
src/Dodge/TestString.hs
+5 -2
View File
@@ -8,5 +8,8 @@ import qualified Data.Map.Strict as M
testStringInit :: Universe -> [String]
testStringInit u =
[ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
] ++ map show (M.toList (u ^. uvWorld . input . pressedKeys))
[ show $ u ^? uvScreenLayers . _head . scSelectionList . slOffset
]
++ [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
]
++ map show (M.toList (u ^. uvWorld . input . pressedKeys))
src/Dodge/Update.hs
+11 -5
View File
@@ -92,15 +92,21 @@ gotoTerminal w = case _uvScreenLayers w of
(InputScreen{} : _) -> w
_ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
mouseClickOptionsList :: [MenuOption] -> SelectionList -> Maybe MenuOption -> Universe -> Universe
mouseClickOptionsList mos sl mop u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
mouseClickOptionsList :: [MenuOption] -> SelectionList -> Universe -> Universe
mouseClickOptionsList mos sl u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
Just False -> fromMaybe u $ do
i <- sl ^. slSelPos
si <- sl ^? slShownItems . ix i . _2
return $ maybe u ($ u) $ case si of
ListedSelectionItem j -> mos ^? ix j . moEff
ScrollUpSelectionItem -> Just $ uvScreenLayers . _head . scSelectionList . slOffset %~ (min 0 . subtract 10)
ScrollDownSelectionItem -> Just $ uvScreenLayers . _head . scSelectionList . slOffset +~ 10
ScrollUpSelectionItem -> Just $ uvScreenLayers . _head . scSelectionList . slOffset %~ (max 0 . subtract 5)
ScrollDownSelectionItem -> do
maxlines <- sl ^? slSizeRestriction . maxSelectionLines
alllines <- sl ^? slLength
Just $ uvScreenLayers . _head . scSelectionList . slOffset %~
(\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2)
DummySelectionItem -> Just id
SpecialSelectionItem -> Just id
_ -> u
mouseOverSelectionList :: SelectionList -> Universe -> Universe
@@ -146,7 +152,7 @@ optionScreenUpdate :: [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
-> Universe -> Universe
optionScreenUpdate mos mop _ sl u =
optionScreenDefEff mop
. mouseClickOptionsList mos sl mop
. mouseClickOptionsList mos sl
. mouseOverSelectionList sl
. menuWheelEvents
. over (uvScreenLayers . _head . scSelectionList) (setSelectionListRestriction cfig)