Move selection list offset into option screen data structure

This commit is contained in:
2022-12-22 10:27:01 +00:00
parent 91d65094c9
commit a8fa1e9949
7 changed files with 14 additions and 11 deletions
-1
View File
@@ -10,7 +10,6 @@ import Dodge.Data.CardinalPoint
data SelectionList = SelectionList data SelectionList = SelectionList
{ _slPosX :: Float { _slPosX :: Float
, _slPosY :: Float , _slPosY :: Float
, _slOffset :: Int
, _slScale :: Float , _slScale :: Float
, _slVerticalGap :: Float , _slVerticalGap :: Float
, _slItems :: [SelectionItem] , _slItems :: [SelectionItem]
+1
View File
@@ -52,6 +52,7 @@ data ScreenLayer
= OptionScreen = OptionScreen
{ _scTitle :: String { _scTitle :: String
, _scOptions :: [MenuOption] , _scOptions :: [MenuOption]
, _scOffset :: Int
, _scMaybeOption :: Maybe MenuOption , _scMaybeOption :: Maybe MenuOption
, _scOptionFlag :: OptionScreenFlag , _scOptionFlag :: OptionScreenFlag
, _scSelectionList :: SelectionList , _scSelectionList :: SelectionList
+1 -1
View File
@@ -16,6 +16,7 @@ slTitleOptionsEff title ops defstr eff u =
OptionScreen OptionScreen
{ _scTitle = title { _scTitle = title
, _scOptions = ops , _scOptions = ops
, _scOffset = 0
, _scMaybeOption = fmap (Toggle eff . const . MODString) defstr , _scMaybeOption = fmap (Toggle eff . const . MODString) defstr
, _scOptionFlag = NormalOptions , _scOptionFlag = NormalOptions
, _scSelectionList = makeOptionsSelectionList (Just 0) u ops , _scSelectionList = makeOptionsSelectionList (Just 0) u ops
@@ -35,7 +36,6 @@ makeOptionsSelectionList :: Maybe Int -> Universe -> [MenuOption] -> SelectionLi
makeOptionsSelectionList mselpos u mos = SelectionList makeOptionsSelectionList mselpos u mos = SelectionList
{ _slPosX = 50 { _slPosX = 50
, _slPosY = 50 , _slPosY = 50
, _slOffset = 0
, _slScale = 2 , _slScale = 2
, _slVerticalGap = 30 , _slVerticalGap = 30
, _slItems = optionsToSelections u mos , _slItems = optionsToSelections u mos
-2
View File
@@ -55,7 +55,6 @@ defaultSelectionList = SelectionList
, _slScale = 1 , _slScale = 1
, _slPosX = 0 , _slPosX = 0
, _slPosY = 0 , _slPosY = 0
, _slOffset = 0
, _slItems = [] , _slItems = []
, _slShownItems = [] , _slShownItems = []
, _slSelPos = Nothing , _slSelPos = Nothing
@@ -71,7 +70,6 @@ subInvSelectionList = SelectionList
, _slScale = 1 , _slScale = 1
, _slPosX = subInvX , _slPosX = subInvX
, _slPosY = 60 , _slPosY = 60
, _slOffset = 0
, _slItems = [] , _slItems = []
, _slShownItems = [] , _slShownItems = []
, _slSelPos = Nothing , _slSelPos = Nothing
+9 -4
View File
@@ -1,11 +1,17 @@
module Dodge.SelectionList where module Dodge.SelectionList where
--import Color --import Color
import Dodge.Data.SelectionList import Dodge.Data.Universe
import LensHelp import LensHelp
import Data.Maybe
setShownSelectionItems :: SelectionList -> SelectionList setShownSelectionItems :: ScreenLayer -> ScreenLayer
setShownSelectionItems sl = case sl ^? slSizeRestriction of setShownSelectionItems sl = fromMaybe sl $ do
offset <- sl ^? scOffset
return $ sl & scSelectionList %~ setShownSelectionItems' offset
setShownSelectionItems' :: Int -> SelectionList -> SelectionList
setShownSelectionItems' offset sl = case sl ^? slSizeRestriction of
Just (SelectionSizeRestriction maxlines _ botit _) Just (SelectionSizeRestriction maxlines _ botit _)
| length allitems > maxlines -> | length allitems > maxlines ->
sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem)) sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem))
@@ -13,5 +19,4 @@ setShownSelectionItems sl = case sl ^? slSizeRestriction of
_ -> sl & slShownItems .~ allitems _ -> sl & slShownItems .~ allitems
where where
-- dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem) -- dummyitem = (SelectionItem [] 1 False 0 white 0, DummySelectionItem)
offset = sl ^. slOffset
allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. slItems) [0..] allitems = zipWith (\x y -> (x,ListedSelectionItem y)) (sl ^. slItems) [0..]
+1 -1
View File
@@ -8,7 +8,7 @@ import qualified Data.Map.Strict as M
testStringInit :: Universe -> [String] testStringInit :: Universe -> [String]
testStringInit u = testStringInit u =
[ show $ u ^? uvScreenLayers . _head . scSelectionList . slOffset [ show $ u ^? uvScreenLayers . _head . scOffset
] ]
++ [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos ++ [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
] ]
+2 -2
View File
@@ -103,7 +103,7 @@ mouseClickOptionsList mos sl u = case u ^. uvWorld . input . mouseButtons . at B
ScrollSelectionItem -> do ScrollSelectionItem -> do
maxlines <- sl ^? slSizeRestriction . maxSelectionLines maxlines <- sl ^? slSizeRestriction . maxSelectionLines
alllines <- sl ^? slLength alllines <- sl ^? slLength
Just $ uvScreenLayers . _head . scSelectionList . slOffset %~ Just $ uvScreenLayers . _head . scOffset %~
(\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2) (\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2)
SpecialSelectionItem -> Just id SpecialSelectionItem -> Just id
_ -> u _ -> u
@@ -155,7 +155,7 @@ optionScreenUpdate mos mop _ sl u =
. mouseOverSelectionList sl . mouseOverSelectionList sl
. menuWheelEvents . menuWheelEvents
. over (uvScreenLayers . _head . scSelectionList) (setSelectionListRestriction cfig) . over (uvScreenLayers . _head . scSelectionList) (setSelectionListRestriction cfig)
$ over (uvScreenLayers . _head . scSelectionList) setShownSelectionItems $ over (uvScreenLayers . _head) setShownSelectionItems
u u
where where
cfig = u ^. uvConfig cfig = u ^. uvConfig