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

Unify regex/filtering code

Browse Source
This commit is contained in:
justin
2024-10-26 00:01:12 +01:00
parent 46ee29f646
commit dc34172691
6 changed files with 316 additions and 306 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ghcidOutput
+1 -7
View File
@@ -1,7 +1 @@
/home/justin/Haskell/loop/src/Dodge/DisplayInventory.hs:(134,16)-(136,62): warning: [GHC-62161] [-Wincomplete-patterns]
Pattern match(es) are non-exhaustive
In a case alternative:
Patterns of type ‘a’ not matched: p where p is not one of {(-1), 2}
|
134 | mstr = case i of
| ^^^^^^^^^...
All good (595 modules, at 00:00:33)
src/Dodge/Data/SelectionList.hs
+1 -16
View File
@@ -1,6 +1,4 @@
{-# LANGUAGE StrictData #-}
--{-# LANGUAGE DeriveGeneric #-}
--{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.SelectionList where
@@ -12,9 +10,6 @@ import Dodge.Data.CardinalPoint
import Dodge.Data.ScreenPos
import Picture.Data
--import Data.Aeson
--import Data.Aeson.TH
data ListDisplayParams = ListDisplayParams
{ _ldpPos :: ScreenPos
, _ldpScale :: Float
@@ -23,9 +18,7 @@ data ListDisplayParams = ListDisplayParams
}
data CursorDisplay
= BoundaryCursor
{ _cursSides :: [CardinalPoint]
}
= BoundaryCursor {_cursSides :: [CardinalPoint]}
| BackdropCursor
data SelectionList a = SelectionList
@@ -33,10 +26,6 @@ data SelectionList a = SelectionList
, _slSelPos :: Maybe Int
}
--data SelectionSections a = SelectionSections
-- { _sssSections :: IntMap (SelectionSection a)
-- }
data SectionCursor = SectionCursor
{ _scurPos :: Int
, _scurSize :: Int
@@ -81,9 +70,5 @@ makeLenses ''ListDisplayParams
makeLenses ''SelectionList
makeLenses ''SelectionItem
makeLenses ''SelectionSection
--makeLenses ''SelectionSections
makeLenses ''SectionCursor
makeLenses ''CursorDisplay
--deriveJSON defaultOptions ''SelectionItem
--deriveJSON defaultOptions ''SelectionList
src/Dodge/Default/World.hs
-7
View File
@@ -168,17 +168,10 @@ defaultDisplayInventory =
, _diSections = defaultInvSections
, _diSelection = Just (1,0)
, _diSelectionExtra = 0
-- , _diFilters = IM.fromList [(-1, mempty), (2, mempty)]
, _diInvFilter = mempty
, _diCloseFilter = mempty
}
--defaultSSSExtra :: SSSExtra
--defaultSSSExtra =
-- SSSExtra
-- { _sssFilters = IM.fromList [(-1, mempty), (2, mempty)]
-- }
defaultInvSections :: IM.IntMap (SelectionSection ())
defaultInvSections = IM.fromDistinctAscList $
zip
src/Dodge/DisplayInventory.hs
+88 -54
View File
@@ -1,4 +1,4 @@
--{-# OPTIONS_GHC -fno-full-laziness #-}
-- {-# OPTIONS_GHC -fno-full-laziness #-}
module Dodge.DisplayInventory (
toggleCombineInv,
updateInventoryPositioning,
@@ -42,31 +42,36 @@ updateCombineSections ::
IM.IntMap (SelectionSection CombinableItem) ->
IM.IntMap (SelectionSection CombinableItem)
updateCombineSections w cfig =
updateSectionsPositioning
mselpos
availablelines
[(0, showncombs), (-1, filtinv)]
updateSectionsPositioning
(w ^? hud . hudElement . subInventory . ciSelection . _Just)
(getAvailableListLines secondColumnParams cfig)
[(0, sclose), (-1, sfclose)]
where
mselpos = w ^? hud . hudElement . subInventory . ciSelection . _Just
availablelines = getAvailableListLines secondColumnParams cfig
(sfclose,sclose) = filterSectionsPair (flip (andOrRegex $ regexCombs invitms))
allcombs "COMBINATIONS" $ mstr
invitms = fromMaybe mempty $ w ^? hud . hudElement . diSections . ix 0 . ssItems
allcombs = IM.fromDistinctAscList $ zip [0 ..] $ combineList w
filtcombs = fromMaybe allcombs $ do
str <- mstr
invitms <- w ^? hud . hudElement . diSections . ix 0 . ssItems
return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
showncombs
| null filtcombs =
IM.singleton 0 $
SelectionInfo ["No possible combinations"] 1 False white 0
| otherwise = filtcombs
filtinv = fromMaybe mempty $ do
str <- mstr
return $
IM.singleton
0
(SelectionInfo ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
-- filtcombs = fromMaybe allcombs $ do
-- str <- mstr
-- invitms <- w ^? hud . hudElement . diSections . ix 0 . ssItems
-- return $ IM.filter (flip (andOrRegex $ regexCombs invitms) str) allcombs
-- showncombs
-- | null filtcombs =
-- IM.singleton 0 $
-- SelectionInfo ["No possible combinations"] 1 False white 0
-- | otherwise = filtcombs
-- filterdisplay = fromMaybe mempty $ do
-- str <- mstr
-- return $
-- IM.singleton 0 $
-- SelectionInfo
-- ["COMBINATIONS FILTER: " ++ str, numfiltitems]
-- 2
-- True
-- white
-- 0
mstr = w ^? hud . hudElement . subInventory . ciFilter . _Just
numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
-- numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
regexCombs :: IM.IntMap (SelectionItem ()) -> SelectionItem CombinableItem -> String -> Bool
regexCombs inv ci str = case str of
@@ -96,12 +101,11 @@ updateDisplaySections ::
Configuration ->
IM.IntMap (SelectionSection ()) ->
IM.IntMap (SelectionSection ())
updateDisplaySections w cfig sss =
updateSectionsPositioning
mselpos
availablelines
addorder
sss
updateDisplaySections w cfig =
updateSectionsPositioning
mselpos
(getAvailableListLines (invDisplayParams w) cfig)
addorder
where
mselpos = w ^? hud . hudElement . diSelection . _Just
addorder = case mselpos of
@@ -110,40 +114,70 @@ updateDisplaySections w cfig sss =
Just (1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
Just (2, _) -> reverse [filtinv, filtclose, closex, invx, youx]
_ -> reverse [filtinv, filtclose, closex, invx, youx]
(filtinv, invx) = filtpair (-1) invitems' "INV. "
(filtclose, closex) = filtpair 2 coitems' "NEARBY "
(sfinv,sinv) = filterSectionsPair plainRegex invitems "INVTORY" $
w ^? hud . hudElement . diInvFilter . _Just
(filtinv, invx) = ((-1,sfinv),(0,sinv))
-- filtpair (-1) invitems "INV. " $
-- w ^? hud . hudElement . diInvFilter . _Just
(sfclose,sclose) = filterSectionsPair plainRegex coitems "NEARBY" $
w ^? hud . hudElement . diCloseFilter . _Just
(filtclose, closex) = ((2,sfclose),(3,sclose))
-- filtpair 2 coitems "NEARBY " $
-- w ^? hud . hudElement . diCloseFilter . _Just
youx = (1, youitems)
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
thetext = displayFreeSlots nfreeslots
availablelines = getAvailableListLines (invDisplayParams w) cfig
coitems' =
coitems =
IM.fromDistinctAscList . zip [0 ..] $
map closeObjectToSelectionItem (w ^. hud . closeObjects)
invitems' =
invitems =
IM.mapWithKey
(\k (y, x) -> invSelectionItem cr k (x ^. locLDT . ldtValue) y)
invlocs
(\k (y, x) -> invSelectionItem y cr k (x ^. locLDT . ldtValue))
(allInvLocs $ _crInv cr)
cr = you w
invlocs = allInvLocs $ _crInv (you w)
nfreeslots = crNumFreeSlots cr
filtpair i itms filtdescription =
( (i, filtsis)
, (i + 1, itms')
)
where
mstr = case i of
(-1) -> w ^? hud . hudElement . diInvFilter . _Just
2 -> w ^? hud . hudElement . diCloseFilter . _Just
filtsis = fromMaybe mempty $ do
str <- mstr
return $
IM.singleton
-- filtpair i itms filtdescription mstr =
-- ( (i, filtsis)
-- , (i + 1, itms')
-- )
-- where
-- filtsis = fromMaybe mempty $ do
-- str <- mstr
-- return $
-- IM.singleton
-- 0
-- (SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
-- itms' = fromMaybe itms $ do
-- str <- mstr
-- return $ IM.filter (plainRegex str) itms
-- numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
filterSectionsPair ::
(String -> SelectionItem a -> Bool) ->
IM.IntMap (SelectionItem a) ->
String ->
Maybe String ->
(IM.IntMap (SelectionItem a), IM.IntMap (SelectionItem a))
filterSectionsPair filtfn itms filtdescription mfilt =
( filtsis
, itms'
)
where
filtsis = fromMaybe mempty $ do
str <- mfilt
return $
IM.singleton
0
$ SelectionInfo
[filtdescription ++ " FILTER: " ++ str, numfiltitems]
2
True
white
0
(SelectionInfo [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
itms' = fromMaybe itms $ do
str <- mstr
return $ IM.filter (plainRegex str) itms
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
itms' = fromMaybe itms $ do
str <- mfilt
return $ IM.filter (filtfn str) itms
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
invDimColor :: Color
invDimColor = greyN 0.7
src/Dodge/Inventory/SelectionList.hs
+13 -12
View File
@@ -1,38 +1,38 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Inventory.SelectionList (
invSelectionItem,
invSelectionItem',
closeObjectToSelectionItem,
) where
import Dodge.Item.Grammar
import Dodge.Data.ComposedItem
import Padding
import Dodge.Equipment.Text
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Equipment.Text
import Dodge.Item.Display
import Dodge.Item.Grammar
import Dodge.Item.InventoryColor
import LensHelp
import Padding
import Picture.Base
invSelectionItem' :: Creature -> Int -> ComposedItem -> SelectionItem ()
invSelectionItem' cr i it = invSelectionItem cr i it 0
invSelectionItem' = invSelectionItem 0
invSelectionItem :: Creature -> Int -> ComposedItem -> Int -> SelectionItem ()
invSelectionItem cr i ci indent =
invSelectionItem :: Int -> Creature -> Int -> ComposedItem -> SelectionItem ()
invSelectionItem indent cr i ci =
SelectionItem
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
, _siHeight = _itInvSize itm
, _siHeight = _itInvSize $ _cItem ci
, _siIsSelectable = True
, _siColor = col
, _siOffX = indent
, _siPayload = ()
}
where
itm = _cItem ci
anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
anyhotkey = maybe [] ((' ' :) . hotkeyToString) (cr ^? crInvHotkeys . ix i)
anyequippos = maybe [] (rightPad 8 ' ' . (' ' :) . eqPosText) (cr ^? crInvEquipped . ix i)
col = itemInvColor ci
pics = itemDisplay cr ci
@@ -65,8 +65,9 @@ closeObjectToSelectionItem e =
where
(pics, col) = closeObjectToTextPictures e
--
closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
closeObjectToTextPictures = \case
Left flit -> let it = _flIt flit in (basicItemDisplay it, itemInvColor . pciToCI $ basePCI it)
Left flit ->
let it = _flIt flit
in (basicItemDisplay it, itemInvColor . pciToCI $ basePCI it)
Right bt -> ([_btText bt], yellow)
tags
+213 -210
View File
File diff suppressed because it is too large Load Diff