97 lines
3.2 KiB
Haskell
97 lines
3.2 KiB
Haskell
module Dodge.Menu.Option
|
|
where
|
|
--import Dodge.ScodeToChar
|
|
--import Data.Maybe
|
|
--import Dodge.WindowLayout
|
|
import Padding
|
|
import Picture.Base
|
|
import Dodge.Data.CardinalPoint
|
|
import Dodge.Data.SelectionList
|
|
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 =
|
|
OptionScreen
|
|
{ _scTitle = title
|
|
, _scOptions = ops
|
|
, _scOffset = 0
|
|
, _scMaybeOption = fmap (Toggle eff . const . MODString) defstr
|
|
, _scOptionFlag = NormalOptions
|
|
, _scSelectionList = makeOptionsSelectionList (Just 0) u ops
|
|
, _scAvailableLines = 10
|
|
}
|
|
|
|
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"]
|
|
, _siHeight = 1
|
|
, _siIsSelectable = True
|
|
, _siWidth = length "MORE OPTIONS"
|
|
, _siColor = white
|
|
, _siOffX = 0
|
|
}
|
|
|
|
optionsToSelections :: Universe -> [MenuOption] -> [SelectionItem]
|
|
optionsToSelections u ops = map colStrToSelItem colstrs
|
|
where
|
|
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
|
|
colstrs = map (menuOptionToString u maxOptionLength) ops
|
|
|
|
colStrToSelItem :: (Color,String) -> SelectionItem
|
|
colStrToSelItem (col,str) = SelectionItem
|
|
{ _siPictures = [color col $ text str]
|
|
, _siHeight = 1
|
|
, _siIsSelectable = True
|
|
, _siWidth = length str
|
|
, _siColor = col
|
|
, _siOffX = 0
|
|
}
|
|
|
|
optionValueOffset :: Universe -> MenuOption -> Int
|
|
optionValueOffset u mo = case _moString mo u of
|
|
MODStringOption s _ -> length s
|
|
_ -> 0
|
|
|
|
menuOptionToString :: Universe -> Int -> MenuOption -> (Color, String)
|
|
menuOptionToString w padAmount mo = (thecol, optionText)
|
|
where
|
|
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
|