150 lines
5.1 KiB
Haskell
150 lines
5.1 KiB
Haskell
module Dodge.Menu.Option where
|
|
|
|
--import Dodge.ScodeToChar
|
|
import Dodge.Default.SelectionList
|
|
import Data.Maybe
|
|
--import Dodge.WindowLayout
|
|
|
|
import Dodge.Data.CardinalPoint
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.Universe
|
|
import Dodge.SelectionList
|
|
import LensHelp
|
|
import Padding
|
|
import Picture.Base
|
|
|
|
optionListDisplayParams :: ListDisplayParams
|
|
optionListDisplayParams =
|
|
ListDisplayParams
|
|
{ _ldpPosX = 50
|
|
, _ldpPosY = 50
|
|
, _ldpScale = 2
|
|
, _ldpVerticalGap = 30
|
|
, _ldpWidth = FixedSelectionWidth 25
|
|
, _ldpCursorType = BorderCursor [North, South, West]
|
|
}
|
|
|
|
initializeOptionMenu :: String -> [MenuOption] -> PositionedMenuOption -> Universe -> ScreenLayer
|
|
initializeOptionMenu title ops pmo u =
|
|
OptionScreen
|
|
{ _scTitle = title
|
|
, _scOptions = ops
|
|
, _scOffset = 0
|
|
, _scPositionedMenuOption = pmo
|
|
, _scOptionFlag = NormalOptions
|
|
, _scSelectionList = makeOptionsSelectionList 10 (Just 0) u ops pmo
|
|
, _scAvailableLines = getAvailableListLines optionListDisplayParams (u ^. uvConfig)
|
|
, _scListDisplayParams = optionListDisplayParams
|
|
}
|
|
|
|
-- BO = Bottom Option
|
|
initializeOptionMenuBO :: String -> [MenuOption] -> String -> (Universe -> Universe) -> Universe -> ScreenLayer
|
|
initializeOptionMenuBO title ops str eff = initializeOptionMenu title ops pmo
|
|
where
|
|
pmo = BottomMenuOption $ (Toggle eff . const . MODString) str
|
|
|
|
refreshOptionsSelectionList :: Universe -> Universe
|
|
refreshOptionsSelectionList u = u & uvScreenLayers . ix 0 %~ f
|
|
where
|
|
f sl = case sl of
|
|
OptionScreen
|
|
{ _scOptions = mops
|
|
, _scPositionedMenuOption = pmo
|
|
, _scAvailableLines = maxlines
|
|
} ->
|
|
sl & scSelectionList . slItems .~ optionsToSelections maxlines u mops pmo
|
|
_ -> sl
|
|
|
|
makeOptionsSelectionList ::
|
|
Int ->
|
|
Maybe Int ->
|
|
Universe ->
|
|
[MenuOption] ->
|
|
PositionedMenuOption ->
|
|
SelectionList (Universe -> Universe)
|
|
makeOptionsSelectionList maxlines mselpos u mos pmo =
|
|
defaultSelectionList
|
|
{ _slItems = optionsToSelections maxlines u mos pmo
|
|
, _slSelPos = mselpos
|
|
}
|
|
|
|
optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)]
|
|
optionsToSelections maxlines u allops pmo = case pmo of
|
|
NoPositionedMenuOption -> map (menuOptionToSelectionItem u maxOptionLength) ops
|
|
TopMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (mo : ops)
|
|
BottomMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (ops ++ [mo])
|
|
where
|
|
offset = fromMaybe 0 $ u ^? uvScreenLayers . _head . scOffset
|
|
ops
|
|
| maxlines >= length allops = allops
|
|
| otherwise = take (maxlines - 2) (drop offset allops ++ repeat dummyMenuOption) ++ [cycleOptionsOption]
|
|
maxOptionLength = 3 + maximum (0 : map (optionValueOffset u) ops)
|
|
cycleOptionsOption = Toggle cycleOptions (const (MODString ("MORE OPTIONS " ++ show n ++ "/" ++ show m)))
|
|
l = length allops
|
|
m = div (l - 1) (max 1 (maxlines - 2)) + 1
|
|
n = div (offset + 1) (max 1 (maxlines - 2)) + 1
|
|
|
|
dummyMenuOption :: MenuOption
|
|
dummyMenuOption = Toggle id (const $ MODBlockedString "")
|
|
|
|
cycleOptions :: Universe -> Universe
|
|
cycleOptions u = fromMaybe u $ do
|
|
screen <- u ^? uvScreenLayers . _head
|
|
maxlines <- screen ^? scAvailableLines
|
|
numoptions <- fmap length $ screen ^? scOptions
|
|
return $ u & uvScreenLayers . _head . scOffset %~ f numoptions (maxlines - 2)
|
|
where
|
|
f n l curoff
|
|
| l + curoff >= n = 0
|
|
| otherwise = l + curoff
|
|
|
|
colStrToSelItem :: (Color, String) -> SelectionItem (Universe -> Universe)
|
|
colStrToSelItem (col, str) =
|
|
SelectionItem
|
|
{ _siPictures = [str]
|
|
, _siHeight = 1
|
|
, _siIsSelectable = True
|
|
, _siWidth = length str
|
|
, _siColor = col
|
|
, _siOffX = 0
|
|
, _siPayload = id
|
|
}
|
|
|
|
optionValueOffset :: Universe -> MenuOption -> Int
|
|
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 = [optionText]
|
|
, _siHeight = 1
|
|
, _siIsSelectable = isselectable
|
|
, _siWidth = length optionText
|
|
, _siColor = thecol
|
|
, _siOffX = 0
|
|
, _siPayload = f
|
|
}
|
|
where
|
|
isselectable = case _moString mo w of
|
|
MODBlockedString{} -> False
|
|
_ -> True
|
|
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
|
|
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
|