diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 5f3fdbb2c..569195de1 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -19,7 +19,6 @@ data SelectionList = SelectionList , _slWidth :: SelectionWidth , _slLength :: Int , _slSizeRestriction :: SelectionSizeRestriction --- , _slSpecialItem :: SpecialSelectionItem } data SelectionItemIndex = ListedSelectionItem Int @@ -31,10 +30,7 @@ data SpecialSelectionItem = NoSpecialSelectionItem data SelectionSizeRestriction = NoSelectionSizeRestriction | SelectionSizeRestriction - { _maxSelectionLines :: Int - , _overflowItemTop :: SelectionItem - , _overflowItemBottom :: SelectionItem - , _ssrType :: SSRType + { _overflowItemBottom :: SelectionItem } newtype SSRType = SSRFromScreenBottom {_ssrFromScreenBottom :: Float} diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index b1c667a6d..c6e570306 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -56,6 +56,7 @@ data ScreenLayer , _scMaybeOption :: Maybe MenuOption , _scOptionFlag :: OptionScreenFlag , _scSelectionList :: SelectionList + , _scAvailableLines :: Int } | ColumnsScreen { _scTitle :: String diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 7c9c01b47..f263667a3 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -2,7 +2,7 @@ module Dodge.Menu.Option where --import Dodge.ScodeToChar --import Data.Maybe -import Dodge.WindowLayout +--import Dodge.WindowLayout import Padding import Picture.Base import Dodge.Data.CardinalPoint @@ -20,6 +20,7 @@ slTitleOptionsEff title ops defstr eff u = , _scMaybeOption = fmap (Toggle eff . const . MODString) defstr , _scOptionFlag = NormalOptions , _scSelectionList = makeOptionsSelectionList (Just 0) u ops + , _scAvailableLines = 10 } refreshOptionsSelectionList :: Universe -> Universe @@ -29,9 +30,6 @@ refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f OptionScreen {_scOptions = mops} -> sl & scSelectionList . slItems .~ optionsToSelections u mops _ -> sl - ---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 @@ -44,8 +42,7 @@ makeOptionsSelectionList mselpos u mos = SelectionList , _slCursorType = BorderCursor (Set.fromList [North,South,West]) , _slWidth = FixedSelectionWidth 15 , _slLength = length $ optionsToSelections u mos - , _slSizeRestriction = SelectionSizeRestriction (availableMenuLines cfig) overflowit overflowit - (SSRFromScreenBottom 5) + , _slSizeRestriction = SelectionSizeRestriction overflowit -- , _slSpecialItem = fromMaybe NoSpecialSelectionItem $ do -- str <- defstr -- return $ BottomSelectionItem SelectionItem @@ -58,7 +55,6 @@ makeOptionsSelectionList mselpos u mos = SelectionList -- } } where - cfig = u ^. uvConfig overflowit = SelectionItem { _siPictures = [text "MORE OPTIONS"] , _siHeight = 1 diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index c2458bef6..f2e1fba5b 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -1,18 +1,20 @@ module Dodge.SelectionList where --import Color +--import Dodge.WindowLayout import Dodge.Data.Universe import LensHelp import Data.Maybe -setShownSelectionItems :: ScreenLayer -> ScreenLayer -setShownSelectionItems sl = fromMaybe sl $ do +setShownSelectionItems :: Configuration -> ScreenLayer -> ScreenLayer +setShownSelectionItems cfig sl = fromMaybe sl $ do offset <- sl ^? scOffset - return $ sl & scSelectionList %~ setShownSelectionItems' offset + maxlines <- sl ^? scAvailableLines + return $ sl & scSelectionList %~ setShownSelectionItems' maxlines offset -setShownSelectionItems' :: Int -> SelectionList -> SelectionList -setShownSelectionItems' offset sl = case sl ^? slSizeRestriction of - Just (SelectionSizeRestriction maxlines _ botit _) +setShownSelectionItems' :: Int -> Int -> SelectionList -> SelectionList +setShownSelectionItems' maxlines offset sl = case sl ^? slSizeRestriction of + Just (SelectionSizeRestriction botit) | length allitems > maxlines -> sl & slShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem)) ++ [(botit,ScrollSelectionItem)] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 993d3a461..107559b35 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,7 +6,6 @@ Description : Simulation update -} module Dodge.Update (updateUniverse) where ---import Dodge.Menu.Option import Dodge.Menu.Option import Dodge.SelectionList import Dodge.Data.SelectionList @@ -93,15 +92,17 @@ gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command" -mouseClickOptionsList :: [MenuOption] -> SelectionList -> Universe -> Universe -mouseClickOptionsList mos sl u = case u ^. uvWorld . input . mouseButtons . at ButtonLeft of +mouseClickOptionsList :: [MenuOption] -> ScreenLayer -> Universe -> Universe +mouseClickOptionsList mos screen u = fromMaybe u $ do + sl <- screen ^? scSelectionList + Just $ 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 -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff) ScrollSelectionItem -> do - maxlines <- sl ^? slSizeRestriction . maxSelectionLines + maxlines <- screen ^? scAvailableLines alllines <- sl ^? slLength Just $ uvScreenLayers . _head . scOffset %~ (\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2) @@ -125,20 +126,25 @@ mouseOverSelectionList sl u hh = halfHeight cfig hw = halfWidth cfig -setSelectionListRestriction :: Configuration -> SelectionList -> SelectionList -setSelectionListRestriction cfig sl = sl & slSizeRestriction . maxSelectionLines %~ const nlines +setSelectionListRestriction' :: Configuration -> ScreenLayer -> ScreenLayer +setSelectionListRestriction' cfig screen = fromMaybe screen $ do + sl <- screen ^? scSelectionList + return $ screen & scAvailableLines %~ const (setSelectionListRestriction cfig sl) + +setSelectionListRestriction :: Configuration -> SelectionList -> Int +setSelectionListRestriction cfig sl = nlines where nlines = floor ((dToBot - vgap) / itmHeight) vgap = sl ^. slVerticalGap itmHeight = 10 * sl ^. slScale + vgap dToBot = cfig ^. windowY - (sl ^. slPosY + dFromScreenBot) - dFromScreenBot = fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom + 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 OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist} - -> optionScreenUpdate mos mop flag sellist u + Just screen@OptionScreen{_scOptions = mos, _scMaybeOption = mop, _scOptionFlag = flag, _scSelectionList = sellist} + -> optionScreenUpdate screen mos mop flag 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 @@ -146,16 +152,16 @@ updateUseInput u = case u ^? uvScreenLayers . _head of where pkeys = u ^. uvWorld . input . pressedKeys -optionScreenUpdate :: [MenuOption] -> Maybe MenuOption -> OptionScreenFlag +optionScreenUpdate :: ScreenLayer -> [MenuOption] -> Maybe MenuOption -> OptionScreenFlag -> SelectionList -> Universe -> Universe -optionScreenUpdate mos mop _ sl u = +optionScreenUpdate screen mos mop _ sl u = optionScreenDefEff mop - . mouseClickOptionsList mos sl + . mouseClickOptionsList mos screen . mouseOverSelectionList sl . menuWheelEvents - . over (uvScreenLayers . _head . scSelectionList) (setSelectionListRestriction cfig) - $ over (uvScreenLayers . _head) setShownSelectionItems + . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig) + $ over (uvScreenLayers . _head) (setShownSelectionItems cfig) u where cfig = u ^. uvConfig