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

Reorganise/cleanup

Browse Source
This commit is contained in:
justin
2023-02-21 01:24:22 +00:00
parent dee7472d31
commit 4904c57972
13 changed files with 119 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+5 -2
View File
@@ -140,7 +140,7 @@ toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
enterCombineInv :: Configuration -> World -> World enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory
cm' cm'
FilterableSections {_fssFilters=IM.singleton (-1) Nothing,_fssSections = sss} sss
--(updateCombineSelections w cfig sss) --(updateCombineSelections w cfig sss)
where where
cm' = IM.fromAscList $ zip [0..] $ combineList' w cm' = IM.fromAscList $ zip [0..] $ combineList' w
@@ -148,7 +148,10 @@ enterCombineInv cfig w = w & hud . hudElement . subInventory .~ CombineInventory
| otherwise = cm' | otherwise = cm'
sss = SelectionSections sss = SelectionSections
{ _sssSections = IM.fromDistinctAscList [(-1,filtsection),(0,combsection)] { _sssSections = IM.fromDistinctAscList [(-1,filtsection),(0,combsection)]
, _sssSelPos = selpos , _sssExtra = SSSExtra
{_sssSelPos = selpos
, _sssFilters=IM.singleton (-1) Nothing
}
} }
selpos | null cm' = Nothing selpos | null cm' = Nothing
| otherwise = Just (0,0) | otherwise = Just (0,0)
src/Dodge/Data/HUD.hs
+2 -2
View File
@@ -16,7 +16,7 @@ import Data.IntMap.Strict (IntMap)
data HUDElement data HUDElement
= DisplayInventory = DisplayInventory
{ _subInventory :: SubInventory { _subInventory :: SubInventory
, _diSections :: FilterableSections () , _diSections :: SelectionSections ()
} }
| DisplayCarte | DisplayCarte
@@ -25,7 +25,7 @@ data SubInventory
| ExamineInventory {_subInvMSel :: Maybe Int} | ExamineInventory {_subInvMSel :: Maybe Int}
-- | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem} -- | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem}
| CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem) | CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem)
, _ciSections :: FilterableSections CombinableItem , _ciSections :: SelectionSections CombinableItem
} }
| LockedInventory | LockedInventory
| DisplayTerminal {_termID :: Int} | DisplayTerminal {_termID :: Int}
src/Dodge/Data/SelectionList.hs
+9 -13
View File
@@ -30,23 +30,19 @@ data SelectionList a = SelectionList
} }
--deriving (Eq, Ord, Show, Read) --Generic, Flat) --deriving (Eq, Ord, Show, Read) --Generic, Flat)
-- this is projected to be VERY arbitrary: the fssFilters point to the lower of
-- a pair of ints (i,i+1) such that the lower is the regex section, the higher
-- is the items section.
data FilterableSections a = FilterableSections
{ _fssFilters :: IntMap (Maybe String)
, _fssSections :: SelectionSections a
}
data SelectionSections a = SelectionSections data SelectionSections a = SelectionSections
{ _sssSections :: IntMap (SelectionSection a) { _sssSections :: IntMap (SelectionSection a)
, _sssSelPos :: Maybe (Int,Int) , _sssExtra :: SSSExtra
} }
--data SSSExtra :: SSSExtra -- note that filters are arbitrary: the sssFilters point to the lower of
-- { _sssSelPos :: Maybe (Int,Int) -- a pair of ints (i,i+1) such that the lower is the regex section, the higher
-- , _sssFilters :: IntMap (Maybe String -- is the items section.
-- } data SSSExtra = SSSExtra
{ _sssSelPos :: Maybe (Int,Int)
, _sssFilters :: IntMap (Maybe String)
}
data SectionCursor = SectionCursor data SectionCursor = SectionCursor
{ _scurPos :: Int { _scurPos :: Int
@@ -100,7 +96,7 @@ makeLenses ''SelectionList
makeLenses ''SelectionItem makeLenses ''SelectionItem
makeLenses ''SelectionSection makeLenses ''SelectionSection
makeLenses ''SelectionSections makeLenses ''SelectionSections
makeLenses ''FilterableSections makeLenses ''SSSExtra
makeLenses ''SectionCursor makeLenses ''SectionCursor
--deriveJSON defaultOptions ''SelectionItem --deriveJSON defaultOptions ''SelectionItem
--deriveJSON defaultOptions ''SelectionList --deriveJSON defaultOptions ''SelectionList
src/Dodge/Default/World.hs
+11 -11
View File
@@ -143,11 +143,11 @@ defaultLWorld =
, _lClock = 0 , _lClock = 0
} }
defaultDisplaySections :: SelectionSections a --defaultDisplaySections :: SelectionSections a
defaultDisplaySections = SelectionSections --defaultDisplaySections = SelectionSections
{ _sssSections = mempty -- { _sssSections = mempty
, _sssSelPos = Just (0,0) -- , _sssSelPos = Just (0,0)
} -- }
defaultHUD :: HUD defaultHUD :: HUD
defaultHUD = defaultHUD =
@@ -162,7 +162,7 @@ defaultHUD =
defaultDisplayInventory :: HUDElement defaultDisplayInventory :: HUDElement
defaultDisplayInventory = DisplayInventory defaultDisplayInventory = DisplayInventory
{_subInventory = NoSubInventory {_subInventory = NoSubInventory
, _diSections = defaultFiltInv , _diSections = defaultInvSections
-- , _invRegex = Nothing -- , _invRegex = Nothing
-- , _closeRegex = Nothing -- , _closeRegex = Nothing
} }
@@ -179,10 +179,10 @@ defaultDisplayInventory = DisplayInventory
-- where -- where
-- f (V2 x y) = V3 x y 100 -- f (V2 x y) = V3 x y 100
defaultFiltInv :: FilterableSections () defaultSSSExtra :: SSSExtra
defaultFiltInv = FilterableSections defaultSSSExtra = SSSExtra
{_fssFilters = IM.fromList [(-1,mempty),(2,mempty)] {_sssFilters = IM.fromList [(-1,mempty),(2,mempty)]
,_fssSections =defaultInvSections ,_sssSelPos = Nothing
} }
defaultInvSections :: SelectionSections () defaultInvSections :: SelectionSections ()
@@ -195,7 +195,7 @@ defaultInvSections = SelectionSections
& ssDescriptor .~ "NEARBY") & ssDescriptor .~ "NEARBY")
, defaultCOSection , defaultCOSection
] ]
, _sssSelPos = Nothing , _sssExtra = defaultSSSExtra
} }
defaultSS :: SelectionSection a defaultSS :: SelectionSection a
defaultSS = SelectionSection defaultSS = SelectionSection
src/Dodge/DisplayInventory.hs
+24 -22
View File
@@ -3,7 +3,7 @@ module Dodge.DisplayInventory
( updateDisplayInventory ( updateDisplayInventory
, defaultSS , defaultSS
, defaultFiltSection , defaultFiltSection
, defaultDisplaySections -- , defaultDisplaySections
, updateSection , updateSection
) where ) where
@@ -26,8 +26,8 @@ import Dodge.Data.World
updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections () updateDisplayInventory :: World -> Configuration -> SelectionSections () -> SelectionSections ()
updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
Just mo -> updateSectionsPositioning Just mo -> sss & sssSections %~ updateSectionsPositioning
(sss & sssSelPos ?~ manObjIndex mo) (sss ^. sssExtra . sssSelPos)
availablelines availablelines
(addorder mo) (addorder mo)
_ -> error "error when getting cr inv sel" _ -> error "error when getting cr inv sel"
@@ -38,8 +38,8 @@ updateDisplayInventory w cfig sss = case cr ^? crManipulation . manObject of
SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex] SelNothing -> reverse [filtinv,filtclose,invx ,youx, closex]
InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx] InNearby SortNearby -> reverse [filtinv,filtclose,closex, invx ,youx]
InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx] InNearby SelCloseObject {} -> reverse [filtinv,filtclose,closex, invx ,youx]
(filtinv,invx) = filtpair (-1) (hud . hudElement . diSections . fssFilters . ix (-1) . _Just) invitems' "INV. " (filtinv,invx) = filtpair (-1) (hud . hudElement . diSections . sssExtra . sssFilters . ix (-1) . _Just) invitems' "INV. "
(filtclose,closex) = filtpair 2 (hud . hudElement . diSections . fssFilters . ix 2 . _Just) coitems' "NEARBY " (filtclose,closex) = filtpair 2 (hud . hudElement . diSections . sssExtra . sssFilters . ix 2 . _Just) 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
@@ -72,31 +72,33 @@ displayFreeSlots x = case x of
_ -> show x ++ " FREE SLOTS" _ -> show x ++ " FREE SLOTS"
updateSectionsPositioning updateSectionsPositioning
:: SelectionSections a :: Maybe (Int,Int)
-> Int -> [(Int,IM.IntMap (SelectionItem a))] -> Int
-> SelectionSections a -> [(Int,IM.IntMap (SelectionItem a))]
updateSectionsPositioning sss _ [] = sss & sssSections .~ mempty -> IM.IntMap (SelectionSection a)
updateSectionsPositioning sss allavailablelines ((k,y) : xs) -> IM.IntMap (SelectionSection a)
= previoussections & sssSections %~ IM.insert k ss updateSectionsPositioning _ _ [] _ = mempty
updateSectionsPositioning mselpos allavailablelines ((k,y) : xs) sss
= IM.insert k ss previoussections
where where
mscel = do mscel = do
(i,j) <- sss ^? sssSelPos . _Just (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 ^?! sssSections . ix k x = sss ^?! ix k
availablelines = allavailablelines - _ssMinSize x availablelines = allavailablelines - _ssMinSize x
linesleft = allavailablelines - sum (fmap linestaken $ _sssSections previoussections) linesleft = allavailablelines - sum (fmap linestaken $ previoussections)
linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss') linestaken ss' = max (length $ _ssShownItems ss') (_ssMinSize ss')
previoussections = updateSectionsPositioning sss availablelines xs previoussections = updateSectionsPositioning mselpos availablelines xs sss
manObjIndex :: ManipulatedObject -> (Int,Int) --manObjIndex :: ManipulatedObject -> (Int,Int)
manObjIndex mo = case mo of --manObjIndex mo = case mo of
InInventory SortInventory -> (-1, 0) -- InInventory SortInventory -> (-1, 0)
InInventory (SelItem i _) -> (0, i) -- InInventory (SelItem i _) -> (0, i)
SelNothing -> (1,0) -- SelNothing -> (1,0)
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)
src/Dodge/InputFocus.hs
+23 -43
View File
@@ -11,7 +11,7 @@ module Dodge.InputFocus (
) where ) where
import Control.Monad import Control.Monad
import Data.IntMap.Strict (IntMap) --import Data.IntMap.Strict (IntMap)
import Data.Maybe import Data.Maybe
import Dodge.Data.SelectionList import Dodge.Data.SelectionList
import Dodge.Data.World import Dodge.Data.World
@@ -25,57 +25,39 @@ inTermFocus w = fromMaybe False $ do
return $ hasfocus && connectionstatus == TerminalReady return $ hasfocus && connectionstatus == TerminalReady
regexScope :: regexScope ::
(Applicative f1, Applicative f2, Num c) => (Applicative f) =>
World -> World ->
Maybe Maybe
( ( IntMap (Maybe String) -> ((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int)
f1 (IntMap (Maybe String))
) ->
HUDElement ->
f1 HUDElement
, (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) ->
HUDElement ->
f2 HUDElement
, c
)
regexScope w = case w ^? hud . hudElement . subInventory of regexScope w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just (-1, _) -> di (-1) Just (-1, _) -> di (-1)
Just (0, _) -> di (-1) Just (0, _) -> di (-1)
Just (2, _) -> di 2 Just (2, _) -> di 2
Just (3, _) -> di 2 Just (3, _) -> di 2
_ -> Nothing _ -> Nothing
Just CombineInventory{} -> Just CombineInventory{} ->
Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1)) Just (subInventory . ciSections . sssExtra, (-1))
_ -> Nothing _ -> Nothing
where where
di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x) di x = Just (diSections . sssExtra, x)
he = w ^. hud . hudElement he = w ^. hud . hudElement
regexFocus :: regexFocus ::
(Applicative f1, Applicative f2, Num c) => (Applicative f) =>
World -> World ->
Maybe Maybe
( ( IntMap (Maybe String) -> ((SSSExtra -> f SSSExtra) -> HUDElement -> f HUDElement, Int)
f1 (IntMap (Maybe String))
) ->
HUDElement ->
f1 HUDElement
, (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) ->
HUDElement ->
f2 HUDElement
, c
)
regexFocus w = case w ^? hud . hudElement . subInventory of regexFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just (-1, _) -> di (-1) Just (-1, _) -> di (-1)
Just (2, _) -> di 2 Just (2, _) -> di 2
_ -> Nothing _ -> Nothing
Just CombineInventory{} -> Just CombineInventory{} ->
Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1)) Just (subInventory . ciSections . sssExtra, (-1))
_ -> Nothing _ -> Nothing
where where
di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x) di x = Just (diSections . sssExtra, x)
he = w ^. hud . hudElement he = w ^. hud . hudElement
inInputFocus :: World -> Bool inInputFocus :: World -> Bool
@@ -89,12 +71,12 @@ inputFocus ::
World -> World ->
Maybe ((String -> f String) -> World -> f World) Maybe ((String -> f String) -> World -> f World)
inputFocus w = case w ^? hud . hudElement . subInventory of inputFocus w = case w ^? hud . hudElement . subInventory of
Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of Just NoSubInventory -> case he ^? diSections . sssExtra . sssSelPos . _Just of
Just (-1, _) -> di (-1) Just (-1, _) -> di (-1)
Just (2, _) -> di 2 Just (2, _) -> di 2
_ -> Nothing _ -> Nothing
Just CombineInventory{} -> case he ^? subInventory . ciSections . fssSections . sssSelPos . _Just of Just CombineInventory{} -> case he ^? subInventory . ciSections . sssExtra . sssSelPos . _Just of
Just (-1, _) -> Just $ hud . hudElement . subInventory . ciSections . fssFilters . ix (-1) . _Just Just (-1, _) -> Just $ hud . hudElement . subInventory . ciSections . sssExtra . sssFilters . ix (-1) . _Just
_ -> Nothing _ -> Nothing
Just DisplayTerminal{_termID = tmid} -> do Just DisplayTerminal{_termID = tmid} -> do
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
@@ -103,25 +85,23 @@ inputFocus w = case w ^? hud . hudElement . subInventory of
return $ cWorld . lWorld . terminals . ix tmid . tmInput . tiText return $ cWorld . lWorld . terminals . ix tmid . tmInput . tiText
_ -> Nothing _ -> Nothing
where where
di x = Just $ hud . hudElement . diSections . fssFilters . ix x . _Just di x = Just $ hud . hudElement . diSections . sssExtra . sssFilters . ix x . _Just
he = w ^. hud . hudElement he = w ^. hud . hudElement
inTopRegex :: Int -> World -> Bool
inTopRegex x w = fromMaybe False $ do
i <- w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _1
return $ i == x
inInvRegex :: World -> Bool inInvRegex :: World -> Bool
inInvRegex w = fromMaybe False $ do inInvRegex = inTopRegex (-1)
sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1)
inCloseRegex :: World -> Bool inCloseRegex :: World -> Bool
inCloseRegex w = fromMaybe False $ do inCloseRegex = inTopRegex 2
sss <- w ^? hud . hudElement . diSections . fssSections
i <- sss ^? sssSelPos . _Just . _1
return $ i == 2
inSubInvRegex :: World -> Bool inSubInvRegex :: World -> Bool
inSubInvRegex w = fromMaybe False $ do inSubInvRegex w = fromMaybe False $ do
sss <- w ^? hud . hudElement . subInventory . ciSections . fssSections i <- w ^? hud . hudElement . subInventory . ciSections . sssExtra . sssSelPos . _Just . _1
i <- sss ^? sssSelPos . _Just . _1
return $ i == (-1) return $ i == (-1)
--inputFocus :: World -> Bool --inputFocus :: World -> Bool
src/Dodge/Inventory.hs
+6 -6
View File
@@ -106,7 +106,7 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan
Nothing -> w Nothing -> w
selNumPos :: ManipulatedObject -> World -> Maybe Int selNumPos :: ManipulatedObject -> World -> Maybe Int
selNumPos mo w = w ^? hud . hudElement . diSections . fssSections >>= selNumPos mo w = w ^? hud . hudElement . diSections >>=
case mo of case mo of
InInventory SortInventory -> selSecSelPos (-1) 0 InInventory SortInventory -> selSecSelPos (-1) 0
InInventory (SelItem i _) -> selSecSelPos 0 i InInventory (SelItem i _) -> selSecSelPos 0 i
@@ -164,7 +164,7 @@ updateCloseObjects w =
= case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of
Just i Just i
| i >= length newcloseobjects -> scrollAugInvSel 1 | i >= length newcloseobjects -> scrollAugInvSel 1
| isNothing (w ^? hud . hudElement . diSections . fssSections . sssSections . ix 3 . ssItems . ix i) | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i)
-> scrollAugInvSel (-1) -> scrollAugInvSel (-1)
_ -> id _ -> id
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
@@ -346,7 +346,7 @@ scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w scrollAugInvSel yi w
| yi == 0 = w | yi == 0 = w
| otherwise = | otherwise =
w & hud . hudElement . diSections . fssSections %~ scrollSelectionSections yi w & hud . hudElement . diSections %~ scrollSelectionSections yi
& setInvPosFromSS & setInvPosFromSS
setInvPosFromSS :: World -> World setInvPosFromSS :: World -> World
@@ -354,8 +354,8 @@ setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where where
thesel = fromMaybe SelNothing $ do thesel = fromMaybe SelNothing $ do
sss <- w ^? hud . hudElement . diSections . fssSections sss <- w ^? hud . hudElement . diSections
(i,j) <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssExtra . sssSelPos . _Just
case i of case i of
(-1) -> Just $ InInventory SortInventory (-1) -> Just $ InInventory SortInventory
0 -> Just $ InInventory (SelItem j NoInvSelAction) 0 -> Just $ InInventory (SelItem j NoInvSelAction)
@@ -368,5 +368,5 @@ setInvPosFromSS w = w
selectedCloseObject :: World -> Maybe (Either FloorItem Button) selectedCloseObject :: World -> Maybe (Either FloorItem Button)
selectedCloseObject w = do selectedCloseObject w = do
i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject
<|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . fssSections . sssSections . ix 3 . ssItems) <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems)
w ^? hud . closeObjects . ix i w ^? hud . closeObjects . ix i
src/Dodge/Render/HUD.hs
+9 -9
View File
@@ -38,7 +38,7 @@ drawHUD cfig w = case w ^. hud . hudElement of
DisplayCarte -> drawCarte cfig w DisplayCarte -> drawCarte cfig w
DisplayInventory {_diSections = sections, _subInventory = subinv} -> DisplayInventory {_diSections = sections, _subInventory = subinv} ->
drawHP cfig w drawHP cfig w
<> inventoryDisplay (sections ^. fssSections) w cfig <> inventoryDisplay sections w cfig
<> drawSubInventory subinv cfig w <> drawSubInventory subinv cfig w
drawHP :: Configuration -> World -> Picture drawHP :: Configuration -> World -> Picture
@@ -80,7 +80,7 @@ drawSelectionSections sss ldps cfig = listPicturesAtScaleOff
<> thecursor' <> thecursor'
where where
thecursor' = fromMaybe mempty $ do thecursor' = fromMaybe mempty $ do
(i,j) <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssExtra . sssSelPos . _Just
return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j return $ selSecDrawCursor 15 [North,South,West] cfig ldps sss i j
pics = foldMap _ssShownItems (_sssSections sss) pics = foldMap _ssShownItems (_sssSections sss)
@@ -93,7 +93,7 @@ drawSubInventory subinv cfig w = case subinv of
NoSubInventory -> drawNoSubInventory cfig w NoSubInventory -> drawNoSubInventory cfig w
ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld) DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory {_ciSections = FilterableSections {_fssSections = sss}} CombineInventory {_ciSections = sss}
-> titledSub' cfig "COMBINE" sss -> titledSub' cfig "COMBINE" sss
<> combineInventoryExtra sss cfig w <> combineInventoryExtra sss cfig w
@@ -156,11 +156,11 @@ drawNoSubInventory cfig w =
where where
equipcursor = fromMaybe mempty $ do equipcursor = fromMaybe mempty $ do
invid <- cr ^. crLeftInvSel . lisMPos invid <- cr ^. crLeftInvSel . lisMPos
sss <- w ^? hud . hudElement . diSections . fssSections sss <- w ^? hud . hudElement . diSections
pos <- selSecSelPos 0 invid sss pos <- selSecSelPos 0 invid sss
return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $_crInvEquipped cr IM.! invid return $ listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $_crInvEquipped cr IM.! invid
f col invid epos = fromMaybe mempty $ do f col invid epos = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections . fssSections sss <- w ^? hud . hudElement . diSections
pos <- selSecSelPos 0 invid sss pos <- selSecSelPos 0 invid sss
return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
@@ -179,7 +179,7 @@ examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
combineInventoryExtra sss cfig w = fromMaybe mempty $ do combineInventoryExtra sss cfig w = fromMaybe mempty $ do
(i,j) <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssExtra . sssSelPos . _Just
si <- sss ^? sssSections . ix i . ssItems . ix j si <- sss ^? sssSections . ix i . ssItems . ix j
cpos <- selSecSelPos i j sss cpos <- selSecSelPos i j sss
let col = _siColor si let col = _siColor si
@@ -197,7 +197,7 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
] ]
where where
invcursor i = fromMaybe mempty $ do invcursor i = fromMaybe mempty $ do
sss' <- w ^? hud . hudElement . diSections . fssSections 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
-- fromMaybe mempty $ do -- fromMaybe mempty $ do
-- i <- mi -- i <- mi
@@ -324,7 +324,7 @@ combineCounts cfig w = winScale cfig . foldMap f . group
where where
f (i : is) = fromMaybe mempty $ do f (i : is) = fromMaybe mempty $ do
_ <- yourInv w ^? ix i . itUse . useAmount _ <- yourInv w ^? ix i . itUse . useAmount
sss <- w ^? hud . hudElement . diSections . fssSections sss <- w ^? hud . hudElement . diSections
p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
col <- selSecSelCol 0 i sss col <- selSecSelCol 0 i sss
return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1)) return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
@@ -335,7 +335,7 @@ lnkMidPosInvSelsCol cfig w i col = winScale cfig
. foldMap f . foldMap f
where where
f j = fromMaybe mempty $ do f j = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections . fssSections sss <- w ^? hud . hudElement . diSections
h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j
invcol <- selSecSelCol 0 j sss invcol <- selSecSelCol 0 j sss
return $ zConnectCol rp (V2 18 0 + h) col white white invcol return $ zConnectCol rp (V2 18 0 + h) col white white invcol
src/Dodge/SelectionSections.hs
+6 -6
View File
@@ -23,10 +23,10 @@ scrollSelectionSections yi sss
setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
setFirstPosSelectionSections sss = fromMaybe sss $ do setFirstPosSelectionSections sss = fromMaybe sss $ do
(i, j, _) <- ssLookupMin sss (i, j, _) <- ssLookupMin sss
return $ sss & sssSelPos ?~ (i, j) return $ sss & sssExtra . sssSelPos ?~ (i, j)
scrollUpSelectionSections :: SelectionSections a -> SelectionSections a scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
scrollUpSelectionSections sss = sss & sssSelPos .~ scrollUpSelectionSections sss = sss & sssExtra . sssSelPos .~
fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) fmap f (ssScrollUp (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where where
f (i,j,_) = (i,j) f (i,j,_) = (i,j)
@@ -35,18 +35,18 @@ ssScrollUp :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssScrollUp sss = l <|> ssLookupMin sss ssScrollUp sss = l <|> ssLookupMin sss
where where
l = do l = do
(i,j) <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssExtra . sssSelPos . _Just
ssLookupUp i j sss ssLookupUp i j sss
ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a) ssScrollDown :: SelectionSections a -> Maybe (Int,Int,SelectionItem a)
ssScrollDown sss = l <|> ssLookupMin sss ssScrollDown sss = l <|> ssLookupMin sss
where where
l = do l = do
(i,j) <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssExtra . sssSelPos . _Just
ssLookupDown i j sss ssLookupDown i j sss
scrollDownSelectionSections :: SelectionSections a -> SelectionSections a scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
scrollDownSelectionSections sss = sss & sssSelPos .~ scrollDownSelectionSections sss = sss & sssExtra . sssSelPos .~
fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))) fmap f (ssScrollDown (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
where where
f (i,j,_) = (i,j) f (i,j,_) = (i,j)
@@ -61,7 +61,7 @@ ssSetCursor f sss = fromMaybe sss $ do
(i, j, _) <- f sss (i, j, _) <- f sss
return $ return $
sss sss
& sssSelPos ?~ (i, j) & sssExtra . sssSelPos ?~ (i, j)
-- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si) -- & sssSections . ix i . ssCursor ?~ SectionCursor j j (_siHeight si) (_siColor si)
src/Dodge/TestString.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Dodge.Data.Universe
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
testStringInit :: Universe -> [String] testStringInit :: Universe -> [String]
testStringInit u = testStringInit u =
[show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . fssSections . sssSections] [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . diSections . sssSections]
--[ show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation --[ 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) ++ lines (unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation)
src/Dodge/Update.hs
+1 -1
View File
@@ -82,7 +82,7 @@ updateUniverse u =
cfig = u ^. uvConfig cfig = u ^. uvConfig
updateInventoryDisplay :: Universe -> Universe updateInventoryDisplay :: Universe -> Universe
updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections . fssSections updateInventoryDisplay u = u & uvWorld . hud . hudElement . diSections
%~ updateDisplayInventory (_uvWorld u) (_uvConfig u) %~ updateDisplayInventory (_uvWorld u) (_uvConfig u)
maybeOpenTerminal :: Universe -> Universe maybeOpenTerminal :: Universe -> Universe
src/Dodge/Update/Input.hs
+21 -23
View File
@@ -56,7 +56,7 @@ updateUseInputInGame h u = case h of
| inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
| lbinitialpress -> | lbinitialpress ->
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
CombineInventory {_ciSections = FilterableSections {_fssSections = sss}} CombineInventory {_ciSections = sss}
| inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1) | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1)
| lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u
-- _ -> case regexFocus w of -- _ -> case regexFocus w of
@@ -73,7 +73,7 @@ updateUseInputInGame h u = case h of
tryCombine :: SelectionSections CombinableItem -> World -> World tryCombine :: SelectionSections CombinableItem -> World -> World
tryCombine sss w = fromMaybe w $ do tryCombine sss w = fromMaybe w $ do
(i,j) <- sss ^? sssSelPos . _Just (i,j) <- sss ^? sssExtra . sssSelPos . _Just
CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is) return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
@@ -106,22 +106,20 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
Just LongPress -> True Just LongPress -> True
_ -> False _ -> False
doRegexInput :: Universe -> Int -> FilterableSections a -> FilterableSections a doRegexInput :: Universe -> Int -> SelectionSections a -> SelectionSections a
doRegexInput u i fss doRegexInput u i sss
| backspacetonothing || escapekey = endregex i 0 | backspacetonothing || escapekey = endregex i 0
| endkeys || endmouse = endregex (i + 1) (j -1) | endkeys || endmouse = endregex (i + 1) (j -1)
| otherwise = fss & doTextInputOver' u (fssFilters . ix i . _Just) | otherwise = sss & doTextInputOver' u (sssExtra . sssFilters . ix i . _Just)
where where
endregex a b = endregex a b =
fss sss
& fssFilters . ix i .~ Nothing & sssExtra . sssFilters . ix i .~ Nothing
& fssSections & sssSections . ix i . ssItems .~ mempty
%~ ( ssSetCursor (ssLookupDown a b) & ssSetCursor (ssLookupDown a b)
. (sssSections . ix i . ssItems .~ mempty)
)
-- & uvWorld %~ setInvPosFromSS -- & uvWorld %~ setInvPosFromSS
j = fromMaybe 0 $ do j = fromMaybe 0 $ do
itms <- fss ^? fssSections . sssSections . ix (i + 1) . ssItems itms <- sss ^? sssSections . ix (i + 1) . ssItems
fst <$> IM.lookupMin itms fst <$> IM.lookupMin itms
escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
endkeys = endkeys =
@@ -130,7 +128,7 @@ doRegexInput u i fss
[ScancodeReturn, ScancodeSlash] [ScancodeReturn, ScancodeSlash]
endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft) endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
backspacetonothing = backspacetonothing =
fss ^? fssFilters . ix i . _Just == Just "" sss ^? sssExtra . sssFilters . ix i . _Just == Just ""
&& ScancodeBackspace `M.lookup` pkeys == Just InitialPress && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
pkeys = u ^. uvWorld . input . pressedKeys pkeys = u ^. uvWorld . input . pressedKeys
@@ -197,16 +195,16 @@ updateBackspaceRegex w = case di ^? subInventory of
_ -> w _ -> w
where where
secfocus a b = fromMaybe False $ do secfocus a b = fromMaybe False $ do
i <- di ^? diSections . fssSections . sssSelPos . _Just . _1 i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1
return $ i == a || i == b return $ i == a || i == b
trybackspace x fss = fromMaybe fss $ do trybackspace x sss = fromMaybe sss $ do
-- i <- fss ^? fssSections . sssSelPos . _Just . _1 -- i <- fss ^? fssSections . sssSelPos . _Just . _1
-- guard (i == x || i == x+1) -- guard (i == x || i == x+1)
str <- fss ^? fssFilters . ix x . _Just str <- sss ^? sssExtra . sssFilters . ix x . _Just
return $ case str of return $ case str of
(_ : _) -> fss & fssFilters . ix x . _Just %~ init (_ : _) -> sss & sssExtra . sssFilters . ix x . _Just %~ init
& fssSections . sssSelPos ?~ (x,0) & sssExtra . sssSelPos ?~ (x,0)
[] -> fss & fssFilters . ix x .~ Nothing [] -> sss & sssExtra . sssFilters . ix x .~ Nothing
di = w ^. hud . hudElement di = w ^. hud . hudElement
updateEnterRegex :: World -> World updateEnterRegex :: World -> World
@@ -225,10 +223,10 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
where where
di = w ^. hud . hudElement di = w ^. hud . hudElement
secfocus a b = fromMaybe False $ do secfocus a b = fromMaybe False $ do
i <- di ^? diSections . fssSections . sssSelPos . _Just . _1 i <- di ^? diSections . sssExtra . sssSelPos . _Just . _1
return $ i == a || i == b return $ i == a || i == b
enterregex x fss = fss & fssFilters . ix x %~ f enterregex x sss = sss & sssExtra . sssFilters . ix x %~ f
& fssSections . sssSelPos ?~ (x,0) & sssExtra . sssSelPos ?~ (x,0)
f Nothing = Just "" f Nothing = Just ""
f x = x f x = x
@@ -258,7 +256,7 @@ spaceAction w = case w ^?! hud . hudElement of
toggleMap :: Universe -> Universe toggleMap :: Universe -> Universe
toggleMap u = case u ^?! uvWorld . hud . hudElement of toggleMap u = case u ^?! uvWorld . hud . hudElement of
DisplayCarte -> u & uvWorld . hud . hudElement DisplayCarte -> u & uvWorld . hud . hudElement
.~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultFiltInv} .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections}
_ -> u & uvWorld . hud . hudElement .~ DisplayCarte _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World toggleTweakInv :: World -> World
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -49,7 +49,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w) invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
moveCombineSel :: Int -> World -> World moveCombineSel :: Int -> World -> World
moveCombineSel yi = hud . hudElement . subInventory . ciSections . fssSections moveCombineSel yi = hud . hudElement . subInventory . ciSections
%~ scrollSelectionSections yi %~ scrollSelectionSections yi
moveSubSel :: Int -> Int -> World -> World moveSubSel :: Int -> Int -> World -> World