Fix combinations filter
This commit is contained in:
+1
-77
@@ -1,17 +1,10 @@
|
|||||||
--{-# LANGUAGE TupleSections #-}
|
--{-# LANGUAGE TupleSections #-}
|
||||||
module Dodge.Combine (
|
module Dodge.Combine (
|
||||||
toggleCombineInv,
|
|
||||||
enterCombineInv,
|
|
||||||
combineList,
|
combineList,
|
||||||
|
combineList',
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Dodge.Data.Universe
|
import Dodge.Data.Universe
|
||||||
--import Regex
|
|
||||||
import Dodge.DisplayInventory
|
|
||||||
import Dodge.Render.HUD
|
|
||||||
import Dodge.SelectionList
|
|
||||||
--import Dodge.Data.Config
|
|
||||||
--import SelectionIntMap
|
|
||||||
import Dodge.Data.Combine
|
import Dodge.Data.Combine
|
||||||
import Dodge.Item.Display
|
import Dodge.Item.Display
|
||||||
import Color
|
import Color
|
||||||
@@ -108,72 +101,3 @@ combineTwoModuleMaps =
|
|||||||
fullModuleName :: ItemModuleType -> String
|
fullModuleName :: ItemModuleType -> String
|
||||||
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
|
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
|
||||||
|
|
||||||
toggleCombineInv :: Universe -> Universe
|
|
||||||
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
|
|
||||||
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
|
|
||||||
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
|
|
||||||
|
|
||||||
--updateCombineSelections :: World -> Configuration -> SelectionSections CombinableItem
|
|
||||||
-- -> SelectionSections CombinableItem
|
|
||||||
--updateCombineSelections w cfig sss = sss & sssSections .~ updateSections availablelines ij [combs,filt]
|
|
||||||
-- where
|
|
||||||
-- availablelines = getAvailableListLines secondColumnParams cfig
|
|
||||||
-- filt = (-1, (filtsec,filtitems))
|
|
||||||
-- filtsec = fromMaybe defaultFiltSection $ sss ^? sssSections . ix (-1)
|
|
||||||
-- filtitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
|
|
||||||
-- Just str -> IM.singleton 0 (SelectionRegex ["COMB. FILTER: " ++ str,numfiltitems] 2 True white 0)
|
|
||||||
-- Nothing -> mempty
|
|
||||||
-- numfiltitems = " " ++ show numfiltitems' ++ " FILTERED"
|
|
||||||
-- numfiltitems' = length combitems' - length combitems
|
|
||||||
-- combs :: (Int , (SelectionSection CombinableItem , IM.IntMap (SelectionItem CombinableItem)))
|
|
||||||
-- combs = (0, (combsec,combitems))
|
|
||||||
-- combsec = fromMaybe (defaultSS & ssDescriptor .~ "COMBINATIONS") $ sss ^? sssSections . ix 0
|
|
||||||
-- combitems' = fromMaybe mempty $ w ^? hud . hudElement . subInventory . ciCombinations
|
|
||||||
-- combitems = case w ^? hud . hudElement . subInventory . ciRegex . _Just of
|
|
||||||
-- Just str -> IM.filter (regexList str . _siPictures) combitems'
|
|
||||||
-- Nothing -> combitems'
|
|
||||||
-- ij = fromMaybe (0,0) $ do
|
|
||||||
-- i <- sss ^? sssSelPos . _Just
|
|
||||||
-- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel
|
|
||||||
-- return (i,j)
|
|
||||||
|
|
||||||
enterCombineInv :: Configuration -> World -> World
|
|
||||||
enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory
|
|
||||||
cm'
|
|
||||||
sss
|
|
||||||
--(updateCombineSelections w cfig sss)
|
|
||||||
where
|
|
||||||
cm' = IM.fromAscList $ zip [0..] $ combineList' w
|
|
||||||
cm | null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
|
|
||||||
| otherwise = cm'
|
|
||||||
sss = SelectionSections
|
|
||||||
{ _sssSections = IM.fromDistinctAscList [(-1,filtsection),(0,combsection)]
|
|
||||||
, _sssExtra = SSSExtra
|
|
||||||
{_sssSelPos = selpos
|
|
||||||
, _sssFilters=IM.singleton (-1) Nothing
|
|
||||||
}
|
|
||||||
}
|
|
||||||
selpos | null cm' = Nothing
|
|
||||||
| otherwise = Just (0,0)
|
|
||||||
availablelines = getAvailableListLines secondColumnParams cfig
|
|
||||||
filtsection = SelectionSection
|
|
||||||
{ _ssItems = mempty
|
|
||||||
, _ssCursor = Nothing
|
|
||||||
, _ssMinSize = 0
|
|
||||||
, _ssOffset = 0
|
|
||||||
, _ssShownItems = mempty
|
|
||||||
, _ssIndent = 0
|
|
||||||
, _ssDescriptor = "COMB FILTER"
|
|
||||||
}
|
|
||||||
combsection = updateSection cm (Just 0) availablelines combinationssection'
|
|
||||||
combinationssection' = SelectionSection
|
|
||||||
{ _ssItems = cm
|
|
||||||
, _ssCursor = do
|
|
||||||
(_,si) <- IM.lookupMin cm
|
|
||||||
return $ SectionCursor 0 (length (_siPictures si)) (_siColor si)
|
|
||||||
, _ssMinSize = 5
|
|
||||||
, _ssOffset = 0
|
|
||||||
, _ssShownItems = mempty
|
|
||||||
, _ssIndent = 0
|
|
||||||
, _ssDescriptor = "COMBINATIONS"
|
|
||||||
}
|
|
||||||
|
|||||||
@@ -191,8 +191,8 @@ defaultInvSections = SelectionSections
|
|||||||
[ defaultFiltSection
|
[ defaultFiltSection
|
||||||
, defaultInvSection
|
, defaultInvSection
|
||||||
, defaultYouSection
|
, defaultYouSection
|
||||||
, (defaultFiltSection & ssIndent .~ 2
|
, defaultFiltSection & ssIndent .~ 2
|
||||||
& ssDescriptor .~ "NEARBY")
|
& ssDescriptor .~ "NEARBY"
|
||||||
, defaultCOSection
|
, defaultCOSection
|
||||||
]
|
]
|
||||||
, _sssExtra = defaultSSSExtra
|
, _sssExtra = defaultSSSExtra
|
||||||
|
|||||||
+188
-82
@@ -1,65 +1,115 @@
|
|||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
module Dodge.DisplayInventory
|
|
||||||
( updateDisplayInventory
|
|
||||||
, defaultSS
|
|
||||||
, defaultFiltSection
|
|
||||||
-- , defaultDisplaySections
|
|
||||||
, updateSection
|
|
||||||
) where
|
|
||||||
|
|
||||||
|
module Dodge.DisplayInventory (
|
||||||
|
updateDisplayInventory,
|
||||||
|
defaultSS,
|
||||||
|
defaultFiltSection,
|
||||||
|
-- , defaultDisplaySections
|
||||||
|
updateSection,
|
||||||
|
enterCombineInv,
|
||||||
|
toggleCombineInv,
|
||||||
|
updatePositionHUD,
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Dodge.Data.Combine
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Regex
|
import qualified Data.IntMap.Strict as IM
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Picture.Base
|
import Dodge.Base.You
|
||||||
|
import Dodge.Combine
|
||||||
|
import Dodge.Data.Config
|
||||||
|
import Dodge.Data.SelectionList
|
||||||
|
import Dodge.Data.Universe
|
||||||
|
import Dodge.Default.World
|
||||||
|
import Dodge.Inventory.CheckSlots
|
||||||
|
import Dodge.Inventory.Color
|
||||||
|
import Dodge.Inventory.SelectionList
|
||||||
import Dodge.Render.HUD
|
import Dodge.Render.HUD
|
||||||
import Dodge.SelectionList
|
import Dodge.SelectionList
|
||||||
import LensHelp
|
import LensHelp
|
||||||
import Dodge.Inventory.CheckSlots
|
import Picture.Base
|
||||||
import Dodge.Inventory.Color
|
import Regex
|
||||||
import Dodge.Base.You
|
|
||||||
import Dodge.Inventory.SelectionList
|
-- this should ONLY change the shownitems
|
||||||
import qualified Data.IntMap.Strict as IM
|
updatePositionHUD :: Universe -> Universe
|
||||||
import Dodge.Data.Config
|
updatePositionHUD u = case u ^? uvWorld . hud . hudElement . subInventory of
|
||||||
import Dodge.Default.World
|
Just NoSubInventory -> u & uvWorld . hud . hudElement . diSections
|
||||||
import Dodge.Data.SelectionList
|
%~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
|
||||||
import Dodge.Data.World
|
Just CombineInventory {} -> u & uvWorld . hud . hudElement . subInventory . ciSections
|
||||||
|
%~ updateCombineInventory (_uvWorld u) (_uvConfig u)
|
||||||
|
_ -> u
|
||||||
|
|
||||||
|
toggleCombineInv :: Universe -> Universe
|
||||||
|
toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
|
||||||
|
Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
|
||||||
|
_ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
|
||||||
|
|
||||||
|
updateCombineInventory :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem
|
||||||
|
updateCombineInventory w cfig sss =
|
||||||
|
sss & sssSections
|
||||||
|
%~ updateSectionsPositioning
|
||||||
|
mselpos
|
||||||
|
availablelines
|
||||||
|
[(0, showncombs), (-1, filtinv)]
|
||||||
|
where
|
||||||
|
mselpos = sss ^. sssExtra . sssSelPos
|
||||||
|
availablelines = getAvailableListLines secondColumnParams cfig
|
||||||
|
allcombs = IM.fromAscList $ zip [0 ..] $ combineList' w
|
||||||
|
filtcombs = fromMaybe allcombs $ do
|
||||||
|
str <- mstr
|
||||||
|
return $ IM.filter (regexList str . _siPictures) 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
|
||||||
|
(SelectionRegex ["COMBINATIONS FILTER: " ++ str, numfiltitems] 2 True white 0)
|
||||||
|
mstr = w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . ix (-1) . _Just
|
||||||
|
numfiltitems = " " ++ show (length allcombs - length filtcombs) ++ " FILTERED"
|
||||||
|
|
||||||
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
|
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
|
||||||
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
|
updateDisplayInventory w cfig sss =
|
||||||
Just mo -> sss & sssSections %~ updateSectionsPositioning
|
sss & sssSections
|
||||||
(sss ^. sssExtra . sssSelPos)
|
%~ updateSectionsPositioning
|
||||||
availablelines
|
mselpos
|
||||||
(addorder mo)
|
availablelines
|
||||||
_ -> error "error when getting cr inv sel"
|
addorder
|
||||||
where
|
where
|
||||||
addorder mo = case mo of
|
mselpos = sss ^. sssExtra . sssSelPos
|
||||||
InInventory SortInventory -> reverse [filtinv,filtclose,invx ,youx, closex]
|
addorder = case mselpos of
|
||||||
InInventory SelItem{} -> reverse [filtinv,filtclose,invx ,youx, closex]
|
Just (-1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
|
||||||
SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex]
|
Just (0, _) -> reverse [filtinv, filtclose, invx, youx, closex]
|
||||||
InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx]
|
Just (1, _) -> reverse [filtinv, filtclose, invx, youx, closex]
|
||||||
InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx]
|
Just (2, _) -> reverse [filtinv, filtclose, closex, invx, youx]
|
||||||
(filtinv,invx) = filtpair (-1) (hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just) invitems' "INV. "
|
_ -> reverse [filtinv, filtclose, closex, invx, youx]
|
||||||
(filtclose,closex) = filtpair 2 (hud . hudElement . diSections . sssExtra . sssFilters . ix 2 . _Just) coitems' "NEARBY "
|
(filtinv, invx) = filtpair (-1) invitems' "INV. "
|
||||||
|
(filtclose, closex) = filtpair 2 coitems' "NEARBY "
|
||||||
youx = (1, youitems)
|
youx = (1, youitems)
|
||||||
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
|
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
|
||||||
thetext = displayFreeSlots nfreeslots
|
thetext = displayFreeSlots nfreeslots
|
||||||
availablelines = getAvailableListLines (invDisplayParams w) cfig
|
availablelines = getAvailableListLines (invDisplayParams w) cfig
|
||||||
coitems' = IM.fromDistinctAscList . zip [0..]
|
coitems' =
|
||||||
$ map closeObjectToSelectionItem (w ^. hud . closeObjects)
|
IM.fromDistinctAscList . zip [0 ..] $
|
||||||
|
map closeObjectToSelectionItem (w ^. hud . closeObjects)
|
||||||
invitems' = IM.mapWithKey (invSelectionItem' cr) inv
|
invitems' = IM.mapWithKey (invSelectionItem' cr) inv
|
||||||
cr = you w
|
cr = you w
|
||||||
inv = _crInv (you w)
|
inv = _crInv (you w)
|
||||||
nfreeslots = crNumFreeSlots cr
|
nfreeslots = crNumFreeSlots cr
|
||||||
filtpair i regpointer itms filtdescription =
|
filtpair i itms filtdescription =
|
||||||
( ( i, filtsis)
|
( (i, filtsis)
|
||||||
, ( i+1, itms')
|
, (i + 1, itms')
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
mstr = w ^? regpointer
|
mstr = w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix i . _Just
|
||||||
filtsis = fromMaybe mempty $ do
|
filtsis = fromMaybe mempty $ do
|
||||||
str <- mstr
|
str <- mstr
|
||||||
return $ IM.singleton 0
|
return $
|
||||||
(SelectionRegex [filtdescription ++ "FILTER: "++str,numfiltitems] 2 True white 0)
|
IM.singleton
|
||||||
|
0
|
||||||
|
(SelectionRegex [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
|
||||||
itms' = fromMaybe itms $ do
|
itms' = fromMaybe itms $ do
|
||||||
str <- mstr
|
str <- mstr
|
||||||
return $ IM.filter (regexList str . _siPictures) itms
|
return $ IM.filter (regexList str . _siPictures) itms
|
||||||
@@ -71,24 +121,24 @@ displayFreeSlots x = case x of
|
|||||||
1 -> "1 FREE SLOT"
|
1 -> "1 FREE SLOT"
|
||||||
_ -> show x ++ " FREE SLOTS"
|
_ -> show x ++ " FREE SLOTS"
|
||||||
|
|
||||||
updateSectionsPositioning
|
updateSectionsPositioning ::
|
||||||
:: Maybe (Int,Int)
|
Maybe (Int, Int) ->
|
||||||
-> Int
|
Int ->
|
||||||
-> [(Int,IM.IntMap (SelectionItem a))]
|
[(Int, IM.IntMap (SelectionItem a))] ->
|
||||||
-> IM.IntMap (SelectionSection a)
|
IM.IntMap (SelectionSection a) ->
|
||||||
-> IM.IntMap (SelectionSection a)
|
IM.IntMap (SelectionSection a)
|
||||||
updateSectionsPositioning _ _ [] _ = mempty
|
updateSectionsPositioning _ _ [] _ = mempty
|
||||||
updateSectionsPositioning mselpos allavailablelines ((k,y) : xs) sss
|
updateSectionsPositioning mselpos allavailablelines ((k, y) : xs) sss =
|
||||||
= IM.insert k ss previoussections
|
IM.insert k ss previoussections
|
||||||
where
|
where
|
||||||
mscel = do
|
mscel = do
|
||||||
(i,j) <- mselpos
|
(i, j) <- mselpos
|
||||||
guard $ i == k
|
guard $ i == k
|
||||||
return j
|
return j
|
||||||
ss = updateSection y mscel linesleft x
|
ss = updateSection y mscel linesleft x
|
||||||
x = sss ^?! ix k
|
x = sss ^?! ix k
|
||||||
availablelines = allavailablelines - _ssMinSize x
|
availablelines = allavailablelines - _ssMinSize x
|
||||||
linesleft = allavailablelines - sum (fmap linestaken $ previoussections)
|
linesleft = allavailablelines - sum (linestaken <$> previoussections)
|
||||||
linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
|
linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
|
||||||
previoussections = updateSectionsPositioning mselpos availablelines xs sss
|
previoussections = updateSectionsPositioning mselpos availablelines xs sss
|
||||||
|
|
||||||
@@ -100,23 +150,24 @@ updateSectionsPositioning mselpos allavailablelines ((k,y) : xs) sss
|
|||||||
-- InNearby SortNearby -> (2,0)
|
-- InNearby SortNearby -> (2,0)
|
||||||
-- InNearby (SelCloseObject i) -> (3,i)
|
-- InNearby (SelCloseObject i) -> (3,i)
|
||||||
|
|
||||||
updateSection
|
updateSection ::
|
||||||
:: IM.IntMap (SelectionItem a)
|
IM.IntMap (SelectionItem a) ->
|
||||||
-> Maybe Int
|
Maybe Int ->
|
||||||
-> Int
|
Int ->
|
||||||
-> SelectionSection a
|
SelectionSection a ->
|
||||||
-> SelectionSection a
|
SelectionSection a
|
||||||
updateSection sis mcsel availablelines ss = ss
|
updateSection sis mcsel availablelines ss =
|
||||||
{ _ssItems = sis
|
ss
|
||||||
, _ssCursor = scurs
|
{ _ssItems = sis
|
||||||
, _ssOffset = offset
|
, _ssCursor = scurs
|
||||||
, _ssShownItems = shownitems
|
, _ssOffset = offset
|
||||||
}
|
, _ssShownItems = shownitems
|
||||||
|
}
|
||||||
where
|
where
|
||||||
oldoffset = ss ^. ssOffset
|
oldoffset = ss ^. ssOffset
|
||||||
scurs = do
|
scurs = do
|
||||||
csel <- mcsel
|
csel <- mcsel
|
||||||
(_,si) <- IM.lookupGE csel sis -- this is not right
|
(_, si) <- IM.lookupGE csel sis -- this is not right
|
||||||
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
|
let cpos = sum (fmap (length . _siPictures) . fst . IM.split csel $ sis)
|
||||||
csize = length $ _siPictures si
|
csize = length $ _siPictures si
|
||||||
ccolor = _siColor si
|
ccolor = _siColor si
|
||||||
@@ -127,30 +178,85 @@ updateSection sis mcsel availablelines ss = ss
|
|||||||
si <- sis ^? ix csel
|
si <- sis ^? ix csel
|
||||||
let xselsize = length $ _siPictures si
|
let xselsize = length $ _siPictures si
|
||||||
return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
|
return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
|
||||||
pos | pos == 0 || length allstrings <= availablelines
|
pos
|
||||||
-> 0
|
| pos == 0 || length allstrings <= availablelines ->
|
||||||
pos | pos - 1 < oldoffset
|
0
|
||||||
-> pos - 1
|
pos
|
||||||
pos | maxcsel == csel
|
| pos - 1 < oldoffset ->
|
||||||
-> pos - availablelines + xselsize
|
pos - 1
|
||||||
pos | pos + 1 + xselsize - availablelines > oldoffset
|
pos
|
||||||
-> pos - availablelines + 1 + xselsize
|
| maxcsel == csel ->
|
||||||
_ | length allstrings - oldoffset < availablelines
|
pos - availablelines + xselsize
|
||||||
-> length allstrings - availablelines
|
pos
|
||||||
_ -> oldoffset
|
| pos + 1 + xselsize - availablelines > oldoffset ->
|
||||||
tweakfirst (x:xs)
|
pos - availablelines + 1 + xselsize
|
||||||
|
_
|
||||||
|
| length allstrings - oldoffset < availablelines ->
|
||||||
|
length allstrings - availablelines
|
||||||
|
_ -> oldoffset
|
||||||
|
tweakfirst (x : xs)
|
||||||
| offset > 0 = xtra "<<<" : map h xs
|
| offset > 0 = xtra "<<<" : map h xs
|
||||||
| otherwise = map h (x:xs)
|
| otherwise = map h (x : xs)
|
||||||
tweakfirst [] = []
|
tweakfirst [] = []
|
||||||
shownitems
|
shownitems
|
||||||
| length shownstrings > availablelines
|
| length shownstrings > availablelines =
|
||||||
= tweakfirst (take (availablelines - 1) shownstrings)
|
tweakfirst (take (availablelines - 1) shownstrings)
|
||||||
++ [xtra ">>>"]
|
++ [xtra ">>>"]
|
||||||
| otherwise = tweakfirst shownstrings
|
| otherwise = tweakfirst shownstrings
|
||||||
allstrings :: [(Color,String)]
|
allstrings :: [(Color, String)]
|
||||||
allstrings = foldMap g sis
|
allstrings = foldMap g sis
|
||||||
shownstrings = drop offset allstrings
|
shownstrings = drop offset allstrings
|
||||||
h (col,str) = color col . text $ theindent ++ str
|
h (col, str) = color col . text $ theindent ++ str
|
||||||
theindent = replicate (_ssIndent ss) ' '
|
theindent = replicate (_ssIndent ss) ' '
|
||||||
xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
|
xtra str = color white . text $ theindent ++ str ++ " MORE " ++ _ssDescriptor ss
|
||||||
g si = map (_siColor si ,) $ _siPictures si
|
g si = map (_siColor si,) $ _siPictures si
|
||||||
|
|
||||||
|
enterCombineInv :: Configuration -> World -> World
|
||||||
|
enterCombineInv cfig w =
|
||||||
|
w & hud . hudElement . subInventory
|
||||||
|
.~ CombineInventory
|
||||||
|
cm'
|
||||||
|
sss
|
||||||
|
where
|
||||||
|
--(updateCombineSelections w cfig sss)
|
||||||
|
|
||||||
|
cm' = IM.fromAscList $ zip [0 ..] $ combineList' w
|
||||||
|
cm
|
||||||
|
| null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
|
||||||
|
| otherwise = cm'
|
||||||
|
sss =
|
||||||
|
SelectionSections
|
||||||
|
{ _sssSections = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)]
|
||||||
|
, _sssExtra =
|
||||||
|
SSSExtra
|
||||||
|
{ _sssSelPos = selpos
|
||||||
|
, _sssFilters = IM.singleton (-1) Nothing
|
||||||
|
}
|
||||||
|
}
|
||||||
|
selpos
|
||||||
|
| null cm' = Nothing
|
||||||
|
| otherwise = Just (0, 0)
|
||||||
|
availablelines = getAvailableListLines secondColumnParams cfig
|
||||||
|
filtsection =
|
||||||
|
SelectionSection
|
||||||
|
{ _ssItems = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
|
||||||
|
, _ssCursor = Nothing
|
||||||
|
, _ssMinSize = 0
|
||||||
|
, _ssOffset = 0
|
||||||
|
, _ssShownItems = mempty
|
||||||
|
, _ssIndent = 0
|
||||||
|
, _ssDescriptor = "COMB FILTER"
|
||||||
|
}
|
||||||
|
combsection = updateSection cm (Just 0) availablelines combinationssection'
|
||||||
|
combinationssection' =
|
||||||
|
SelectionSection
|
||||||
|
{ _ssItems = cm
|
||||||
|
, _ssCursor = do
|
||||||
|
(_, si) <- IM.lookupMin cm
|
||||||
|
return $ SectionCursor 0 (length (_siPictures si)) (_siColor si)
|
||||||
|
, _ssMinSize = 5
|
||||||
|
, _ssOffset = 0
|
||||||
|
, _ssShownItems = mempty
|
||||||
|
, _ssIndent = 0
|
||||||
|
, _ssDescriptor = "COMBINATIONS"
|
||||||
|
}
|
||||||
|
|||||||
@@ -37,7 +37,7 @@ regexScope w = case w ^? hud . hudElement . subInventory of
|
|||||||
Just (3, _) -> di 2
|
Just (3, _) -> di 2
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
Just CombineInventory{} ->
|
Just CombineInventory{} ->
|
||||||
Just (subInventory . ciSections . sssExtra, (-1))
|
Just (subInventory . ciSections . sssExtra, -1)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
where
|
where
|
||||||
di x = Just (diSections . sssExtra, x)
|
di x = Just (diSections . sssExtra, x)
|
||||||
@@ -54,7 +54,7 @@ regexFocus w = case w ^? hud . hudElement . subInventory of
|
|||||||
Just (2, _) -> di 2
|
Just (2, _) -> di 2
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
Just CombineInventory{} ->
|
Just CombineInventory{} ->
|
||||||
Just (subInventory . ciSections . sssExtra, (-1))
|
Just (subInventory . ciSections . sssExtra, -1)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
where
|
where
|
||||||
di x = Just (diSections . sssExtra, x)
|
di x = Just (diSections . sssExtra, x)
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE TupleSections #-}
|
--{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
module Dodge.Inventory (
|
module Dodge.Inventory (
|
||||||
selSecSelPos,
|
selSecSelPos,
|
||||||
|
|||||||
+1
-50
@@ -5,6 +5,7 @@ module Dodge.Render.HUD (
|
|||||||
secondColumnParams,
|
secondColumnParams,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Dodge.ListDisplayParams
|
||||||
import Dodge.Inventory
|
import Dodge.Inventory
|
||||||
import Dodge.Data.Combine
|
import Dodge.Data.Combine
|
||||||
import Dodge.Default.SelectionList
|
import Dodge.Default.SelectionList
|
||||||
@@ -44,29 +45,6 @@ drawHUD cfig w = case w ^. hud . hudElement of
|
|||||||
drawHP :: Configuration -> World -> Picture
|
drawHP :: Configuration -> World -> Picture
|
||||||
drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w
|
drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w
|
||||||
|
|
||||||
defaultListDisplayParams :: ListDisplayParams
|
|
||||||
defaultListDisplayParams =
|
|
||||||
ListDisplayParams
|
|
||||||
{ _ldpVerticalGap = 10
|
|
||||||
, _ldpScale = 1
|
|
||||||
, _ldpPosX = 0
|
|
||||||
, _ldpPosY = 0
|
|
||||||
, _ldpCursorType = NoCursor
|
|
||||||
, _ldpWidth = FixedSelectionWidth 15
|
|
||||||
}
|
|
||||||
|
|
||||||
invDisplayParams :: World -> ListDisplayParams
|
|
||||||
invDisplayParams w =
|
|
||||||
defaultListDisplayParams
|
|
||||||
& ldpCursorType .~ BorderCursor selcursortype
|
|
||||||
& ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
|
|
||||||
where
|
|
||||||
selcursortype
|
|
||||||
| isexaminesub || ButtonRight `M.member` _mouseButtons (_input w) = [North, South, East, West]
|
|
||||||
| otherwise = [North, South, West]
|
|
||||||
isexaminesub = case w ^? hud . hudElement . subInventory of
|
|
||||||
Just ExamineInventory{} -> True
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
|
drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
|
||||||
drawSelectionSections sss ldps cfig = listPicturesAtScaleOff
|
drawSelectionSections sss ldps cfig = listPicturesAtScaleOff
|
||||||
@@ -221,18 +199,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
|
|||||||
-- sss <- w ^? hud . hudElement . diSections
|
-- sss <- w ^? hud . hudElement . diSections
|
||||||
-- return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
|
-- return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
|
||||||
|
|
||||||
secondColumnParams :: ListDisplayParams
|
|
||||||
secondColumnParams =
|
|
||||||
defaultListDisplayParams
|
|
||||||
& ldpPosX .~ subInvX
|
|
||||||
& ldpPosY .~ 60
|
|
||||||
& ldpCursorType .~ BorderCursor [North, South, West]
|
|
||||||
|
|
||||||
--thirdColumnParams :: ListDisplayParams
|
|
||||||
--thirdColumnParams =
|
|
||||||
-- defaultListDisplayParams
|
|
||||||
-- & ldpPosX .~ 9 * fromIntegral topInvW + 275
|
|
||||||
-- & ldpPosY .~ 60
|
|
||||||
|
|
||||||
--thirdColumnPara :: [String] -> SelectionList ()
|
--thirdColumnPara :: [String] -> SelectionList ()
|
||||||
--thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
|
--thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
|
||||||
@@ -313,11 +280,7 @@ eqPosText ep = case ep of
|
|||||||
OnLegs -> "LEGS"
|
OnLegs -> "LEGS"
|
||||||
OnSpecial -> "EQUIPPED"
|
OnSpecial -> "EQUIPPED"
|
||||||
|
|
||||||
topInvW :: Int
|
|
||||||
topInvW = 15
|
|
||||||
|
|
||||||
subInvX :: Float
|
|
||||||
subInvX = 9 * fromIntegral topInvW + 50
|
|
||||||
|
|
||||||
combineCounts :: Configuration -> World -> [Int] -> Picture
|
combineCounts :: Configuration -> World -> [Int] -> Picture
|
||||||
combineCounts cfig w = winScale cfig . foldMap f . group
|
combineCounts cfig w = winScale cfig . foldMap f . group
|
||||||
@@ -343,18 +306,6 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig
|
|||||||
hh = halfHeight cfig
|
hh = halfHeight cfig
|
||||||
hw = halfWidth cfig
|
hw = halfWidth cfig
|
||||||
|
|
||||||
determineInvSelCursorWidth :: World -> Int
|
|
||||||
determineInvSelCursorWidth w = case _rbOptions w of
|
|
||||||
NoRightButtonOptions -> topInvW
|
|
||||||
EquipOptions{}
|
|
||||||
| ButtonRight `M.member` _mouseButtons (_input w)
|
|
||||||
&& hasnosubinv ->
|
|
||||||
47
|
|
||||||
| otherwise -> topInvW
|
|
||||||
where
|
|
||||||
hasnosubinv = case w ^? hud . hudElement . subInventory of
|
|
||||||
Just NoSubInventory -> True
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
|
|
||||||
ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
|
ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
|
||||||
|
|||||||
@@ -1,18 +1,20 @@
|
|||||||
module Dodge.TestString where
|
module Dodge.TestString where
|
||||||
|
|
||||||
|
import Data.Aeson (ToJSON)
|
||||||
import Data.ByteString.Lazy.Char8 (unpack)
|
import Data.ByteString.Lazy.Char8 (unpack)
|
||||||
import qualified Data.Aeson.Encode.Pretty as AEP
|
import qualified Data.Aeson.Encode.Pretty as AEP
|
||||||
import Control.Lens
|
--import Control.Lens
|
||||||
import Dodge.Data.Universe
|
import Dodge.Data.Universe
|
||||||
--import Data.Maybe
|
--import Data.Maybe
|
||||||
--import ShortShow
|
--import ShortShow
|
||||||
--import qualified Data.Map.Strict as M
|
--import qualified Data.Map.Strict as M
|
||||||
import qualified IntMapHelp as IM
|
--import qualified IntMapHelp as IM
|
||||||
testStringInit :: Universe -> [String]
|
testStringInit :: Universe -> [String]
|
||||||
testStringInit u =
|
testStringInit _ = []
|
||||||
[show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . sssSections]
|
-- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
|
||||||
--[ show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation
|
|
||||||
++ lines (unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation)
|
getPretty :: ToJSON a => a -> [String]
|
||||||
|
getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
|
||||||
|
|
||||||
showTimeFlow :: TimeFlowStatus -> String
|
showTimeFlow :: TimeFlowStatus -> String
|
||||||
showTimeFlow tfs = case tfs of
|
showTimeFlow tfs = case tfs of
|
||||||
|
|||||||
+1
-5
@@ -72,8 +72,8 @@ updateUniverse u =
|
|||||||
. maybeOpenTerminal
|
. maybeOpenTerminal
|
||||||
. over (uvWorld . input . textInput) (const mempty)
|
. over (uvWorld . input . textInput) (const mempty)
|
||||||
. updateUniverseMid
|
. updateUniverseMid
|
||||||
|
. updatePositionHUD
|
||||||
. updateUseInput
|
. updateUseInput
|
||||||
. updateInventoryDisplay
|
|
||||||
. over uvWorld (updateCamera cfig)
|
. over uvWorld (updateCamera cfig)
|
||||||
. over (uvWorld . input) updateScrollTestValue
|
. over (uvWorld . input) updateScrollTestValue
|
||||||
. over (uvWorld . cWorld . cClock) (+ 1)
|
. over (uvWorld . cWorld . cClock) (+ 1)
|
||||||
@@ -81,10 +81,6 @@ updateUniverse u =
|
|||||||
where
|
where
|
||||||
cfig = u ^. uvConfig
|
cfig = u ^. uvConfig
|
||||||
|
|
||||||
updateInventoryDisplay :: Universe -> Universe
|
|
||||||
updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections
|
|
||||||
%~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
|
|
||||||
|
|
||||||
maybeOpenTerminal :: Universe -> Universe
|
maybeOpenTerminal :: Universe -> Universe
|
||||||
maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
|
maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
|
||||||
Just InitialPress -> gotoTerminal u
|
Just InitialPress -> gotoTerminal u
|
||||||
|
|||||||
@@ -3,6 +3,11 @@ module Dodge.Update.Input (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
--import Control.Monad
|
--import Control.Monad
|
||||||
|
|
||||||
|
--import Control.Monad
|
||||||
|
|
||||||
|
--import Control.Monad
|
||||||
|
import Dodge.DisplayInventory
|
||||||
import Data.List (sort)
|
import Data.List (sort)
|
||||||
import Dodge.Inventory.Add
|
import Dodge.Inventory.Add
|
||||||
import Dodge.Data.Combine
|
import Dodge.Data.Combine
|
||||||
@@ -20,7 +25,6 @@ import Data.Maybe
|
|||||||
--import Data.Monoid (First)
|
--import Data.Monoid (First)
|
||||||
import Dodge.Base.You
|
import Dodge.Base.You
|
||||||
import Dodge.Button.Event
|
import Dodge.Button.Event
|
||||||
import Dodge.Combine
|
|
||||||
import Dodge.Creature.Action
|
import Dodge.Creature.Action
|
||||||
import Dodge.Data.Universe
|
import Dodge.Data.Universe
|
||||||
import Dodge.Debug.Terminal
|
import Dodge.Debug.Terminal
|
||||||
@@ -219,6 +223,7 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
|
|||||||
w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
|
w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
|
||||||
& hud . hudElement . diSections %~ enterregex 2
|
& hud . hudElement . diSections %~ enterregex 2
|
||||||
Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ enterregex (-1)
|
Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ enterregex (-1)
|
||||||
|
& hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos ?~ (-1,0)
|
||||||
_ -> w
|
_ -> w
|
||||||
where
|
where
|
||||||
di = w ^. hud . hudElement
|
di = w ^. hud . hudElement
|
||||||
|
|||||||
Reference in New Issue
Block a user