justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Allow selection items to have a payload

Browse Source
This commit is contained in:
justin
2022-12-24 00:28:04 +00:00
parent 5356d21778
commit a97c5ec8ef
8 changed files with 65 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
+5 -21
View File
@@ -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
src/Dodge/Data/Universe.hs
+2 -2
View File
@@ -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
src/Dodge/Menu/Option.hs
+31 -17
View File
@@ -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
src/Dodge/Render/HUD.hs
+16 -15
View File
@@ -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
src/Dodge/Render/List.hs
+3 -3
View File
@@ -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
src/Dodge/Render/MenuScreen.hs
+1 -1
View File
@@ -82,7 +82,7 @@ drawOptions ::
-- | Title
String ->
-- | Select position
SelectionList ->
SelectionList a ->
-- | Help Text
String ->
Picture
src/Dodge/SelectionList.hs
-19
View File
@@ -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
src/Dodge/Update.hs
+7 -14
View File
@@ -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