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

Separate selection list items from display parameters

Browse Source
This commit is contained in:
justin
2022-12-23 12:22:57 +00:00
parent 6ac4e5d669
commit b072dc9e9a
10 changed files with 141 additions and 132 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
+12 -9
View File
@@ -7,18 +7,20 @@ import Control.Lens
import Data.Set (Set)
import Dodge.Data.CardinalPoint
data ListDisplayParams = ListDisplayParams
{ _ldpPosX :: Float
, _ldpPosY :: Float
, _ldpScale :: Float
, _ldpVerticalGap :: Float
, _ldpCursorType :: CursorType
, _ldpWidth :: SelectionWidth
, _ldpSizeRestriction :: SelectionSizeRestriction
}
data SelectionList = SelectionList
{ _slPosX :: Float
, _slPosY :: Float
, _slScale :: Float
, _slVerticalGap :: Float
, _slItems :: [SelectionItem]
, _slShownItems :: [(SelectionItem,SelectionItemIndex)]
{ _slItems :: [SelectionItem]
, _slSelPos :: Maybe Int
, _slCursorType :: CursorType
, _slWidth :: SelectionWidth
, _slLength :: Int
, _slSizeRestriction :: SelectionSizeRestriction
}
data SelectionItemIndex = ListedSelectionItem Int
@@ -51,6 +53,7 @@ data SelectionItem = SelectionItem
, _siOffX :: Int
}
makeLenses ''ListDisplayParams
makeLenses ''SelectionList
makeLenses ''SelectionItem
makeLenses ''SpecialSelectionItem
src/Dodge/Data/Universe.hs
+2
View File
@@ -57,6 +57,8 @@ data ScreenLayer
, _scOptionFlag :: OptionScreenFlag
, _scSelectionList :: SelectionList
, _scAvailableLines :: Int
, _scShownItems :: [(SelectionItem,SelectionItemIndex)]
, _scListDisplayParams :: ListDisplayParams
}
| ColumnsScreen
{ _scTitle :: String
src/Dodge/Menu.hs
+6 -6
View File
@@ -27,7 +27,7 @@ import Data.Maybe
splashMenu :: Universe -> ScreenLayer
splashMenu u =
slTitleOptionsEff "AMNESIS" splashMenuOptions Nothing id u
initializeOptionMenu "AMNESIS" splashMenuOptions Nothing id u
& scOptionFlag .~ SplashOptions
splashMenuOptions :: [MenuOption]
@@ -51,7 +51,7 @@ splashMenuOptions =
| otherwise = MODString str
pauseMenu :: Universe -> ScreenLayer
pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (Just "CONTINUE") unpause
pauseMenu = initializeOptionMenu "PAUSED" pauseMenuOptions (Just "CONTINUE") unpause
pauseMenuOptions :: [MenuOption]
pauseMenuOptions =
@@ -77,7 +77,7 @@ saveQuitConc u = do
return $ const Nothing
seedStartMenu :: String -> Universe -> ScreenLayer
seedStartMenu str = slTitleOptionsEff str seedStartOptions (Just "BACK") popScreen
seedStartMenu str = initializeOptionMenu str seedStartOptions (Just "BACK") popScreen
seedStartOptions :: [MenuOption]
seedStartOptions =
@@ -96,10 +96,10 @@ trySeedFromClipboard u = do
Just i -> return $ startSeedGame 0 i u
slTitleOptions :: String -> [MenuOption] -> Universe -> ScreenLayer
slTitleOptions title ops = slTitleOptionsEff title ops (Just "BACK") (popScreen . writeConfig)
slTitleOptions title ops = initializeOptionMenu title ops (Just "BACK") (popScreen . writeConfig)
optionMenu :: Universe -> ScreenLayer
optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions (Just "BACK") popScreen
optionMenu = initializeOptionMenu "OPTIONS" optionsOptions (Just "BACK") popScreen
optionsOptions :: [MenuOption]
optionsOptions =
@@ -192,7 +192,7 @@ graphicsMenuOptions =
gameOverMenu :: Universe -> ScreenLayer
gameOverMenu u =
slTitleOptionsEff "GAME OVER" pauseMenuOptions Nothing id u
initializeOptionMenu "GAME OVER" pauseMenuOptions Nothing id u
& scOptionFlag .~ GameOverOptions
-- OptionScreen
src/Dodge/Menu/Option.hs
+32 -37
View File
@@ -11,49 +11,27 @@ import Dodge.Data.Universe
import qualified Data.Set as Set
import LensHelp
slTitleOptionsEff :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer
slTitleOptionsEff title ops defstr eff u =
initializeOptionMenu :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer
initializeOptionMenu title ops defstr eff u =
OptionScreen
{ _scTitle = title
, _scOptions = ops
, _scOffset = 0
, _scMaybeOption = fmap (Toggle eff . const . MODString) defstr
, _scOptionFlag = NormalOptions
, _scSelectionList = makeOptionsSelectionList (Just 0) u ops
, _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops
, _scAvailableLines = 10
, _scShownItems = []
, _scListDisplayParams = ListDisplayParams
{ _ldpPosX = 50
, _ldpPosY = 50
, _ldpScale = 2
, _ldpVerticalGap = 30
, _ldpWidth = FixedSelectionWidth 15
, _ldpSizeRestriction = SelectionSizeRestriction overflowit
, _ldpCursorType = BorderCursor (Set.fromList [North,South,West])
}
}
refreshOptionsSelectionList :: Universe -> Universe
refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
where
f sl = case sl of
OptionScreen {_scOptions = mops} -> sl & scSelectionList . slItems .~ optionsToSelections u mops
_ -> sl
makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionList
makeOptionsSelectionList mselpos u mos = SelectionList
{ _slPosX = 50
, _slPosY = 50
, _slScale = 2
, _slVerticalGap = 30
, _slItems = optionsToSelections u mos
, _slShownItems = []
, _slSelPos = mselpos
, _slCursorType = BorderCursor (Set.fromList [North,South,West])
, _slWidth = FixedSelectionWidth 15
, _slLength = length $ optionsToSelections u mos
, _slSizeRestriction = SelectionSizeRestriction overflowit
-- , _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
overflowit = SelectionItem
{ _siPictures = [text "MORE OPTIONS"]
@@ -64,9 +42,26 @@ makeOptionsSelectionList mselpos u mos = SelectionList
, _siOffX = 0
}
optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
optionsToSelections u ops = map colStrToSelItem colstrs
refreshOptionsSelectionList :: Universe -> Universe
refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
where
f sl = case sl of
OptionScreen {_scOptions = mops
, _scAvailableLines = maxlines}
-> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops
_ -> sl
makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList
makeOptionsSelectionList maxlines mselpos u mos = SelectionList
{ _slItems = optionsToSelections maxlines u mos
, _slSelPos = mselpos
, _slLength = length $ optionsToSelections maxlines u mos
}
optionsToSelections :: Int -> Universe -> [MenuOption] -> [SelectionItem]
optionsToSelections maxlines u allops = map colStrToSelItem colstrs
where
ops = take maxlines allops
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
colstrs = map (menuOptionToString u maxOptionLength) ops
src/Dodge/Render/HUD.hs
+35 -26
View File
@@ -49,34 +49,40 @@ drawInGameHUD subinv uv =
w = _uvWorld uv
cfig = _uvConfig uv
defaultListDisplayParams :: ListDisplayParams
defaultListDisplayParams = ListDisplayParams
{ _ldpVerticalGap = 10
, _ldpScale = 1
, _ldpPosX = 0
, _ldpPosY = 0
, _ldpCursorType = NoCursor
, _ldpWidth = FixedSelectionWidth 15
, _ldpSizeRestriction = NoSelectionSizeRestriction
}
defaultSelectionList :: SelectionList
defaultSelectionList = SelectionList
{ _slVerticalGap = 10
, _slScale = 1
, _slPosX = 0
, _slPosY = 0
, _slItems = []
, _slShownItems = []
{_slItems = []
, _slSelPos = Nothing
, _slCursorType = NoCursor
, _slWidth = FixedSelectionWidth 15
, _slLength = 0
, _slSizeRestriction = NoSelectionSizeRestriction
}
subInvListDisplayParams :: ListDisplayParams
subInvListDisplayParams = ListDisplayParams
{ _ldpVerticalGap = 10
, _ldpScale = 1
, _ldpPosX = subInvX
, _ldpPosY = 60
, _ldpCursorType = NoCursor
, _ldpWidth = FixedSelectionWidth 15
, _ldpSizeRestriction = NoSelectionSizeRestriction
}
subInvSelectionList :: SelectionList
subInvSelectionList = SelectionList
{ _slVerticalGap = 10
, _slScale = 1
, _slPosX = subInvX
, _slPosY = 60
, _slItems = []
, _slShownItems = []
{ _slItems = []
, _slSelPos = Nothing
, _slCursorType = NoCursor
, _slWidth = FixedSelectionWidth 15
, _slLength = 0
, _slSizeRestriction = NoSelectionSizeRestriction
}
inventorySelectionList :: World -> [SelectionItem]
@@ -98,18 +104,21 @@ inventoryCursorPos subinv w = case subinv of
CombineInventory {} -> Nothing
_ -> Just $ yourInvSel w
inventoryDisplay :: SubInventory -> Configuration -> World -> Picture
inventoryDisplay subinv cfig w = drawSelectionList cfig $
defaultSelectionList & slItems .~ inventorySelectionList w
& slWidth .~ FixedSelectionWidth topInvW
& slCursorType .~ BorderCursor (Set.fromList selcursortype)
& slSelPos .~ inventoryCursorPos subinv w
& slWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
invDisplayParams :: World -> ListDisplayParams
invDisplayParams w = defaultListDisplayParams
& ldpWidth .~ FixedSelectionWidth topInvW
& ldpCursorType .~ BorderCursor (Set.fromList selcursortype)
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
where
selcursortype
| ButtonRight `M.member` _mouseButtons (_input w) = [North,South,East,West]
| otherwise = [North,South,West]
inventoryDisplay :: SubInventory -> Configuration -> World -> Picture
inventoryDisplay subinv cfig w = drawSelectionList (invDisplayParams w) cfig $
defaultSelectionList & slItems .~ inventorySelectionList w
& slSelPos .~ inventoryCursorPos subinv w
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
@@ -160,7 +169,7 @@ drawSubInventory subinv cfig w = case subinv of
]
where
titledSub subtitle subitems extrapics = pictures $ [invHead cfig subtitle
,drawSelectionList cfig subitems] <>
,drawSelectionList subInvListDisplayParams cfig subitems] <>
extrapics
closeobjectcursor = case selectedCloseObject w of
Nothing -> mempty
src/Dodge/Render/List.hs
+17 -16
View File
@@ -15,36 +15,37 @@ import ListHelp
import Picture
import LensHelp
drawSelectionList :: Configuration -> SelectionList -> Picture
drawSelectionList cfig sl =
drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList -> Picture
drawSelectionList ldps cfig sl =
listPicturesAtScaleOff
(_slVerticalGap sl)
(_slScale sl)
(_slPosX sl)
(_slPosY sl)
(_ldpVerticalGap ldps)
(_ldpScale ldps)
(_ldpPosX ldps)
(_ldpPosY ldps)
cfig
0 --(_slOffset sl)
(makeSelectionListPictures sl)
<> drawSelectionCursor cfig sl
<> drawSelectionCursor ldps cfig sl
makeSelectionListPictures :: SelectionList -> [Picture]
makeSelectionListPictures sl = case sl ^. slSizeRestriction of
SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl
_ -> concatMap _siPictures $ _slItems sl
makeSelectionListPictures sl = concatMap _siPictures $ _slItems sl
--case sl ^. slSizeRestriction of
-- SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl
-- _ -> concatMap _siPictures $ _slItems sl
drawSelectionCursor :: Configuration -> SelectionList -> Picture
drawSelectionCursor cfig sl = fromMaybe mempty $ do
drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList -> Picture
drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do
i <- _slSelPos sl
selit <- filter _siIsSelectable lis !? i
f <- case _slCursorType sl of
BorderCursor cps -> Just $ listCursorChooseBorderScale (_slVerticalGap sl) (_slScale sl) cps
f <- case _ldpCursorType ldps of
BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
NoCursor -> Nothing
let j = sum . map _siHeight $ takeWhileArb (<= i) (\x itsel -> x + if _siIsSelectable itsel then 1 else 0) 0 lis
col = _siColor selit
return $ f (_slPosX sl + (9 * fromIntegral (_siOffX selit))) (_slPosY sl) cfig j col wdth (_siHeight selit)
return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) cfig j col wdth (_siHeight selit)
where
lis = _slItems sl
wdth = case _slWidth sl of
wdth = case _ldpWidth ldps of
FixedSelectionWidth x -> x
_ -> 1
src/Dodge/Render/MenuScreen.hs
+5 -4
View File
@@ -16,8 +16,8 @@ import Picture
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"
OptionScreen{_scTitle = titf, _scSelectionList = selpos, _scListDisplayParams = ldps} ->
drawOptions ldps cfig titf selpos "Use keys to navigate the menu"
-- (WaitScreen sf _) -> drawOptions w (sf w) [] 0 ""
(InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help
-- (DisplayScreen sd) -> sd w
@@ -77,6 +77,7 @@ drawInputMenu cfig title footer =
]
drawOptions ::
ListDisplayParams ->
Configuration ->
-- | Title
String ->
@@ -85,12 +86,12 @@ drawOptions ::
-- | Help Text
String ->
Picture
drawOptions cfig title sl footer =
drawOptions ldps cfig title sl footer =
pictures
[ darkenBackground cfig
, drawTitle cfig title
, drawFooterText cfig red footer
, drawSelectionList cfig sl
, drawSelectionList ldps cfig sl
]
darkenBackground :: Configuration -> Picture
src/Dodge/SelectionList.hs
+10 -8
View File
@@ -6,19 +6,21 @@ import Dodge.Data.Universe
import LensHelp
import Data.Maybe
setShownSelectionItems :: Configuration -> ScreenLayer -> ScreenLayer
setShownSelectionItems cfig sl = fromMaybe sl $ do
setShownSelectionItems :: ScreenLayer -> ScreenLayer
setShownSelectionItems sl = fromMaybe sl $ do
offset <- sl ^? scOffset
maxlines <- sl ^? scAvailableLines
return $ sl & scSelectionList %~ setShownSelectionItems' maxlines offset
return $ setShownSelectionItems' maxlines offset sl
setShownSelectionItems' :: Int -> Int -> SelectionList -> SelectionList
setShownSelectionItems' maxlines offset sl = case sl ^? slSizeRestriction of
setShownSelectionItems' :: Int -> Int -> ScreenLayer -> ScreenLayer
setShownSelectionItems' maxlines offset sl = case sl ^? scListDisplayParams . ldpSizeRestriction of
Just (SelectionSizeRestriction botit)
| length allitems > maxlines ->
sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
sl & scShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
++ [(botit,ScrollSelectionItem)]
_ -> sl & slShownItems .~ allitems
& scSelectionList . slItems .~ map fst ( take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
++ [(botit,ScrollSelectionItem)])
_ -> sl & scShownItems .~ allitems
where
-- dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem)
allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. slItems) [0..]
allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. scSelectionList . slItems) [0..]
src/Dodge/Update.hs
+22 -20
View File
@@ -98,7 +98,7 @@ mouseClickOptionsList mos screen u = fromMaybe u $ do
Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of
Just False -> fromMaybe u $ do
i <- sl ^. slSelPos
si <- sl ^? slShownItems . ix i . _2
si <- screen ^? scShownItems . ix i . _2
return $ maybe u ($ u) $ case si of
ListedSelectionItem j -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff)
ScrollSelectionItem -> do
@@ -109,18 +109,18 @@ mouseClickOptionsList mos screen u = fromMaybe u $ do
SpecialSelectionItem -> Just id
_ -> u
mouseOverSelectionList :: SelectionList -> Universe -> Universe
mouseOverSelectionList sl u
mouseOverSelectionList :: ListDisplayParams -> SelectionList -> Universe -> Universe
mouseOverSelectionList ldps sl u
| x > xl && x < xr && ylower == yupper && mmoving
&& ylower >= 0 && ylower < ymax = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper
| otherwise = u
where
ymax = maybe 0 length $ u ^? uvScreenLayers . _head . scSelectionList . slShownItems
ymax = maybe 0 length $ u ^? uvScreenLayers . _head . scSelectionList . slItems
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
ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50
yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50
xl = _ldpPosX ldps - hw
xr = xl + _ldpScale ldps * 15 * 9
V2 x y = u ^. uvWorld . input . mousePos
cfig = u ^. uvConfig
hh = halfHeight cfig
@@ -129,22 +129,23 @@ mouseOverSelectionList sl u
setSelectionListRestriction' :: Configuration -> ScreenLayer -> ScreenLayer
setSelectionListRestriction' cfig screen = fromMaybe screen $ do
sl <- screen ^? scSelectionList
return $ screen & scAvailableLines %~ const (setSelectionListRestriction cfig sl)
ldps <- screen ^? scListDisplayParams
return $ screen & scAvailableLines %~ const (setSelectionListRestriction ldps cfig sl)
setSelectionListRestriction :: Configuration -> SelectionList -> Int
setSelectionListRestriction cfig sl = nlines
setSelectionListRestriction :: ListDisplayParams -> Configuration -> SelectionList -> Int
setSelectionListRestriction ldps cfig sl = nlines
where
nlines = floor ((dToBot - vgap) / itmHeight)
vgap = sl ^. slVerticalGap
itmHeight = 10 * sl ^. slScale + vgap
dToBot = cfig ^. windowY - (sl ^. slPosY + dFromScreenBot)
vgap = ldps ^. ldpVerticalGap
itmHeight = 10 * ldps ^. ldpScale + vgap
dToBot = cfig ^. windowY - (ldps ^. ldpPosY + dFromScreenBot)
dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
updateUseInput :: Universe -> Universe
updateUseInput u = case u ^? uvScreenLayers . _head of
Just (InputScreen thetext _) -> doInputScreenInput thetext u
Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist}
-> optionScreenUpdate screen mos mop flag sellist u
Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps}
-> optionScreenUpdate screen mos mop flag ldps sellist u
-- Just ColumnsScreen{} -> u & uvScreenLayers %~ tail
_ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
@@ -153,15 +154,16 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
pkeys = u ^. uvWorld . input . pressedKeys
optionScreenUpdate :: ScreenLayer -> [MenuOption] -> Maybe MenuOption -> OptionScreenFlag
-> ListDisplayParams
-> SelectionList
-> Universe -> Universe
optionScreenUpdate screen mos mop _ sl u =
optionScreenUpdate screen mos mop _ ldps sl u =
optionScreenDefEff mop
. mouseClickOptionsList mos screen
. mouseOverSelectionList sl
. mouseOverSelectionList ldps sl
. menuWheelEvents
. over (uvScreenLayers . _head) (setSelectionListRestriction' cfig)
$ over (uvScreenLayers . _head) (setShownSelectionItems cfig)
$ over (uvScreenLayers . _head) setShownSelectionItems
u
where
cfig = u ^. uvConfig
@@ -306,7 +308,7 @@ functionalUpdate w =
menuWheelEvents :: Universe -> Universe
menuWheelEvents u = u & uvScreenLayers . _head . scSelectionList . slSelPos . _Just %~ (\y' -> (y' - y) `mod` ymax)
where
ymax = max 1 $ maybe 1 length (u ^? uvScreenLayers . _head . scSelectionList . slShownItems)
ymax = max 1 $ maybe 1 length (u ^? uvScreenLayers . _head . scSelectionList . slItems)
y = u ^. uvWorld . input . scrollAmount
updateWheelEvents :: World -> World
src/Dodge/WindowLayout.hs
-6
View File
@@ -1,6 +0,0 @@
module Dodge.WindowLayout where
import Dodge.Data.Config
availableMenuLines :: Configuration -> Int
availableMenuLines = floor . (/ 50) . subtract 125 . _windowY