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

Remove section-wide indentation

Browse Source
This commit is contained in:
justin
2024-11-24 10:52:20 +00:00
parent aca7ebd808
commit 9529185319
11 changed files with 110 additions and 178 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/SelectionList.hs
-3
View File
@@ -29,11 +29,8 @@ data SectionCursor = SectionCursor
data SelectionSection a = SelectionSection
{ _ssItems :: IntMap (SelectionItem a)
-- , _ssMinSize :: Int
, _ssOffset :: Int
, _ssShownItems :: [Picture]
, _ssIndent :: Int
, _ssDescriptor :: String
}
type IMSS a = IntMap (SelectionSection a)
src/Dodge/Default/World.hs
+2 -12
View File
@@ -175,13 +175,12 @@ defaultInvSections :: IM.IntMap (SelectionSection ())
defaultInvSections = IM.fromDistinctAscList $
zip
[-2 ..]
[ defaultSS & ssDescriptor .~ "STATUS"
[ defaultSS
& ssItems .~ IM.fromAscList [(0,SelectionItem ["STATUS"] 1 False white 0 ())]
, defaultFiltSection
, defaultInvSection
, defaultYouSection
, defaultFiltSection & ssIndent .~ 2
& ssDescriptor .~ "NEARBY"
, defaultFiltSection
, defaultCOSection
]
@@ -191,29 +190,20 @@ defaultSS =
{ _ssItems = mempty
, _ssOffset = 0
, _ssShownItems = []
, _ssIndent = 0
, _ssDescriptor = ""
}
defaultCOSection :: SelectionSection ()
defaultCOSection =
defaultSS
& ssIndent .~ 2
& ssDescriptor .~ "CLOSE OBJECTS"
defaultFiltSection :: SelectionSection a
defaultFiltSection =
defaultSS
& ssIndent .~ 0
& ssDescriptor .~ "INV"
defaultInvSection :: SelectionSection ()
defaultInvSection =
defaultSS
& ssDescriptor .~ "INVENTORY ITEMS"
defaultYouSection :: SelectionSection ()
defaultYouSection =
defaultSS
& ssIndent .~ 2
& ssDescriptor .~ "YOUR STATUS"
src/Dodge/DisplayInventory.hs
+56 -64
View File
@@ -1,21 +1,22 @@
-- {-# OPTIONS_GHC -fno-full-laziness #-}
{-# LANGUAGE TupleSections #-}
module Dodge.DisplayInventory (
toggleCombineInv,
updateInventoryPositioning,
updateCombinePositioning,
) where
import Data.Monoid
import qualified Data.List as List
import Dodge.CharacterEnums
import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Bifunctor
import qualified Data.IntMap.Strict as IM
import qualified Data.List as List
import Data.Maybe
import Data.Monoid
import Dodge.Base.You
import Dodge.CharacterEnums
import Dodge.Combine
import Dodge.Data.Combine
import Dodge.Data.Config
@@ -32,17 +33,15 @@ import ListHelp
import Picture.Base
toggleCombineInv :: Universe -> Universe
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} ->
uv & uvWorld . hud . hudElement . subInventory
.~ NoSubInventory --MouseInvNothing
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
toggleCombineInv uv = uv & case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} -> uvWorld . hud . hudElement . subInventory .~ NoSubInventory
_ -> uvWorld %~ enterCombineInv (uv ^. uvConfig)
updateCombinePositioning :: Universe -> Universe
updateCombinePositioning u =
u & uvWorld . hud . hudElement . subInventory . ciSections
updateCombinePositioning u = u
& uvWorld . hud . hudElement . subInventory . ciSections
%~ updateCombineSections (_uvWorld u) (_uvConfig u)
& checkCombineSelectionExists
& checkCombineSelectionExists
updateCombineSections ::
World ->
@@ -56,9 +55,7 @@ updateCombineSections w cfig =
(getAvailableListLines secondColumnParams cfig)
[(0, sclose), (-1, sfclose)]
where
filtcurs = case w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 of
Just (-1) -> [cFilledRect]
_ -> [cWireRect]
filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1)
(sfclose, sclose) =
filterSectionsPair
filtcurs
@@ -108,7 +105,7 @@ checkCombineSelectionExists u = fromMaybe u $ do
<|> Just (0, 0)
Just $ case u ^? uvWorld . hud . hudElement . subInventory . ciSections . ix i . ssItems . ix j of
Nothing ->
u & uvWorld . hud . hudElement . subInventory . ciSelection ?~ (0,-1)
u & uvWorld . hud . hudElement . subInventory . ciSelection ?~ (0, -1)
& uvWorld . hud . hudElement . subInventory . ciSelection
%~ scrollSelectionSections (-1) sss
_ -> u
@@ -128,32 +125,21 @@ updateDisplaySections w cfig =
displaySectionsSizes
mselpos
(getAvailableListLines (invDisplayParams w) cfig)
addorder
[filtinv, filtclose, invx, youx, closex]
where
mselpos = w ^? hud . hudElement . diSelection . _Just
addorder = case mselpos of
Just (-1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
Just (0, _) -> reverse [filtinv, filtclose, invx, youx, closex]
Just (1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
Just (2, _) -> reverse [filtinv, filtclose, closex, invx, youx]
Just (3, _) -> reverse [filtinv, filtclose, closex, invx, youx]
_ -> reverse [filtinv, filtclose, invx, closex, youx]
invfiltcurs = case mselpos ^? _Just . _1 of
Just (-1) -> [toEnum 219] -- filled rect
_ -> [toEnum 128] -- wire rect
invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
(sfinv, sinv) =
filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
w ^? hud . hudElement . diInvFilter . _Just
(filtinv, invx) = ((-1, sfinv), (0, sinv))
closefiltcurs = case mselpos ^? _Just . _1 of
Just (2) -> [toEnum 219] -- filled rect
_ -> [toEnum 128] -- wire rect
closefiltcurs = mselpos ^? _Just . _1 == Just 2
(sfclose, sclose) =
filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY" $
w ^? hud . hudElement . diCloseFilter . _Just
(filtclose, closex) = ((2, sfclose), (3, sclose))
youx = (1, youitems)
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 0 ()
thetext = displayFreeSlots (crNumFreeSlots cr)
closeitms =
IM.fromDistinctAscList . zip [0 ..] $
@@ -171,24 +157,23 @@ updateDisplaySections w cfig =
cr = you w
filterSectionsPair ::
String -> -- string at the end of the input
Bool -> -- check for whether filter is in focus, changes string at the end
(String -> SelectionItem a -> Bool) ->
IM.IntMap (SelectionItem a) ->
String ->
Maybe String ->
(IM.IntMap (SelectionItem a), IM.IntMap (SelectionItem a))
filterSectionsPair endstr filtfn itms filtdescription mfilt =
( filtsis
, itms'
)
filterSectionsPair infocus filtfn itms filtdescription mfilt =
(filtsis, itms')
where
filtcurs = if infocus then cFilledRect else cWireRect
filtsis = fold $ do
str <- mfilt
return $
IM.singleton
0
$ SelectionInfo
[filtdescription ++ " FILTER/" ++ str ++ endstr, numfiltitems]
[filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
2
True
white
@@ -234,22 +219,24 @@ doSectionSize ::
IM.IntMap Int -> -- sections already sized
IM.IntMap Int
doSectionSize extraavailable mintaken is sss done = fromMaybe done $ do
(v,others,k,ks) <- getsecusingis <|> getminsec
(v, others, k, ks) <- getsecusingis <|> getminsec
minv <- mintaken ^? ix k
let extradesired = v - minv
linesgiven = min extraavailable extradesired
return $ doSectionSize (extraavailable - linesgiven) mintaken ks others $ done
& at k ?~ linesgiven + minv
return $
doSectionSize (extraavailable - linesgiven) mintaken ks others $
done
& at k ?~ linesgiven + minv
where
getsecusingis = do
(k,ks) <- List.uncons is
let (my,s') = IM.updateLookupWithKey (\_ _ -> Nothing) k sss
(k, ks) <- List.uncons is
let (my, s') = IM.updateLookupWithKey (\_ _ -> Nothing) k sss
y <- my
return (y,s',k,ks)
return (y, s', k, ks)
getminsec = do
((k,v),s') <- IM.minViewWithKey sss
return (v,s',k,[])
((k, v), s') <- IM.minViewWithKey sss
return (v, s', k, [])
updateSectionsPositioning ::
(Int -> Int) -> -- for determining each sections minimum size
Maybe (Int, Int) ->
@@ -262,14 +249,18 @@ updateSectionsPositioning f mselpos allavailablelines lsss sss =
where
mss = IM.mapWithKey m sss
m k _ = do
(k',i) <- mselpos
(k', i) <- mselpos
guard $ k == k'
return i
ls = IM.fromList lsss
h = IM.intersectionWith ($)
lk = fromMaybe [] $ fmap ((:[]) . fst) mselpos
ssizes = sectionsSizes allavailablelines f
lk $ sectionsDesiredLines $ IM.intersectionWith (set ssItems) ls sss
lk = fromMaybe [] $ fmap ((: []) . fst) mselpos
ssizes =
sectionsSizes
allavailablelines
f
lk
$ sectionsDesiredLines $ IM.intersectionWith (set ssItems) ls sss
updateSection ::
IM.IntMap (SelectionItem a) ->
@@ -297,28 +288,33 @@ updateSection sis mcsel availablelines ss =
pos | pos == 0 || length allstrings <= availablelines -> 0
pos | pos - 1 < oldoffset -> pos - 1
pos | maxcsel == csel -> pos - availablelines + xselsize
pos | pos + 1 + xselsize - availablelines > oldoffset ->
pos
| pos + 1 + xselsize - availablelines > oldoffset ->
pos - availablelines + 1 + xselsize
_ | length allstrings - oldoffset < availablelines ->
_
| length allstrings - oldoffset < availablelines ->
length allstrings - availablelines
_ -> oldoffset
tweakfirst (x : xs)
| offset > 0 =
color moreupcolor (text (theindent ++ replicate 15 (toEnum 30))) :
--color moreupcolor (text (theindent ++ replicate 15 (toEnum 30))) :
color moreupcolor (text (replicate 15 (toEnum 30))) :
xs
| otherwise = x : xs
| otherwise = x : xs
tweakfirst [] = []
moreupcolor = fromMaybe white $ allstrings ^? ix offset . _1
shownitems
| length shownstrings > availablelines =
map h (take (availablelines - 1) shownstrings)
++ [color moredowncolor . text $ theindent ++ replicate 15 (toEnum 31)]
-- ++ [color moredowncolor . text $ theindent ++ replicate 15 (toEnum 31)]
++ [color moredowncolor . text $ replicate 15 (toEnum 31)]
| otherwise = map h shownstrings
moredowncolor = fromMaybe white $ allstrings ^? ix (offset + availablelines - 1) . _1
allstrings = listSelectionColorPicture sis
shownstrings = drop offset allstrings
h (_, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str
theindent = replicate (_ssIndent ss) ' '
--h (_, str) = translate (fromIntegral (_ssIndent ss) * 100) 0 str
h (_, str) = str
-- theindent = replicate (_ssIndent ss) ' '
listSelectionColorPicture :: Foldable t => t (SelectionItem a) -> [(Color, Picture)]
listSelectionColorPicture = foldMap f
@@ -351,11 +347,9 @@ enterCombineInv cfig w =
filtsection =
SelectionSection
{ _ssItems = mempty
-- , _ssMinSize = 0
, _ssOffset = 0
, -- , _ssMinSize = 0
_ssOffset = 0
, _ssShownItems = mempty
, _ssIndent = 0
, _ssDescriptor = "COMB FILTER"
}
combsection =
updateSection
@@ -364,11 +358,9 @@ enterCombineInv cfig w =
availablelines
SelectionSection
{ _ssItems = cm
-- , _ssMinSize = 5
, _ssOffset = 0
, -- , _ssMinSize = 5
_ssOffset = 0
, _ssShownItems = mempty
, _ssIndent = 0
, _ssDescriptor = "COMBINATIONS"
}
regexList :: String -> [String] -> Bool
src/Dodge/Inventory/SelectionList.hs
+1 -1
View File
@@ -59,7 +59,7 @@ closeObjectToSelectionItem e =
, _siIsSelectable = True
, --, _siWidth = 15
_siColor = col
, _siOffX = 2
, _siOffX = 0
, _siPayload = ()
}
where
src/Dodge/Menu/Option.hs
-11
View File
@@ -86,17 +86,6 @@ cycleOptions u = fromMaybe u $ do
| l + curoff >= n = 0
| otherwise = l + curoff
--colStrToSelItem :: (Color, String) -> SelectionItem (Universe -> Universe)
--colStrToSelItem (col, str) =
-- SelectionItem
-- { _siPictures = [str]
-- , _siHeight = 1
-- , _siIsSelectable = True
-- , _siColor = col
-- , _siOffX = 0
-- , _siPayload = id
-- }
optionValueOffset :: Universe -> MenuOption -> Int
optionValueOffset u mo = case _moString mo u of
MODStringOption s _ -> length s
src/Dodge/Render/HUD.hs
-11
View File
@@ -422,17 +422,6 @@ invHead cfig =
--textSelItems :: [String] -> [SelectionItem ()]
--textSelItems = map (picsToSelectable . (: []))
--picsToSelectable :: [String] -> SelectionItem ()
--picsToSelectable pics =
-- SelectionItem
-- { _siPictures = pics
-- , _siHeight = length pics
-- , _siIsSelectable = True
-- , _siColor = white
-- , _siOffX = 0
-- , _siPayload = ()
-- }
-- would be nice to add parameter to orient this with NSEW, cf cursor
selNumPos ::
Configuration ->
src/Dodge/Render/List.hs
+1 -2
View File
@@ -113,7 +113,6 @@ selSecDrawCursorAt ::
Picture
selSecDrawCursorAt xsize ldp curs sss (i, j) = fold $ do
yint <- selSecYint i j sss
xint <- sss ^? ix i . ssIndent
si <- sss ^? ix i . ssItems . ix j
return $
listCursorChooseBorderScale
@@ -121,7 +120,7 @@ selSecDrawCursorAt xsize ldp curs sss (i, j) = fold $ do
(ldp ^. ldpScale)
curs
yint
(xint + _siOffX si)
(_siOffX si)
(_siColor si)
xsize
(_siHeight si)
src/Dodge/SelectionSections/Draw.hs
+4 -5
View File
@@ -51,13 +51,12 @@ drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^
$ do
(i, j) <- msel
yint <- selSecYint i j sss
xint <- sss ^? ix i . ssIndent
ydown <- mextra
ssitms <- sss ^? ix i . ssItems
let selitms = fst . IM.split (j + ydown + 1) . snd . IM.split (j -1) $ ssitms
ysize = sum . fmap _siHeight $ selitms
maxoff = maximum . fmap _siOffX $ selitms
minoff = minimum . fmap _siOffX $ selitms
maxxoff = maximum . fmap _siOffX $ selitms
minxoff = minimum . fmap _siOffX $ selitms
let col = white
-- col <- fmap (_siColor . fst) $ IM.minView selitms
return $
@@ -66,7 +65,7 @@ drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^
(ldp ^. ldpScale)
curs
yint
(xint + minoff)
minxoff
col
(15 + maxoff - minoff)
(15 + maxxoff - minxoff)
ysize
src/Dodge/Update/Input/InGame.hs
+8 -6
View File
@@ -124,17 +124,18 @@ tryDropSelected mpos w = do
tryPickupSelected :: Maybe (Int,Int) -> World -> Maybe World
tryPickupSelected mpos w = do
guard $ maybe True (\(i,_) -> i == 0) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
let nfreeslots = crNumFreeSlots cr
-- cr <- w ^? cWorld . lWorld . creatures . ix 0
-- let nfreeslots = crNumFreeSlots cr
(3, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
OverInvDrag 3 x <- w ^? input . mouseContext
-- xs <- w ^? hud . hudElement . diSelectionExtra
-- OverInvDrag 3 x <- w ^? input . mouseContext
return w
-- return $ IS.foldr (dropItem cr) w xs
updateMouseReleaseInGame :: World -> World
updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDrag i mpos ->
--OverInvDrag i mpos ->
OverInvDrag _ mpos ->
input . mouseContext .~ MouseInGame $
fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected mpos w
-- OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
@@ -206,7 +207,8 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen mempty w) $ do
(i, j) <- w ^? hud . hudElement . diSelection . _Just
--(i, j) <- w ^? hud . hudElement . diSelection . _Just
(i, _) <- w ^? hud . hudElement . diSelection . _Just
xs <- w ^? hud . hudElement . diSelectionExtra
guard $ i == a && b `IS.member` xs
return $ setmichosen xs w