Fix combinations filter
This commit is contained in:
+1
-77
@@ -1,17 +1,10 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Combine (
|
||||
toggleCombineInv,
|
||||
enterCombineInv,
|
||||
combineList,
|
||||
combineList',
|
||||
) where
|
||||
|
||||
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.Item.Display
|
||||
import Color
|
||||
@@ -108,72 +101,3 @@ combineTwoModuleMaps =
|
||||
fullModuleName :: ItemModuleType -> String
|
||||
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
|
||||
, defaultInvSection
|
||||
, defaultYouSection
|
||||
, (defaultFiltSection & ssIndent .~ 2
|
||||
& ssDescriptor .~ "NEARBY")
|
||||
, defaultFiltSection & ssIndent .~ 2
|
||||
& ssDescriptor .~ "NEARBY"
|
||||
, defaultCOSection
|
||||
]
|
||||
, _sssExtra = defaultSSSExtra
|
||||
|
||||
+189
-83
@@ -1,65 +1,115 @@
|
||||
{-# 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 Regex
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
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.SelectionList
|
||||
import LensHelp
|
||||
import Dodge.Inventory.CheckSlots
|
||||
import Dodge.Inventory.Color
|
||||
import Dodge.Base.You
|
||||
import Dodge.Inventory.SelectionList
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Dodge.Data.Config
|
||||
import Dodge.Default.World
|
||||
import Dodge.Data.SelectionList
|
||||
import Dodge.Data.World
|
||||
import Picture.Base
|
||||
import Regex
|
||||
|
||||
-- this should ONLY change the shownitems
|
||||
updatePositionHUD :: Universe -> Universe
|
||||
updatePositionHUD u = case u ^? uvWorld . hud . hudElement . subInventory of
|
||||
Just NoSubInventory -> u & uvWorld . hud . hudElement . diSections
|
||||
%~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
|
||||
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 w cfig sss = case cr ^? crManipulation . manObject of
|
||||
Just mo -> sss & sssSections %~ updateSectionsPositioning
|
||||
(sss ^. sssExtra . sssSelPos)
|
||||
availablelines
|
||||
(addorder mo)
|
||||
_ -> error "error when getting cr inv sel"
|
||||
updateDisplayInventory w cfig sss =
|
||||
sss & sssSections
|
||||
%~ updateSectionsPositioning
|
||||
mselpos
|
||||
availablelines
|
||||
addorder
|
||||
where
|
||||
addorder mo = case mo of
|
||||
InInventory SortInventory -> reverse [filtinv,filtclose,invx ,youx, closex]
|
||||
InInventory SelItem{} -> reverse [filtinv,filtclose,invx ,youx, closex]
|
||||
SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex]
|
||||
InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx]
|
||||
InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx]
|
||||
(filtinv,invx) = filtpair (-1) (hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just) invitems' "INV. "
|
||||
(filtclose,closex) = filtpair 2 (hud . hudElement . diSections . sssExtra . sssFilters . ix 2 . _Just) coitems' "NEARBY "
|
||||
mselpos = sss ^. sssExtra . sssSelPos
|
||||
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]
|
||||
_ -> reverse [filtinv, filtclose, closex, invx, youx]
|
||||
(filtinv, invx) = filtpair (-1) invitems' "INV. "
|
||||
(filtclose, closex) = filtpair 2 coitems' "NEARBY "
|
||||
youx = (1, youitems)
|
||||
youitems = IM.singleton 0 $ SelectionItem [thetext] 1 True invDimColor 2 ()
|
||||
thetext = displayFreeSlots nfreeslots
|
||||
availablelines = getAvailableListLines (invDisplayParams w) cfig
|
||||
coitems' = IM.fromDistinctAscList . zip [0..]
|
||||
$ map closeObjectToSelectionItem (w ^. hud . closeObjects)
|
||||
coitems' =
|
||||
IM.fromDistinctAscList . zip [0 ..] $
|
||||
map closeObjectToSelectionItem (w ^. hud . closeObjects)
|
||||
invitems' = IM.mapWithKey (invSelectionItem' cr) inv
|
||||
cr = you w
|
||||
inv = _crInv (you w)
|
||||
nfreeslots = crNumFreeSlots cr
|
||||
filtpair i regpointer itms filtdescription =
|
||||
( ( i, filtsis)
|
||||
, ( i+1, itms')
|
||||
filtpair i itms filtdescription =
|
||||
( (i, filtsis)
|
||||
, (i + 1, itms')
|
||||
)
|
||||
where
|
||||
mstr = w ^? regpointer
|
||||
mstr = w ^? hud . hudElement . diSections . sssExtra . sssFilters . ix i . _Just
|
||||
filtsis = fromMaybe mempty $ do
|
||||
str <- mstr
|
||||
return $ IM.singleton 0
|
||||
(SelectionRegex [filtdescription ++ "FILTER: "++str,numfiltitems] 2 True white 0)
|
||||
return $
|
||||
IM.singleton
|
||||
0
|
||||
(SelectionRegex [filtdescription ++ "FILTER: " ++ str, numfiltitems] 2 True white 0)
|
||||
itms' = fromMaybe itms $ do
|
||||
str <- mstr
|
||||
return $ IM.filter (regexList str . _siPictures) itms
|
||||
@@ -71,24 +121,24 @@ displayFreeSlots x = case x of
|
||||
1 -> "1 FREE SLOT"
|
||||
_ -> show x ++ " FREE SLOTS"
|
||||
|
||||
updateSectionsPositioning
|
||||
:: Maybe (Int,Int)
|
||||
-> Int
|
||||
-> [(Int,IM.IntMap (SelectionItem a))]
|
||||
-> IM.IntMap (SelectionSection a)
|
||||
-> IM.IntMap (SelectionSection a)
|
||||
updateSectionsPositioning ::
|
||||
Maybe (Int, Int) ->
|
||||
Int ->
|
||||
[(Int, IM.IntMap (SelectionItem a))] ->
|
||||
IM.IntMap (SelectionSection a) ->
|
||||
IM.IntMap (SelectionSection a)
|
||||
updateSectionsPositioning _ _ [] _ = mempty
|
||||
updateSectionsPositioning mselpos allavailablelines ((k,y) : xs) sss
|
||||
= IM.insert k ss previoussections
|
||||
updateSectionsPositioning mselpos allavailablelines ((k, y) : xs) sss =
|
||||
IM.insert k ss previoussections
|
||||
where
|
||||
mscel = do
|
||||
(i,j) <- mselpos
|
||||
(i, j) <- mselpos
|
||||
guard $ i == k
|
||||
return j
|
||||
ss = updateSection y mscel linesleft x
|
||||
x = sss ^?! ix k
|
||||
availablelines = allavailablelines - _ssMinSize x
|
||||
linesleft = allavailablelines - sum (fmap linestaken $ previoussections)
|
||||
linesleft = allavailablelines - sum (linestaken <$> previoussections)
|
||||
linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
|
||||
previoussections = updateSectionsPositioning mselpos availablelines xs sss
|
||||
|
||||
@@ -100,57 +150,113 @@ updateSectionsPositioning mselpos allavailablelines ((k,y) : xs) sss
|
||||
-- InNearby SortNearby -> (2,0)
|
||||
-- InNearby (SelCloseObject i) -> (3,i)
|
||||
|
||||
updateSection
|
||||
:: IM.IntMap (SelectionItem a)
|
||||
-> Maybe Int
|
||||
-> Int
|
||||
-> SelectionSection a
|
||||
-> SelectionSection a
|
||||
updateSection sis mcsel availablelines ss = ss
|
||||
{ _ssItems = sis
|
||||
, _ssCursor = scurs
|
||||
, _ssOffset = offset
|
||||
, _ssShownItems = shownitems
|
||||
}
|
||||
updateSection ::
|
||||
IM.IntMap (SelectionItem a) ->
|
||||
Maybe Int ->
|
||||
Int ->
|
||||
SelectionSection a ->
|
||||
SelectionSection a
|
||||
updateSection sis mcsel availablelines ss =
|
||||
ss
|
||||
{ _ssItems = sis
|
||||
, _ssCursor = scurs
|
||||
, _ssOffset = offset
|
||||
, _ssShownItems = shownitems
|
||||
}
|
||||
where
|
||||
oldoffset = ss ^. ssOffset
|
||||
scurs = do
|
||||
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)
|
||||
csize = length $ _siPictures si
|
||||
ccolor = _siColor si
|
||||
return $ SectionCursor (cpos - offset) csize ccolor
|
||||
offset = fromMaybe oldoffset $ do
|
||||
csel <- mcsel
|
||||
csel <- mcsel
|
||||
maxcsel <- fst <$> IM.lookupMax sis
|
||||
si <- sis ^? ix csel
|
||||
let xselsize = length $ _siPictures si
|
||||
return $ case sum $ fmap (length . _siPictures) . fst . IM.split csel $ sis of
|
||||
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 - availablelines + 1 + xselsize
|
||||
_ | length allstrings - oldoffset < availablelines
|
||||
-> length allstrings - availablelines
|
||||
_ -> oldoffset
|
||||
tweakfirst (x:xs)
|
||||
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 - availablelines + 1 + xselsize
|
||||
_
|
||||
| length allstrings - oldoffset < availablelines ->
|
||||
length allstrings - availablelines
|
||||
_ -> oldoffset
|
||||
tweakfirst (x : xs)
|
||||
| offset > 0 = xtra "<<<" : map h xs
|
||||
| otherwise = map h (x:xs)
|
||||
tweakfirst [] = []
|
||||
| otherwise = map h (x : xs)
|
||||
tweakfirst [] = []
|
||||
shownitems
|
||||
| length shownstrings > availablelines
|
||||
= tweakfirst (take (availablelines - 1) shownstrings)
|
||||
| length shownstrings > availablelines =
|
||||
tweakfirst (take (availablelines - 1) shownstrings)
|
||||
++ [xtra ">>>"]
|
||||
| otherwise = tweakfirst shownstrings
|
||||
allstrings :: [(Color,String)]
|
||||
allstrings :: [(Color, String)]
|
||||
allstrings = foldMap g sis
|
||||
shownstrings = drop offset allstrings
|
||||
h (col,str) = color col . text $ theindent ++ str
|
||||
h (col, str) = color col . text $ theindent ++ str
|
||||
theindent = replicate (_ssIndent 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
|
||||
_ -> Nothing
|
||||
Just CombineInventory{} ->
|
||||
Just (subInventory . ciSections . sssExtra, (-1))
|
||||
Just (subInventory . ciSections . sssExtra, -1)
|
||||
_ -> Nothing
|
||||
where
|
||||
di x = Just (diSections . sssExtra, x)
|
||||
@@ -54,7 +54,7 @@ regexFocus w = case w ^? hud . hudElement . subInventory of
|
||||
Just (2, _) -> di 2
|
||||
_ -> Nothing
|
||||
Just CombineInventory{} ->
|
||||
Just (subInventory . ciSections . sssExtra, (-1))
|
||||
Just (subInventory . ciSections . sssExtra, -1)
|
||||
_ -> Nothing
|
||||
where
|
||||
di x = Just (diSections . sssExtra, x)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Dodge.Inventory (
|
||||
selSecSelPos,
|
||||
|
||||
+1
-50
@@ -5,6 +5,7 @@ module Dodge.Render.HUD (
|
||||
secondColumnParams,
|
||||
) where
|
||||
|
||||
import Dodge.ListDisplayParams
|
||||
import Dodge.Inventory
|
||||
import Dodge.Data.Combine
|
||||
import Dodge.Default.SelectionList
|
||||
@@ -44,29 +45,6 @@ drawHUD cfig w = case w ^. hud . hudElement of
|
||||
drawHP :: Configuration -> World -> Picture
|
||||
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 sss ldps cfig = listPicturesAtScaleOff
|
||||
@@ -221,18 +199,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
|
||||
-- sss <- w ^? hud . hudElement . diSections
|
||||
-- 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 strs = SelectionList (map f strs) Nothing (length strs)
|
||||
@@ -313,11 +280,7 @@ eqPosText ep = case ep of
|
||||
OnLegs -> "LEGS"
|
||||
OnSpecial -> "EQUIPPED"
|
||||
|
||||
topInvW :: Int
|
||||
topInvW = 15
|
||||
|
||||
subInvX :: Float
|
||||
subInvX = 9 * fromIntegral topInvW + 50
|
||||
|
||||
combineCounts :: Configuration -> World -> [Int] -> Picture
|
||||
combineCounts cfig w = winScale cfig . foldMap f . group
|
||||
@@ -343,18 +306,6 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig
|
||||
hh = halfHeight 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 ()]
|
||||
|
||||
@@ -1,18 +1,20 @@
|
||||
module Dodge.TestString where
|
||||
|
||||
import Data.Aeson (ToJSON)
|
||||
import Data.ByteString.Lazy.Char8 (unpack)
|
||||
import qualified Data.Aeson.Encode.Pretty as AEP
|
||||
import Control.Lens
|
||||
--import Control.Lens
|
||||
import Dodge.Data.Universe
|
||||
--import Data.Maybe
|
||||
--import ShortShow
|
||||
--import qualified Data.Map.Strict as M
|
||||
import qualified IntMapHelp as IM
|
||||
--import qualified IntMapHelp as IM
|
||||
testStringInit :: Universe -> [String]
|
||||
testStringInit u =
|
||||
[show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . 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)
|
||||
testStringInit _ = []
|
||||
-- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
|
||||
|
||||
getPretty :: ToJSON a => a -> [String]
|
||||
getPretty = lines . unpack . AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False)
|
||||
|
||||
showTimeFlow :: TimeFlowStatus -> String
|
||||
showTimeFlow tfs = case tfs of
|
||||
|
||||
+1
-5
@@ -72,8 +72,8 @@ updateUniverse u =
|
||||
. maybeOpenTerminal
|
||||
. over (uvWorld . input . textInput) (const mempty)
|
||||
. updateUniverseMid
|
||||
. updatePositionHUD
|
||||
. updateUseInput
|
||||
. updateInventoryDisplay
|
||||
. over uvWorld (updateCamera cfig)
|
||||
. over (uvWorld . input) updateScrollTestValue
|
||||
. over (uvWorld . cWorld . cClock) (+ 1)
|
||||
@@ -81,10 +81,6 @@ updateUniverse u =
|
||||
where
|
||||
cfig = u ^. uvConfig
|
||||
|
||||
updateInventoryDisplay :: Universe -> Universe
|
||||
updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections
|
||||
%~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
|
||||
|
||||
maybeOpenTerminal :: Universe -> Universe
|
||||
maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
|
||||
Just InitialPress -> gotoTerminal u
|
||||
|
||||
@@ -3,6 +3,11 @@ module Dodge.Update.Input (
|
||||
) where
|
||||
|
||||
--import Control.Monad
|
||||
|
||||
--import Control.Monad
|
||||
|
||||
--import Control.Monad
|
||||
import Dodge.DisplayInventory
|
||||
import Data.List (sort)
|
||||
import Dodge.Inventory.Add
|
||||
import Dodge.Data.Combine
|
||||
@@ -20,7 +25,6 @@ import Data.Maybe
|
||||
--import Data.Monoid (First)
|
||||
import Dodge.Base.You
|
||||
import Dodge.Button.Event
|
||||
import Dodge.Combine
|
||||
import Dodge.Creature.Action
|
||||
import Dodge.Data.Universe
|
||||
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
|
||||
& hud . hudElement . diSections %~ enterregex 2
|
||||
Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ enterregex (-1)
|
||||
& hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos ?~ (-1,0)
|
||||
_ -> w
|
||||
where
|
||||
di = w ^. hud . hudElement
|
||||
|
||||
Reference in New Issue
Block a user