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

Flatten HUDElement

Browse Source
This commit is contained in:
justin
2025-08-26 16:46:02 +01:00
parent 596880f76a
commit 9034c409e1
24 changed files with 255 additions and 270 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+2 -2
View File
@@ -188,8 +188,8 @@ dropItem cr invid w' =
itid <- cr ^? crInv . ix (NInt invid)
w' ^? cWorld . lWorld . items . ix itid
maybeshiftseldown w = fromMaybe w $ do
3 <- w ^? hud . hudElement . diSelection . _Just . _1
return $ w & hud . hudElement . diSelection . _Just . _2 +~ 1
3 <- w ^? hud . diSelection . _Just . _1
return $ w & hud . diSelection . _Just . _2 +~ 1
-- | Get your creature to drop the item under the cursor.
youDropItem :: World -> World
src/Dodge/Creature/Impulse/UseItem.hs
+6 -6
View File
@@ -106,11 +106,11 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
onremove itm' = effectOnRemove itm'
toggleExamineInv :: World -> World
toggleExamineInv w = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . hudElement . subInventory .~ ExamineInventory
toggleExamineInv w = case w ^? hud . subInventory of
Just ExamineInventory{} -> w & hud . subInventory .~ NoSubInventory
_ -> w & hud . subInventory .~ ExamineInventory
toggleMapperInv :: Item -> World -> World
toggleMapperInv itm w = case w ^? hud . hudElement . subInventory of
Just MapperInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . hudElement . subInventory .~ MapperInventory 0 1 (_itID itm)
toggleMapperInv itm w = case w ^? hud . subInventory of
Just MapperInventory{} -> w & hud . subInventory .~ NoSubInventory
_ -> w & hud . subInventory .~ MapperInventory 0 1 (_itID itm)
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -29,7 +29,7 @@ import qualified SDL
yourControl :: Creature -> World -> World
yourControl _ w
| inTextInputFocus w = w
| Just x <- w ^? hud . hudElement . subInventory
| Just x <- w ^? hud . subInventory
, f x =
w
& cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
src/Dodge/Data/HUD.hs
+15 -18
View File
@@ -5,42 +5,36 @@
module Dodge.Data.HUD where
import qualified Data.IntSet as IS
import Dodge.Data.Item.Location
import NewInt
import Control.Lens
import Data.IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Dodge.Data.Combine
import Dodge.Data.Item.Location
import Dodge.Data.SelectionList
import Geometry.Data
data HUDElement
= DisplayInventory
{ _subInventory :: SubInventory
, _diSections :: IMSS ()
, _diSelection :: Maybe (Int, Int, IntSet)
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
}
import NewInt
data SubInventory
= NoSubInventory
| ExamineInventory
| MapperInventory
{_mapInvOffset :: Point2
| MapperInventory
{ _mapInvOffset :: Point2
, _mapInvZoom :: Float
, _mapInvItmID :: NewInt ItmInt
}
| CombineInventory
{ _ciSections :: IntMap (SelectionSection CombinableItem)
{ _ciSections :: IMSS CombinableItem
, _ciSelection :: Maybe (Int, Int, IS.IntSet)
, _ciFilter :: Maybe String
}
| DisplayTerminal {_termID :: Int}
data HUD = HUD
{ _hudElement :: HUDElement
{ _subInventory :: SubInventory
, _diSections :: IMSS ()
, _diSelection :: Maybe (Int, Int, IntSet)
, _diInvFilter :: Maybe String
, _diCloseFilter :: Maybe String
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
@@ -48,6 +42,9 @@ data HUD = HUD
, _closeButtons :: [Int]
}
data Selection
= Sel {_slSec :: Int, _slInt :: Int, _slSet :: IS.IntSet}
| NoSel
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
src/Dodge/Data/SelectionList.hs
+1 -3
View File
@@ -36,9 +36,7 @@ data SelectionSection a = SelectionSection
type IMSS a = IntMap (SelectionSection a)
data SelectionWidth
= FixedSelectionWidth Int
| UseItemWidth
data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
data SelectionItem a
= SelItem
src/Dodge/Default/World.hs
+5 -11
View File
@@ -159,20 +159,14 @@ defaultLWorld =
defaultHUD :: HUD
defaultHUD =
HUD
{ _hudElement = defaultDisplayInventory
{ _subInventory = NoSubInventory
, _diSections = mempty
, _diSelection = Just (1, 0, mempty)
, _diInvFilter = mempty
, _diCloseFilter = mempty
, _carteCenter = V2 0 0
, _carteZoom = 0.5
, _carteRot = 0
, _closeItems = mempty
, _closeButtons = mempty
}
defaultDisplayInventory :: HUDElement
defaultDisplayInventory =
DisplayInventory
{ _subInventory = NoSubInventory
, _diSections = mempty
, _diSelection = Just (1, 0, mempty)
, _diInvFilter = mempty
, _diCloseFilter = mempty
}
src/Dodge/DisplayInventory.hs
+15 -15
View File
@@ -39,9 +39,9 @@ import Picture.Base
updateCombinePositioning :: Universe -> Universe
updateCombinePositioning u =
u
& uvWorld . hud . hudElement . subInventory . ciSections
& uvWorld . hud . subInventory . ciSections
%~ updateCombineSections (_uvWorld u) (_uvConfig u)
& uvWorld . hud . hudElement . subInventory %~ checkCombineSelectionExists
& uvWorld . hud . subInventory %~ checkCombineSelectionExists
updateCombineSections ::
World ->
@@ -51,18 +51,18 @@ updateCombineSections ::
updateCombineSections w cfig =
updateSectionsPositioning
(const 0)
(w ^? hud . hudElement . subInventory . ciSelection . _Just)
(w ^? hud . subInventory . ciSelection . _Just)
(getAvailableListLines secondColumnParams cfig)
(IM.fromDistinctAscList [(-1, sfclose),(0, sclose')])
where
filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1)
filtcurs = w ^? hud . subInventory . ciSelection . _Just . _1 == Just (-1)
(sfclose, sclose) =
filterSectionsPair
filtcurs
(flip . andOrRegex $ regexCombs invitms)
(IM.fromDistinctAscList . zip [0 ..] $ combineList w)
"COMBINATIONS"
$ w ^? hud . hudElement . subInventory . ciFilter . _Just
$ w ^? hud . subInventory . ciFilter . _Just
invitms = _unNIntMap $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
sclose'
| null sclose =
@@ -87,17 +87,17 @@ orRegex f x str = case words str of
updateInventoryPositioning :: Universe -> Universe
updateInventoryPositioning u =
u & uvWorld . hud . hudElement . diSections
u & uvWorld . hud . diSections
%~ updateDisplaySections (_uvWorld u) (_uvConfig u)
& uvWorld
%~ checkInventorySelectionExists
checkInventorySelectionExists :: World -> World
checkInventorySelectionExists w
| isJust $ w ^? hud . hudElement . diSections . ix i . ssItems . ix j = w
| isJust $ w ^? hud . diSections . ix i . ssItems . ix j = w
| otherwise = scrollAugNextInSection w
where
(i, j, _) = fromMaybe (1, -1, mempty) $ w ^? hud . hudElement . diSelection . _Just
(i, j, _) = fromMaybe (1, -1, mempty) $ w ^? hud . diSelection . _Just
checkCombineSelectionExists :: SubInventory -> SubInventory
checkCombineSelectionExists si
@@ -135,15 +135,15 @@ updateDisplaySections w cfig =
]
)
where
mselpos = w ^? hud . hudElement . diSelection . _Just
mselpos = w ^? hud . diSelection . _Just
invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
(sfinv, sinv) =
filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
w ^? hud . hudElement . diInvFilter . _Just
w ^? hud . diInvFilter . _Just
closefiltcurs = mselpos ^? _Just . _1 == Just 2
(sfclose, sclose) =
filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $
w ^? hud . hudElement . diCloseFilter . _Just
w ^? hud . diCloseFilter . _Just
nearbyhead
| null sfclose && not (null sclose) = makehead "NEARBY ITEMS"
| otherwise = sfclose
@@ -315,16 +315,16 @@ regexList = any . List.isInfixOf
toggleCombineInv :: Universe -> Universe
toggleCombineInv uv =
uv & case uv ^? uvWorld . hud . hudElement . subInventory of
Just CombineInventory{} -> uvWorld . hud . hudElement . subInventory .~ NoSubInventory
uv & case uv ^? uvWorld . hud . subInventory of
Just CombineInventory{} -> uvWorld . hud . subInventory .~ NoSubInventory
_ -> uvWorld %~ enterCombineInv (uv ^. uvConfig)
enterCombineInv :: Configuration -> World -> World
enterCombineInv cfig w =
w & hud . hudElement . subInventory
w & hud . subInventory
.~ CombineInventory
{ _ciSections = updateCombineSections w cfig mempty
, _ciSelection = Just (0,0,mempty)
, _ciFilter = Nothing
}
& hud . hudElement . diInvFilter .~ Nothing
& hud . diInvFilter .~ Nothing
src/Dodge/InputFocus.hs
+5 -5
View File
@@ -15,13 +15,13 @@ textInputFocus ::
Applicative f =>
World ->
Maybe ((String -> f String) -> World -> f World)
textInputFocus w = case w ^? hud . hudElement . subInventory of
textInputFocus w = case w ^? hud . subInventory of
Just NoSubInventory{} -> case he ^? diSelection . _Just . _1 of
Just (-1) -> Just $ hud . hudElement . diInvFilter . _Just
Just 2 -> Just $ hud . hudElement . diCloseFilter . _Just
Just (-1) -> Just $ hud . diInvFilter . _Just
Just 2 -> Just $ hud . diCloseFilter . _Just
_ -> Nothing
Just CombineInventory{} -> case he ^? subInventory . ciSelection . _Just . _1 of
Just (-1) -> Just $ hud . hudElement . subInventory . ciFilter . _Just
Just (-1) -> Just $ hud . subInventory . ciFilter . _Just
_ -> Nothing
Just DisplayTerminal{_termID = tmid} -> do
-- connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
@@ -29,4 +29,4 @@ textInputFocus w = case w ^? hud . hudElement . subInventory of
return $ cWorld . lWorld . terminals . ix tmid . tmStatus . tiText
_ -> Nothing
where
he = w ^. hud . hudElement
he = w ^. hud
src/Dodge/Inventory.hs
+8 -8
View File
@@ -87,7 +87,7 @@ rmInvItem cid invid w =
where
pointcid = cWorld . lWorld . creatures . ix cid
updateselectionextra
| cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ const mempty
| cid == 0 = hud . diSelection . _Just . _3 %~ const mempty
| otherwise = id
updateselection
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
@@ -154,7 +154,7 @@ changeSwapOther ::
World ->
World
changeSwapOther manlens n f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix n . ssItems
ss <- w ^? hud . diSections . ix n . ssItems
k <- f i ss
let doswap j
| j == i = k
@@ -166,7 +166,7 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens
%~ doswap
& hud . closeItems %~ swapIndices i k
& hud . hudElement . diSelection . _Just . _2 %~ doswap
& hud . diSelection . _Just . _2 %~ doswap
& worldEventFlags . at InventoryChange ?~ ()
swapItemWith ::
@@ -182,7 +182,7 @@ swapItemWith f (j, i) = case j of
changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
changeSwapWith f w
| Just (j,i,_) <- w ^. hud . hudElement . diSelection = swapItemWith f (j,i) w
| Just (j,i,_) <- w ^. hud . diSelection = swapItemWith f (j,i) w
| otherwise = w
--changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
@@ -195,7 +195,7 @@ changeSwapWith f w
invSetSelection :: (Int, Int, IS.IntSet) -> World -> World
invSetSelection sel w =
w
& hud . hudElement . diSelection ?~ sel
& hud . diSelection ?~ sel
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
@@ -203,7 +203,7 @@ invSetSelection sel w =
invSetSelectionPos :: Int -> Int -> World -> World
invSetSelectionPos i j w =
w
& hud . hudElement . diSelection %~ f
& hud . diSelection %~ f
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
@@ -215,7 +215,7 @@ scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w
| yi == 0 = w
| otherwise =
w & hud . hudElement %~ doscroll
w & hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
@@ -226,7 +226,7 @@ scrollAugInvSel yi w
scrollAugNextInSection :: World -> World
scrollAugNextInSection w =
w & hud . hudElement %~ doscroll
w & hud %~ doscroll
& worldEventFlags . at InventoryChange ?~ ()
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
src/Dodge/Inventory/Add.hs
+1 -1
View File
@@ -43,7 +43,7 @@ tryPutItemInInv cid itid w = do
& updateselectionextra invid
where
updateselectionextra i
| cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ IS.map (f i)
| cid == 0 = hud . diSelection . _Just . _3 %~ IS.map (f i)
| otherwise = id
f j i | i >= _unNInt j = i + 1
| otherwise = i
src/Dodge/Inventory/Location.hs
+1 -1
View File
@@ -97,7 +97,7 @@ setInvPosFromSS w = w
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
where
thesel = fromMaybe SelNothing $ do
(i, j, _) <- w ^? hud . hudElement . diSelection . _Just
(i, j, _) <- w ^? hud . diSelection . _Just
case i of
(-1) -> Just SortInventory
0 -> do
src/Dodge/Inventory/SelectionList.hs
+1 -1
View File
@@ -88,7 +88,7 @@ itemExternalValue itm w cr
displayPulse $ cr ^?! crType . avatarPulse . pulseProgress
| Just t <- itm ^? itType . ibtIntroScanType = Just $ introScanValue cr t
| ITEMSCAN <- itm ^. itType
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
, Just ExamineInventory <- w ^? hud . subInventory
= Just (Right "ON")
| BINGATE <- itm ^. itType = do
invid <- itm ^? itLocation . ilInvID
src/Dodge/Inventory/Swap.hs
+6 -6
View File
@@ -24,11 +24,11 @@ swapInvItems ::
World ->
World
swapInvItems f i w = fromMaybe w $ do
ss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
ss <- w ^? hud . diSections . ix 0 . ssItems
k <- f i ss
let updateselection = case w ^? hud . hudElement . diSelection . _Just of
Just (0, j,_) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
Just (0, j,_) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
let updateselection = case w ^? hud . diSelection . _Just of
Just (0, j,_) | j == k -> hud . diSelection . _Just . _2 .~ i
Just (0, j,_) | j == i -> hud . diSelection . _Just . _2 .~ k
_ -> id
return $
w
@@ -55,11 +55,11 @@ swapInvItems f i w = fromMaybe w $ do
swapAnyExtraSelection :: Int -> Int -> World -> World
swapAnyExtraSelection i k w = fromMaybe w $ do
is <- w ^? hud . hudElement . diSelection . _Just . _3
is <- w ^? hud . diSelection . _Just . _3
let f = if i `IS.member` is then IS.insert k else id
g = if k `IS.member` is then IS.insert i else id
return $
w & hud . hudElement . diSelection . _Just . _3
w & hud . diSelection . _Just . _3
%~ (f . g . IS.delete i . IS.delete k)
checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
src/Dodge/Item/BackgroundEffect.hs
+1 -1
View File
@@ -20,7 +20,7 @@ import Dodge.Wall.Move
import Geometry.Vector
cancelExamineInventory :: World -> World
cancelExamineInventory = hud . hudElement . subInventory %~ f
cancelExamineInventory = hud . subInventory %~ f
where
f ExamineInventory = NoSubInventory
f x = x
src/Dodge/ListDisplayParams.hs
+1 -1
View File
@@ -34,7 +34,7 @@ invDP =
& ldpPos . spPixelOff .~ V2 6 0
invCursorParams :: World -> CursorDisplay
invCursorParams w = BoundaryCursor $ case w ^? hud . hudElement . subInventory of
invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
-- Just ExamineInventory{} -> [North, South, East, West]
Just CombineInventory{} -> []
_ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
src/Dodge/Render/HUD.hs
+18 -18
View File
@@ -46,17 +46,17 @@ import Picture
import SDL (MouseButton (..))
drawHUD :: Configuration -> World -> Picture
drawHUD cfig w = case w ^. hud . hudElement of
drawHUD cfig w = case w ^. hud of
-- DisplayCarte -> drawCarte cfig w
DisplayInventory{_diSections = sections, _subInventory = subinv} ->
HUD {_diSections = sections, _subInventory = subinv} ->
drawInventory sections w cfig
<> drawSubInventory subinv cfig w
drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
drawInventory sss w cfig =
drawSelectionSections sss invDP cfig
<> drawSSCursor sss invDP curs cfig (f $ w ^? hud . hudElement . diSelection . _Just)
<> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) invDP cfig
<> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
<> drawRootCursor w sss (f $ w ^? hud . diSelection . _Just) invDP cfig
<> itemconnections
<> drawMouseOver cfig w
where
@@ -65,7 +65,7 @@ drawInventory sss w cfig =
itemconnections = fromMaybe mempty $ do
inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
case w ^? hud . hudElement . diInvFilter . _Just of
case w ^? hud . diInvFilter . _Just of
Just (_ : _) -> Nothing
_ -> return . drawItemConnections sss cfig $ invAdj inv
@@ -112,7 +112,7 @@ drawMouseOver cfig w =
(j, i) <-
w ^? input . mouseContext . mcoInvSelect
<|> w ^? input . mouseContext . mcoInvFilt
sss <- w ^? hud . hudElement . diSections
sss <- w ^? hud . diSections
return . translateScreenPos cfig (invDP ^. ldpPos)
. color (withAlpha 0.1 white)
-- . color white
@@ -123,7 +123,7 @@ drawMouseOver cfig w =
(j, i) <-
(w ^? input . mouseContext . mcoCombSelect)
<|> (w ^? input . mouseContext . mcoCombCombine)
sss <- w ^? hud . hudElement . subInventory . ciSections
sss <- w ^? hud . subInventory . ciSections
let idp = secondColumnParams
return . translateScreenPos cfig (idp ^. ldpPos)
. color (withAlpha 0.2 white)
@@ -131,15 +131,15 @@ drawMouseOver cfig w =
drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected cfig w = do
ys <- w ^? hud . hudElement . diSelection . _Just . _3
ys <- w ^? hud . diSelection . _Just . _3
guard $
not (IS.null ys)
&& ( case w ^? hud . hudElement . subInventory of
&& ( case w ^? hud . subInventory of
Just NoSubInventory -> True
_ -> False
)
(i, _, _) <- w ^? hud . hudElement . diSelection . _Just
sss <- w ^? hud . hudElement . diSections
(i, _, _) <- w ^? hud . diSelection . _Just
sss <- w ^? hud . diSections
let f x = (selSecDrawCursorAt invDP BackdropCursor sss (i, x) <>)
return . translateScreenPos cfig (invDP ^. ldpPos)
. color (withAlpha 0.2 white)
@@ -149,7 +149,7 @@ drawDragSelected cfig w = do
drawDragSelecting :: Configuration -> World -> Maybe Picture
drawDragSelecting cfig w = do
OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
sss <- w ^? hud . hudElement . diSections
sss <- w ^? hud . diSections
let f x = selSecDrawCursorAt invDP BackdropCursor sss (i, x)
return . translateScreenPos cfig (invDP ^. ldpPos)
. color (withAlpha 0.2 white)
@@ -189,7 +189,7 @@ drawCombineInventory cfig sss w =
curs = BoundaryCursor [North, South, West]
msel =
fmap (\(x, y, _) -> (x, y)) $
w ^? hud . hudElement . subInventory . ciSelection . _Just
w ^? hud . subInventory . ciSelection . _Just
drawExamineInventory :: Configuration -> World -> Picture
drawExamineInventory cfig w =
@@ -253,8 +253,8 @@ drawRBOptions cfig w = fold $ do
you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation invid w
sss <- w ^? hud . hudElement . diSections
(i', j, _) <- w ^? hud . hudElement . diSelection . _Just
sss <- w ^? hud . diSections
(i', j, _) <- w ^? hud . diSelection . _Just
curpos <- selSecYint i' j sss
let ytext = drawListElement 0 1 0 curpos . text
midstr = equipAllocString ae
@@ -349,7 +349,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
return (lnkMidPosInvSelsCol cfig w j col lnks) <> foldMap invcursor lnks
where
invcursor i = do
sss' <- w ^? hud . hudElement . diSections
sss' <- w ^? hud . diSections
return $
translateScreenPos cfig (invDP ^. ldpPos) $
selSecDrawCursor
@@ -391,8 +391,8 @@ lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Pictur
lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
where
f j = do
sss <- w ^? hud . hudElement . diSections
combinesss <- w ^? hud . hudElement . subInventory . ciSections
sss <- w ^? hud . diSections
combinesss <- w ^? hud . subInventory . ciSections
lp <- selNumPos cfig invDP sss 0 j
rp <- selNumPos cfig secondColumnParams combinesss 0 i
invcol <- selSecSelCol 0 j sss
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -115,7 +115,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
where
w = u ^. uvWorld
selsec = u ^? uvWorld . hud . hudElement . diSelection . _Just . _1
selsec = u ^? uvWorld . hud . diSelection . _Just . _1
a = fromMaybe 0 $ do
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return . toClosestMultiple (pi / 32) $
src/Dodge/SelectedClose.hs
+1 -1
View File
@@ -13,7 +13,7 @@ interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e o
getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getSelectedCloseObj w = do
(i, j, _) <- w ^? hud . hudElement . diSelection . _Just
(i, j, _) <- w ^? hud . diSelection . _Just
case i of
3 -> Left <$> w ^? hud . closeItems . ix j
5 -> do
src/Dodge/SelectionSections.hs
+1 -1
View File
@@ -26,7 +26,7 @@ import Geometry.Data
scrollSelectionSections ::
Int ->
IM.IntMap (SelectionSection a) ->
IMSS a ->
Maybe (Int, Int,IS.IntSet) ->
Maybe (Int, Int,IS.IntSet)
scrollSelectionSections yi sss msel
src/Dodge/Update.hs
+8 -8
View File
@@ -333,11 +333,11 @@ updateMagnets lw =
checkTermDist :: World -> World
checkTermDist w = fromMaybe w $ do
tmid <- w ^? hud . hudElement . subInventory . termID
tmid <- w ^? hud . subInventory . termID
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
guard $ dist btpos (_crPos $ you w) > 40
return $ w & hud . hudElement . subInventory .~ NoSubInventory
return $ w & hud . subInventory .~ NoSubInventory
updateMouseContext :: Configuration -> Universe -> Universe
updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
@@ -363,13 +363,13 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
| otherwise = MouseInGame
mpos = w ^. input . mousePos
invdrag i' = fromMaybe (OverInvDrag i' Nothing) $ do
sss <- w ^? hud . hudElement . diSections
sss <- w ^? hud . diSections
(i, j) <- inverseSelNumPos cfig invDP sss mpos
return $ OverInvDrag i' (Just (i, j))
overinv = do
sss <- w ^? hud . hudElement . diSections
sss <- w ^? hud . diSections
selpos@(i, j) <- inverseSelNumPos cfig invDP sss mpos
case w ^? hud . hudElement . subInventory . ciSelection of
case w ^? hud . subInventory . ciSelection of
Just _ | i == 0 -> return $ OverCombFiltInv selpos
Just _ -> Nothing
_ -> do
@@ -377,8 +377,8 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
guard =<< sss ^? ix i . ssItems . ix j . siIsSelectable
return $ OverInvSelect selpos
overcomb = do
sss <- w ^? hud . hudElement . subInventory . ciSections
(xl, xr, _) <- w ^? hud . hudElement . subInventory . ciSelection . _Just
sss <- w ^? hud . subInventory . ciSections
(xl, xr, _) <- w ^? hud . subInventory . ciSelection . _Just
let msel = (xl, xr)
let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
return $ case mpossel of
@@ -387,7 +387,7 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
Just x | x == msel -> OverCombCombine x
Just x -> OverCombSelect x
overterm = do
tmid <- w ^? hud . hudElement . subInventory . termID
tmid <- w ^? hud . subInventory . termID
tm <- w ^? cWorld . lWorld . terminals . ix tmid
return $
if isOverTerminalScreen cfig mpos
src/Dodge/Update/Input/InGame.hs
+56 -56
View File
@@ -43,8 +43,8 @@ import NewInt
import SDL
updateUseInputInGame :: Universe -> Universe
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudElement of
DisplayInventory{_subInventory = si, _diSelection = disel} -> case si of
updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud of
HUD{_subInventory = si, _diSelection = disel} -> case si of
DisplayTerminal tmid -> updateKeysInTerminal tmid u
CombineInventory{_ciSections = sss, _ciSelection = msel@(Just (-1, _, _))} ->
u
@@ -64,7 +64,7 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
& uvWorld %~ setInvPosFromSS
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
tohud = uvWorld . hud . hudElement
tohud = uvWorld . hud
pkeys = u ^. uvWorld . input . pressedKeys
dodisplayregexinput filterprism filterlens x di = fromMaybe di $ do
sss <- di ^? diSections
@@ -98,7 +98,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
OverInvDragSelect{} | ButtonRight `M.member` (w ^. input . mouseButtons) ->
w & input . mouseContext .~ MouseGameRotate
OverInvDragSelect (Just sstart) _ ->
let sss = w ^. hud . hudElement . diSections
let sss = w ^. hud . diSections
msel = inverseSelNumPos cfig invDP sss (w ^. input . mousePos)
in case msel of
Nothing -> w & input . mouseContext . mcoSelEnd .~ Nothing
@@ -112,7 +112,7 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
(IM.lookupMax =<< sss ^? ix (fst sstart) . ssItems)
-- not sure how the above performs when filtering...
OverInvDragSelect Nothing _ -> fromMaybe w $ do
sss <- w ^? hud . hudElement . diSections
sss <- w ^? hud . diSections
ysel <-
inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
@@ -126,9 +126,9 @@ updateMouseHeldInGame cfig w = case w ^. input . mouseContext of
doDrag :: Configuration -> Int -> Int -> Maybe (Int, Int) -> World -> World
doDrag cfig n k mmouseover w = fromMaybe w $ do
guard (n /= 0)
ss <- w ^? hud . hudElement . diSections . ix k . ssItems
ss <- w ^? hud . diSections . ix k . ssItems
x <- mmouseover
is <- w ^? hud . hudElement . diSelection . _Just . _3
is <- w ^? hud . diSelection . _Just . _3
return $
if concurrentIS is
then shiftInvItems cfig n k x is ss w
@@ -138,7 +138,7 @@ tryDropSelected :: Maybe (Int, Int) -> World -> Maybe World
tryDropSelected mpos w = do
guard $ maybe True (\(i, _) -> i == 3) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
(0, _, xs) <- w ^? hud . hudElement . diSelection . _Just
(0, _, xs) <- w ^? hud . diSelection . _Just
return . foldl' (flip $ dropItem cr) w . IS.toDescList $ xs
tryPickupSelected :: Int -> Maybe (Int, Int) -> World -> Maybe World
@@ -146,7 +146,7 @@ tryPickupSelected k mpos w = do
guard $ k == 3
guard $ maybe True (\(i, _) -> i == 0 || i == 1) mpos
cr <- w ^? cWorld . lWorld . creatures . ix 0
xs <- w ^? hud . hudElement . diSelection . _Just . _3
xs <- w ^? hud . diSelection . _Just . _3
let nfreeslots = crNumFreeSlots (w ^. cWorld . lWorld . items) cr
itmstopickup = mapMaybe g $ IS.toList xs
slotsneeded = alaf Sum foldMap itInvHeight itmstopickup
@@ -157,7 +157,7 @@ tryPickupSelected k mpos w = do
_ -> foldl' (flip $ pickUpItem 0) w ispickup & newdisel (length (cr ^. crInv)) xs
where
newdisel j xs =
hud . hudElement . diSelection
hud . diSelection
?~ (0, j, IS.fromDistinctAscList [j .. j + IS.size xs -1])
g i = do
NInt j <- w ^? hud . closeItems . ix i
@@ -171,25 +171,25 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
OverInvDragSelect (Just ssel) mesel
| ScancodeLShift `M.member` (w ^. input . pressedKeys) ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3
& hud . diSelection . _Just . _3
%~ getuniques
( maybe
mempty
(h ssel)
(guard (ssel ^? _1 == w ^? hud . hudElement . diSelection . _Just . _1) >> mesel ^? _Just)
(guard (ssel ^? _1 == w ^? hud . diSelection . _Just . _1) >> mesel ^? _Just)
)
OverInvDragSelect (Just ssel) (Just esel) ->
w & input . mouseContext .~ MouseInGame
& invSetSelection (f (fst ssel, esel) (h ssel esel))
OverInvDragSelect{} ->
w & input . mouseContext .~ MouseInGame
& hud . hudElement . diSelection . _Just . _3 %~ const mempty
& hud . diSelection . _Just . _3 %~ const mempty
_ -> w
where
getuniques x y = IS.union x y IS.\\ IS.intersection x y
f (x, y) z = (x, y, z)
h (k, i) j = fold $ do
sss <- w ^? hud . hudElement . diSections . ix k . ssItems
sss <- w ^? hud . diSections . ix k . ssItems
let (_, xss) = IM.split (min i j -1) sss
(yss, _) = IM.split (max i j + 1) xss
return . IM.keysSet $ yss
@@ -203,7 +203,7 @@ isGroupSelectableSection = \case
updateMouseClickInGame :: Configuration -> World -> World
updateMouseClickInGame cfig w = case w ^. input . mouseContext of
MouseInGame -> fromMaybe (w & input . mouseContext .~ OverInvDragSelect Nothing Nothing) $ do
let sss = w ^. hud . hudElement . diSections
let sss = w ^. hud . diSections
ysel <-
inverseSelSecYint
(posSelSecYint cfig invDP (w ^. input . mousePos . _y))
@@ -213,12 +213,12 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
return $ w & input . mouseContext .~ OverInvDragSelect (Just ysel) Nothing
OverInvSelect (-1, _)
| selsec == Just (-1) ->
w & hud . hudElement . diSelection %~ endRegex (-1) w
& hud . hudElement . diInvFilter .~ Nothing
w & hud . diSelection %~ endRegex (-1) w
& hud . diInvFilter .~ Nothing
OverInvSelect (2, _)
| selsec == Just 2 ->
w & hud . hudElement . diSelection %~ endRegex 2 w
& hud . hudElement . diCloseFilter .~ Nothing
w & hud . diSelection %~ endRegex 2 w
& hud . diCloseFilter .~ Nothing
OverInvSelect x
| ScancodeLShift `M.member` (w ^. input . pressedKeys)
&& isGroupSelectableSection (fst x) ->
@@ -226,14 +226,14 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
OverInvSelect x -> startDrag x w
OverTerminal tmid TerminalTextInput{} -> terminalReturnEffect tmid w
OverTerminal tmid TerminalPressTo{} -> continueTerminal tmid w
OutsideTerminal -> w & hud . hudElement . subInventory .~ NoSubInventory
OutsideTerminal -> w & hud . subInventory .~ NoSubInventory
OverCombSelect x ->
w & hud . hudElement . subInventory . ciSelection ?~ f x
w & hud . subInventory . ciSelection ?~ f x
& worldEventFlags . at CombineInventoryChange ?~ ()
OverCombFilter ->
w & hud . hudElement . subInventory . ciFilter .~ Nothing
w & hud . subInventory . ciFilter .~ Nothing
& worldEventFlags . at CombineInventoryChange ?~ ()
& hud . hudElement . subInventory . ciSelection %~ endCombineRegex w
& hud . subInventory . ciSelection %~ endCombineRegex w
OverCombCombine x ->
w
& tryCombine x
@@ -243,7 +243,7 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
OverCombEscape ->
w
& worldEventFlags . at InventoryChange ?~ ()
& hud . hudElement . subInventory .~ NoSubInventory
& hud . subInventory .~ NoSubInventory
OverCombFiltInv (0, j) -> fromMaybe w $ do
str <-
fmap (take 5) $
@@ -252,33 +252,33 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
w ^? cWorld . lWorld . items . ix k
>>= (listToMaybe . basicItemDisplay)
return . (worldEventFlags . at CombineInventoryChange ?~ ()) $
case w ^? hud . hudElement . subInventory . ciFilter . _Just of
case w ^? hud . subInventory . ciFilter . _Just of
Just ('#' : xs)
| str == xs ->
w & hud . hudElement . subInventory . ciFilter .~ Nothing
_ -> w & hud . hudElement . subInventory . ciFilter ?~ ("#" ++ str)
w & hud . subInventory . ciFilter .~ Nothing
_ -> w & hud . subInventory . ciFilter ?~ ("#" ++ str)
_ -> w
where
f (x, y) = (x, y, mempty)
selsec = w ^? hud . hudElement . diSelection . _Just . _1
selsec = w ^? hud . diSelection . _Just . _1
endRegex :: Int -> World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endRegex i w = ssSetCursor (ssLookupDown i j) sss
where
sss = w ^. hud . hudElement . diSections
sss = w ^. hud . diSections
j = maybe 0 fst $ IM.lookupMin =<< sss ^? ix i . ssItems
endCombineRegex :: World -> Maybe (Int, Int, IS.IntSet) -> Maybe (Int, Int, IS.IntSet)
endCombineRegex w = ssSetCursor (ssLookupDown 0 j) sss
where
sss = w ^. hud . hudElement . subInventory . ciSections
sss = w ^. hud . subInventory . ciSections
j = fromMaybe 0 $ do
itms <- sss ^? ix 0 . ssItems
(k, _) <- IM.lookupMin itms
return (k -1)
startDrag :: (Int, Int) -> World -> World
startDrag (a, b) w = setcontext $ case w ^? hud . hudElement . diSelection . _Just of
startDrag (a, b) w = setcontext $ case w ^? hud . diSelection . _Just of
Just (i, _, xs) | i == a && b `IS.member` xs -> w
_ -> invSetSelection (a, b, IS.singleton b) w
where
@@ -316,10 +316,10 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
let yint = posSelSecYint cfig invDP (w ^. input . mousePos . _y)
bn =
(\v -> inverseSelSecYint (yint + 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections
=<< w ^? hud . diSections
ab =
(\v -> inverseSelSecYint (yint - 1) v ^? nonInf)
=<< w ^? hud . hudElement . diSections
=<< w ^? hud . diSections
guard $ xk == k || xk + 1 == k || xk -1 == k
(maxi, _) <- IS.maxView xs
(mini, _) <- IS.minView xs
@@ -336,10 +336,10 @@ shiftInvItems cfig n k x xs ss w = setSelWhileDragging . fromMaybe w $ do
setSelWhileDragging :: World -> World
setSelWhileDragging w = fromMaybe w $ do
(i, _, xs) <- w ^? hud . hudElement . diSelection . _Just
(i, _, xs) <- w ^? hud . diSelection . _Just
(k, j) <- w ^? input . mouseContext . mcoMaybeSelect . _Just
guard $ i == k && j `IS.member` xs
return $ w & hud . hudElement . diSelection . _Just . _2 .~ j
return $ w & hud . diSelection . _Just . _2 .~ j
shiftInvItemsUp :: Int -> IS.IntSet -> World -> World
shiftInvItemsUp j is w = IS.foldl' f w is
@@ -350,7 +350,7 @@ shiftInvItemsUp j is w = IS.foldl' f w is
shiftInvItemsDown :: Int -> IS.IntSet -> World -> World
shiftInvItemsDown j is w = fromMaybe w $ do
let i = IS.findMax is
guard . isJust $ w ^? hud . hudElement . diSections . ix j . ssItems . ix i
guard . isJust $ w ^? hud . diSections . ix j . ssItems . ix i
return $ IS.foldr f w is
where
f i' w' = swapItemWith g (j, i') w'
@@ -386,8 +386,8 @@ updateKeysInTerminal tmid u = fromMaybe u $ do
return $ case tm ^. tmStatus of
_
| dist x y > 40 || not (hasButtonLOS x y (u ^. uvWorld)) ->
u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
u & uvWorld . hud . subInventory .~ NoSubInventory
TerminalDeactivated -> u & uvWorld . hud . subInventory .~ NoSubInventory
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
TerminalPressTo{} -> updateKeyContinueTerminal tmid u
_ -> u
@@ -477,14 +477,14 @@ updateBackspaceRegex :: World -> World
updateBackspaceRegex w = case di ^? subInventory of
Just NoSubInventory{}
| secfocus (-1) 0 ->
w & hud . hudElement %~ trybackspace (-1) diInvFilter diInvFilter diSelection
w & hud %~ trybackspace (-1) diInvFilter diInvFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just NoSubInventory{}
| secfocus 2 3 ->
w & hud . hudElement %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
w & hud %~ trybackspace 2 diCloseFilter diCloseFilter diSelection
& worldEventFlags . at InventoryChange ?~ ()
Just CombineInventory{} ->
w & hud . hudElement . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
w & hud . subInventory %~ trybackspace (-1) ciFilter ciFilter ciSelection
& worldEventFlags . at InventoryChange ?~ ()
_ -> w
where
@@ -498,25 +498,25 @@ updateBackspaceRegex w = case di ^? subInventory of
he & filtset . _Just %~ init
& selset ?~ (x, 0, mempty)
[] -> he & filtset .~ Nothing
di = w ^. hud . hudElement
di = w ^. hud
updateEnterRegex :: World -> World
updateEnterRegex w = case w ^? hud . hudElement . subInventory of
updateEnterRegex w = case w ^? hud . subInventory of
Just NoSubInventory{}
| secfocus [-1, 0, 1] ->
w & hud . hudElement . diSelection ?~ (-1, 0, mempty)
& hud . hudElement . diInvFilter %~ enterregex
w & hud . diSelection ?~ (-1, 0, mempty)
& hud . diInvFilter %~ enterregex
Just NoSubInventory{}
| secfocus [2, 3] ->
w & hud . hudElement . diSelection ?~ (2, 0, mempty)
& hud . hudElement . diCloseFilter %~ enterregex
w & hud . diSelection ?~ (2, 0, mempty)
& hud . diCloseFilter %~ enterregex
Just CombineInventory{} ->
w & hud . hudElement . subInventory . ciFilter %~ enterregex
& hud . hudElement . subInventory . ciSelection ?~ (-1, 0, mempty)
w & hud . subInventory . ciFilter %~ enterregex
& hud . subInventory . ciSelection ?~ (-1, 0, mempty)
_ -> w
where
secfocus xs = fromMaybe False $ do
i <- w ^? hud . hudElement . diSelection . _Just . _1
i <- w ^? hud . diSelection . _Just . _1
return $ i `elem` xs
enterregex = (<|> Just "")
@@ -524,15 +524,15 @@ pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u] & pauseSound
spaceAction :: World -> World
spaceAction w = case w ^. hud . hudElement . subInventory of
spaceAction w = case w ^. hud . subInventory of
NoSubInventory -> maybe id interactWithCloseObj (getCloseObj w) w
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . subInventory .~ NoSubInventory
getCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
where
topcitem = do
k <- (w ^? hud . hudElement . diSections . ix 3 . ssItems)
k <- (w ^? hud . diSections . ix 3 . ssItems)
>>= (fmap fst . IM.lookupMin)
Left <$> w ^? hud . closeItems . ix k
topcbut = do
@@ -541,15 +541,15 @@ getCloseObj w = getSelectedCloseObj w <|> topcitem <|> topcbut
tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do
CombinableItem is it <- w ^? hud . hudElement . subInventory
CombinableItem is it <- w ^? hud . subInventory
. ciSections . ix i . ssItems . ix j . siPayload . _Just
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $
(createItemYou it (foldr (destroyInvItem 0 . NInt) w (sort is)))
& soundStart InventorySound p wrench1S Nothing
& hud . hudElement . diSelection . _Just . _3 .~ mempty
& hud . diSelection . _Just . _3 .~ mempty
maybeExitCombine :: World -> World
maybeExitCombine w
| ButtonRight `M.member` (w ^. input . mouseButtons) = w
| otherwise = w & hud . hudElement . subInventory .~ NoSubInventory
| otherwise = w & hud . subInventory .~ NoSubInventory
src/Dodge/Update/Scroll.hs
+2 -2
View File
@@ -23,7 +23,7 @@ import SDL
-- yi should be nonzero
updateWheelEvent :: Int -> World -> World
updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
updateWheelEvent yi w = case w ^. hud . subInventory of
NoSubInventory -> updateBaseWheelEvent yi w
ExamineInventory -> updateBaseWheelEvent yi w
MapperInventory{} -> updateBaseWheelEvent yi w
@@ -118,7 +118,7 @@ zoomOutLongGun sc = fromMaybe sc $ do
moveCombineSel :: Int -> World -> World
moveCombineSel yi =
( hud . hudElement . subInventory %~ doscroll
( hud . subInventory %~ doscroll
)
. (worldEventFlags . at CombineInventoryChange ?~ ())
where
src/Dodge/WorldEffect.hs
+3 -3
View File
@@ -55,7 +55,7 @@ accessTerminal tid w = fromMaybe w $ do
tm <- w ^? cWorld . lWorld . terminals . ix tid
guard (tm ^. tmStatus /= TerminalDeactivated)
return $
w & hud . hudElement . subInventory .~ DisplayTerminal tid
w & hud . subInventory .~ DisplayTerminal tid
& cWorld . lWorld . terminals . ix tid %~ tryToBoot
where
tryToBoot tm = case _tmStatus tm of
@@ -106,6 +106,6 @@ resetTerminal x tm =
. exitTerminalSubInv
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
exitTerminalSubInv w = case w ^? hud . subInventory . termID of
Just _ -> w & hud . subInventory .~ NoSubInventory
_ -> w