diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 91e3c6f81..1922946b0 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -14,29 +14,15 @@ data ListDisplayParams = ListDisplayParams , _ldpVerticalGap :: Float , _ldpCursorType :: CursorType , _ldpWidth :: SelectionWidth - , _ldpSizeRestriction :: SelectionSizeRestriction +-- , _ldpSizeRestriction :: SelectionSizeRestriction } -data SelectionList = SelectionList - { _slItems :: [SelectionItem] +data SelectionList a = SelectionList + { _slItems :: [SelectionItem a] , _slSelPos :: Maybe Int , _slLength :: Int } -data SelectionItemIndex = ListedSelectionItem Int - | ScrollSelectionItem - | SpecialSelectionItem - -data SpecialSelectionItem = NoSpecialSelectionItem - | BottomSelectionItem {_bottomSelectionItem :: SelectionItem} - -data SelectionSizeRestriction = NoSelectionSizeRestriction - | SelectionSizeRestriction - { _overflowItemBottom :: SelectionItem - } - -newtype SSRType = SSRFromScreenBottom {_ssrFromScreenBottom :: Float} - data SelectionWidth = FixedSelectionWidth Int | VariableSelectionWidth (Int -> Int) | UseMaxSelectionItemWidth @@ -44,18 +30,16 @@ data SelectionWidth = FixedSelectionWidth Int data CursorType = NoCursor | BorderCursor (Set CardinalPoint) -data SelectionItem = SelectionItem +data SelectionItem a = SelectionItem { _siPictures :: [Picture] , _siHeight :: Int , _siIsSelectable :: Bool , _siWidth :: Int , _siColor :: Color , _siOffX :: Int + , _siPayload :: a } makeLenses ''ListDisplayParams makeLenses ''SelectionList makeLenses ''SelectionItem -makeLenses ''SpecialSelectionItem -makeLenses ''SelectionSizeRestriction -makeLenses ''SSRType diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index 5bdfba728..86dba797f 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -60,9 +60,9 @@ data ScreenLayer , _scOffset :: Int , _scPositionedMenuOption :: PositionedMenuOption , _scOptionFlag :: OptionScreenFlag - , _scSelectionList :: SelectionList + , _scSelectionList :: SelectionList (Universe -> Universe) , _scAvailableLines :: Int - , _scShownItems :: [(SelectionItem,SelectionItemIndex)] +-- , _scShownItems :: [(SelectionItem,SelectionItemIndex)] , _scListDisplayParams :: ListDisplayParams } | ColumnsScreen diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 6dc94ba20..aa5848a58 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -1,7 +1,7 @@ module Dodge.Menu.Option where --import Dodge.ScodeToChar ---import Data.Maybe +import Data.Maybe --import Dodge.WindowLayout import Dodge.SelectionList import Padding @@ -19,18 +19,8 @@ optionListDisplayParams = ListDisplayParams , _ldpScale = 2 , _ldpVerticalGap = 30 , _ldpWidth = FixedSelectionWidth 15 - , _ldpSizeRestriction = SelectionSizeRestriction overflowit , _ldpCursorType = BorderCursor (Set.fromList [North,South,West]) } - where - overflowit = SelectionItem - { _siPictures = [text "MORE OPTIONS"] - , _siHeight = 1 - , _siIsSelectable = True - , _siWidth = length "MORE OPTIONS" - , _siColor = white - , _siOffX = 0 - } initializeOptionMenu :: String -> [MenuOption] -> Maybe String -> (Universe -> Universe) -> Universe -> ScreenLayer initializeOptionMenu title ops defstr eff u = @@ -44,7 +34,6 @@ initializeOptionMenu title ops defstr eff u = , _scOptionFlag = NormalOptions , _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops , _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig) - , _scShownItems = [] , _scListDisplayParams = optionListDisplayParams } @@ -57,26 +46,30 @@ refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f -> sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops _ -> sl -makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList +makeOptionsSelectionList :: Int -> Maybe Int -> Universe -> [MenuOption] -> SelectionList (Universe -> Universe) 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 +optionsToSelections :: Int -> Universe -> [MenuOption] -> [SelectionItem (Universe -> Universe)] +optionsToSelections maxlines u allops = sits where ops | maxlines >= length allops = allops | otherwise = take (maxlines - 1) allops ++ [cycleOptionsOption] maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops) colstrs = map (menuOptionToString u maxOptionLength) ops + sits = map (menuOptionToSelectionItem u maxOptionLength) ops cycleOptionsOption = Toggle cycleOptions (const (MODString "MORE OPTIONS")) cycleOptions :: Universe -> Universe -cycleOptions = id +cycleOptions u = fromMaybe u $ do + screen <- u ^? uvScreenLayers . ix 0 + maxlines <- screen ^? scAvailableLines + return u -colStrToSelItem :: (Color,String) -> SelectionItem +colStrToSelItem :: (Color,String) -> SelectionItem (Universe -> Universe) colStrToSelItem (col,str) = SelectionItem { _siPictures = [color col $ text str] , _siHeight = 1 @@ -84,6 +77,7 @@ colStrToSelItem (col,str) = SelectionItem , _siWidth = length str , _siColor = col , _siOffX = 0 + , _siPayload = id } optionValueOffset :: Universe -> MenuOption -> Int @@ -91,6 +85,26 @@ optionValueOffset u mo = case _moString mo u of MODStringOption s _ -> length s _ -> 0 +menuOptionToSelectionItem :: Universe -> Int -> MenuOption -> SelectionItem (Universe -> Universe) +menuOptionToSelectionItem w padAmount mo = SelectionItem + { _siPictures = [color thecol $ text optionText] + , _siHeight = 1 + , _siIsSelectable = True + , _siWidth = length optionText + , _siColor = white + , _siOffX = 0 + , _siPayload = f + } + where + f = fromMaybe id $ mo ^? moEff + thecol = case _moString mo w of + MODBlockedString{} -> greyN 0.5 + _ -> white + optionText = case _moString mo w of + MODStringOption s t -> rightPad padAmount '.' s ++ t + x -> _modString x + + menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String) menuOptionToString w padAmount mo = (thecol, optionText) where diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index f4af355f1..bf5c1eb70 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -57,10 +57,9 @@ defaultListDisplayParams = ListDisplayParams , _ldpPosY = 0 , _ldpCursorType = NoCursor , _ldpWidth = FixedSelectionWidth 15 - , _ldpSizeRestriction = NoSelectionSizeRestriction } -defaultSelectionList :: SelectionList +defaultSelectionList :: SelectionList a defaultSelectionList = SelectionList {_slItems = [] , _slSelPos = Nothing @@ -75,19 +74,18 @@ subInvListDisplayParams = ListDisplayParams , _ldpPosY = 60 , _ldpCursorType = NoCursor , _ldpWidth = FixedSelectionWidth 15 - , _ldpSizeRestriction = NoSelectionSizeRestriction } -subInvSelectionList :: SelectionList +subInvSelectionList :: SelectionList a subInvSelectionList = SelectionList { _slItems = [] , _slSelPos = Nothing , _slLength = 0 } -inventorySelectionList :: World -> [SelectionItem] +inventorySelectionList :: World -> [SelectionItem ()] inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv) - ++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0] + ++ [SelectionItem displayFreeSlots 1 False (length thetext) white 0 ()] ++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects) where cr = you w @@ -324,21 +322,21 @@ determineInvSelCursorWidth w = case _rbOptions w of then 47 else topInvW -combineListSelection :: World -> SelectionList +combineListSelection :: World -> SelectionList () combineListSelection w = subInvSelectionList & slItems .~ combineListSelectionItems w -combineListSelectionItems :: World -> [SelectionItem] +combineListSelectionItems :: World -> [SelectionItem ()] combineListSelectionItems w = case combineListSelectionItems' w of - [] -> [SelectionItem [text thetext] 1 False (length thetext) white 0] + [] -> [SelectionItem [text thetext] 1 False (length thetext) white 0 ()] xs -> xs where thetext = "NO POSSIBLE COMBINATIONS" -combineListSelectionItems' :: World -> [SelectionItem] +combineListSelectionItems' :: World -> [SelectionItem ()] combineListSelectionItems' w = map (picsToSelectable 15 . itemText . snd) $ combineItemListYou w -ammoTweakSelectionItems :: Maybe Item -> [SelectionItem] +ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()] ammoTweakSelectionItems = textSelItems . ammoTweakStrings ammoTweakStrings :: Maybe Item -> [String] @@ -360,7 +358,7 @@ invHead cfig s = invDimColor :: Color invDimColor = greyN 0.7 -closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem +closeObjectToSelectionItem :: Int -> Either FloorItem Button -> SelectionItem () closeObjectToSelectionItem n e = SelectionItem { _siPictures = pics , _siHeight = length pics @@ -368,6 +366,7 @@ closeObjectToSelectionItem n e = SelectionItem , _siWidth = 15 , _siColor = col , _siOffX = 2 + , _siPayload = () } where (pics,col) = closeObjectToTextPictures' n e @@ -464,7 +463,7 @@ mapWall cfig thehud wl = mainListCursor :: Color -> Int -> Configuration -> Picture mainListCursor c = openCursorAt 120 c 5 0 -picsToSelectable :: Int -> [Picture] -> SelectionItem +picsToSelectable :: Int -> [Picture] -> SelectionItem () picsToSelectable wdth pics = SelectionItem { _siPictures = pics , _siHeight = length pics @@ -472,12 +471,13 @@ picsToSelectable wdth pics = SelectionItem , _siWidth = wdth , _siColor = white , _siOffX = 0 + , _siPayload = () } -textSelItems :: [String] -> [SelectionItem] +textSelItems :: [String] -> [SelectionItem ()] textSelItems = map (picsToSelectable 15 . (:[]) . text) -invSelectionItem :: Creature -> (Int,Item) -> SelectionItem +invSelectionItem :: Creature -> (Int,Item) -> SelectionItem () invSelectionItem cr (i,it) = SelectionItem { _siPictures = pics , _siHeight = length pics @@ -485,6 +485,7 @@ invSelectionItem cr (i,it) = SelectionItem , _siWidth = 15 , _siColor = col , _siOffX = 0 + , _siPayload = () } where col = _itInvColor it diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 97e61868b..304b083fe 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -14,7 +14,7 @@ import ListHelp import Picture --import LensHelp -drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList -> Picture +drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionList ldps cfig sl = listPicturesAtScaleOff (_ldpVerticalGap ldps) @@ -26,13 +26,13 @@ drawSelectionList ldps cfig sl = (makeSelectionListPictures sl) <> drawSelectionCursor ldps cfig sl -makeSelectionListPictures :: SelectionList -> [Picture] +makeSelectionListPictures :: SelectionList a -> [Picture] makeSelectionListPictures sl = concatMap _siPictures $ _slItems sl --case sl ^. slSizeRestriction of -- SelectionSizeRestriction {} -> concatMap (_siPictures . fst) $ _slShownItems sl -- _ -> concatMap _siPictures $ _slItems sl -drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList -> Picture +drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture drawSelectionCursor ldps cfig sl = fromMaybe mempty $ do i <- _slSelPos sl selit <- filter _siIsSelectable lis !? i diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index 97c265a67..10386fb88 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -82,7 +82,7 @@ drawOptions :: -- | Title String -> -- | Select position - SelectionList -> + SelectionList a -> -- | Help Text String -> Picture diff --git a/src/Dodge/SelectionList.hs b/src/Dodge/SelectionList.hs index fcd8f9b79..81f1245e1 100644 --- a/src/Dodge/SelectionList.hs +++ b/src/Dodge/SelectionList.hs @@ -6,25 +6,6 @@ import Dodge.Data.Universe import LensHelp import Data.Maybe -setShownSelectionItems :: ScreenLayer -> ScreenLayer -setShownSelectionItems sl = fromMaybe sl $ do - offset <- sl ^? scOffset - maxlines <- sl ^? scAvailableLines - return $ setShownSelectionItems' maxlines offset sl - -setShownSelectionItems' :: Int -> Int -> ScreenLayer -> ScreenLayer -setShownSelectionItems' maxlines offset sl = case sl ^? scListDisplayParams . ldpSizeRestriction of - Just (SelectionSizeRestriction botit) - | length allitems > maxlines -> - sl & scShownItems .~ take (maxlines - 2) (drop offset allitems) -- ++ repeat dummyitem)) - ++ [(botit,ScrollSelectionItem)] - & 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 ^. scSelectionList . slItems) [0..] - getAvailableListLines :: ListDisplayParams -> Configuration -> Int getAvailableListLines ldps cfig = nlines where diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 6f2c46a24..470f2d87f 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,7 +6,7 @@ Description : Simulation update -} module Dodge.Update (updateUniverse) where -import Dodge.Menu.Option +--import Dodge.Menu.Option import Dodge.SelectionList import Dodge.Data.SelectionList import Dodge.InputFocus @@ -98,18 +98,11 @@ 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 <- screen ^? scShownItems . ix i . _2 - return $ maybe u ($ u) $ case si of - ListedSelectionItem j -> fmap (refreshOptionsSelectionList .) (mos ^? ix j . moEff) - ScrollSelectionItem -> do - maxlines <- screen ^? scAvailableLines - alllines <- sl ^? slLength - Just $ uvScreenLayers . _head . scOffset %~ - (\x -> if x + maxlines - 2 >= alllines then 0 else x + maxlines - 2) - SpecialSelectionItem -> Just id + f <- sl ^? slItems . ix i . siPayload + return $ f u _ -> u -mouseOverSelectionList :: ListDisplayParams -> SelectionList -> Universe -> Universe +mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe mouseOverSelectionList ldps sl u | x > xl && x < xr && ylower == yupper && mmoving && ylower >= 0 && ylower < ymax = u & uvScreenLayers . _head . scSelectionList . slSelPos ?~ yupper @@ -145,7 +138,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of optionScreenUpdate :: ScreenLayer -> [MenuOption] -> PositionedMenuOption -> OptionScreenFlag -> ListDisplayParams - -> SelectionList + -> SelectionList (Universe -> Universe) -> Universe -> Universe optionScreenUpdate screen mos mop _ ldps sl u = optionScreenDefEff mop @@ -153,8 +146,8 @@ optionScreenUpdate screen mos mop _ ldps sl u = . mouseOverSelectionList ldps sl . menuWheelEvents . over (uvScreenLayers . _head) (setSelectionListRestriction' cfig) - $ over (uvScreenLayers . _head) setShownSelectionItems - u +-- $ over (uvScreenLayers . _head) setShownSelectionItems + $ u where cfig = u ^. uvConfig