130 lines
4.3 KiB
Haskell
130 lines
4.3 KiB
Haskell
module Dodge.Menu.Option (
|
|
initializeOptionMenu,
|
|
refreshOptionsSelectionList,
|
|
initializeOptionMenuBO,
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Data.Maybe
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.Universe
|
|
import Dodge.ListDisplayParams
|
|
import Dodge.SelectionList
|
|
import LensHelp
|
|
import Padding
|
|
import Picture.Base
|
|
|
|
initializeOptionMenu ::
|
|
String -> [MenuOption] -> EscapeMenuOption -> Universe -> ScreenLayer
|
|
initializeOptionMenu title ops pmo u =
|
|
OptionScreen
|
|
{ _scTitle = title
|
|
, _scOptions = ops
|
|
, _scOffset = 0
|
|
, _scPositionedMenuOption = pmo
|
|
, _scOptionFlag = NormalOptions
|
|
, _scSelectionList = optionsToSelections 10 u ops pmo
|
|
, _scAvailableLines = getAvailableListLines menuDisplayParams (u ^. uvConfig)
|
|
, _scDisplayTime = 0
|
|
}
|
|
|
|
-- BO = Bottom Option
|
|
initializeOptionMenuBO ::
|
|
String -> [MenuOption] -> String -> (Universe -> Universe) -> Universe -> ScreenLayer
|
|
initializeOptionMenuBO title ops str eff = initializeOptionMenu title ops pmo
|
|
where
|
|
pmo = BottomEscapeMenuOption $ (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 .~ optionsToSelections maxlines u mops pmo
|
|
_ -> sl
|
|
|
|
optionsToSelections ::
|
|
Int ->
|
|
Universe ->
|
|
[MenuOption] ->
|
|
EscapeMenuOption ->
|
|
[SelectionItem (Universe -> Universe, Universe -> Universe)]
|
|
optionsToSelections maxlines u allops pmo = case pmo of
|
|
NoEscapeMenuOption -> map (menuOptionToSelectionItem u maxOptionLength) ops
|
|
TopEscapeMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (mo : ops)
|
|
BottomEscapeMenuOption 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
|
|
|
|
optionValueOffset :: Universe -> MenuOption -> Int
|
|
optionValueOffset u mo = case _moString mo u of
|
|
MODStringOption s _ -> length s
|
|
_ -> 0
|
|
|
|
menuOptionToSelectionItem ::
|
|
Universe ->
|
|
Int ->
|
|
MenuOption ->
|
|
SelectionItem (Universe -> Universe, Universe -> Universe)
|
|
menuOptionToSelectionItem w padAmount mo =
|
|
SelectionItem
|
|
{ _siPictures = [optionText]
|
|
, _siHeight = 1
|
|
, _siWidth = 50
|
|
, _siIsSelectable = isselectable
|
|
, _siColor = thecol
|
|
, _siOffX = 0
|
|
, _siPayload = (f, g)
|
|
}
|
|
where
|
|
isselectable = case _moString mo w of
|
|
MODBlockedString{} -> False
|
|
_ -> True
|
|
f = fromMaybe id $ mo ^? moEff <|> mo ^? moEff1
|
|
g = fromMaybe id $ mo ^? moEff2
|
|
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
|