Move selection list offset into option screen data structure
This commit is contained in:
@@ -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]
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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..]
|
||||||
|
|||||||
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user