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

Cancel terminal display if destroyed while displaying

Browse Source
This commit is contained in:
justin
2025-08-19 18:01:23 +01:00
parent b07280e50c
commit 5ccbfa1f91
10 changed files with 135 additions and 149 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+2 -2
View File
@@ -21,14 +21,14 @@ combineList :: World -> [SelectionItem CombinableItem]
combineList = map f . combineItemListYouX
where
f (is, itm) =
SelectionItem
SelItem
{ _siPictures = basicItemDisplay itm
, _siHeight = itInvHeight itm
, _siWidth = 15
, _siIsSelectable = True
, _siColor = itemInvColor $ baseCI itm
, _siOffX = 0
, _siPayload = CombinableItem is itm
, _siPayload = Just $ CombinableItem is itm
}
combineItemListYouX :: World -> [([Int], Item)]
src/Dodge/Data/SelectionList.hs
+2 -10
View File
@@ -41,22 +41,14 @@ data SelectionWidth
| UseItemWidth
data SelectionItem a
= SelectionItem
{ _siPictures :: [String]
, _siHeight :: Int
, _siWidth :: Int
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siPayload :: a
}
| SelectionInfo
= SelItem
{ _siPictures :: [String]
, _siHeight :: Int
, _siWidth :: Int
, _siIsSelectable :: Bool
, _siColor :: Color
, _siOffX :: Int
, _siPayload :: Maybe a
}
makeLenses ''ListDisplayParams
src/Dodge/DisplayInventory.hs
+6 -5
View File
@@ -65,12 +65,12 @@ updateCombineSections w cfig =
sclose'
| null sclose =
IM.singleton 0 $
SelectionInfo ["No possible combinations"] 1 25 False white 0
SelItem ["No possible combinations"] 1 25 False white 0 Nothing
| otherwise = sclose
regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
regexCombs inv ci = \case
'#' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
'#' : str -> any (g str) (_ciInvIDs $ fromJust $ _siPayload ci)
str -> (regexList str . _siPictures) ci
where
g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i)
@@ -129,7 +129,7 @@ updateDisplaySections w cfig =
[ invhead
, sinv
, IM.singleton 0
$ SelectionItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 ()
$ SelItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 Nothing
, nearbyhead
, sclose
, interfaceshead
@@ -153,7 +153,7 @@ updateDisplaySections w cfig =
btitems =
IM.fromDistinctAscList . zip [0 ..] $
mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing
invhead = if null sfinv then makehead "INVENTORY" else sfinv
cr = you w
closeitms =
@@ -179,13 +179,14 @@ filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
return $
IM.singleton
0
$ SelectionInfo
$ SelItem
[filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
2
(length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
True
white
0
Nothing
itms' = maybe id (IM.filter . filtfn) mfilt itms
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
src/Dodge/Inventory/SelectionList.hs
+6 -6
View File
@@ -31,14 +31,14 @@ import Picture.Base
invSelectionItem :: World -> Int -> LocationDT OItem -> SelectionItem ()
invSelectionItem w indent loc =
SelectionItem
SelItem
{ _siPictures = itemDisplay w cr ci
, _siHeight = itInvHeight $ ci ^. _1
, _siWidth = 15
, _siIsSelectable = True
, _siColor = itemInvColor ci
, _siOffX = indent
, _siPayload = ()
, _siPayload = Nothing
}
where
ci = (a,b)
@@ -207,28 +207,28 @@ closeItemToSelectionItem w (NInt i) = do
e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
let (pics, col) = closeItemToTextPictures e
return
SelectionItem
SelItem
{ _siPictures = pics
, _siHeight = length pics
, _siWidth = 15
, _siIsSelectable = True
, _siColor = col
, _siOffX = 0
, _siPayload = ()
, _siPayload = Nothing
}
closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
closeButtonToSelectionItem w i = do
bt <- w ^? cWorld . lWorld . buttons . ix i
return
SelectionItem
SelItem
{ _siPictures = [btText bt]
, _siHeight = 1
, _siWidth = 15
, _siIsSelectable = True
, _siColor = yellow
, _siOffX = 0
, _siPayload = ()
, _siPayload = Nothing
}
btText :: Button -> String
src/Dodge/Menu/Option.hs
+2 -2
View File
@@ -96,14 +96,14 @@ menuOptionToSelectionItem ::
MenuOption ->
SelectionItem (Universe -> Universe, Universe -> Universe)
menuOptionToSelectionItem w padAmount mo =
SelectionItem
SelItem
{ _siPictures = [optionText]
, _siHeight = 1
, _siWidth = 50
, _siIsSelectable = isselectable
, _siColor = thecol
, _siOffX = 0
, _siPayload = (f, g)
, _siPayload = Just (f, g)
}
where
isselectable = case _moString mo w of
src/Dodge/Render/HUD.hs
+12 -17
View File
@@ -1,10 +1,7 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Render.HUD (
drawHUD,
) where
module Dodge.Render.HUD (drawHUD) where
import Dodge.Data.Terminal.Status
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -23,6 +20,7 @@ import Dodge.Data.Config
import Dodge.Data.DoubleTree
import Dodge.Data.EquipType
import Dodge.Data.SelectionList
import Dodge.Data.Terminal.Status
import Dodge.Data.World
import Dodge.DoubleTree
import Dodge.Equipment.Text
@@ -34,7 +32,6 @@ import Dodge.Item.InvSize
import Dodge.Item.Location
import Dodge.ListDisplayParams
import Dodge.Render.Connectors
--import Dodge.Render.HUD.Carte
import Dodge.Render.List
import Dodge.ScreenPos
import Dodge.SelectionSections
@@ -105,9 +102,7 @@ getRootItemBounds i inv = do
drawMouseOver :: Configuration -> World -> Picture
drawMouseOver cfig w =
concat
( invsel <|> combinvsel
<|> drawDragSelecting cfig w
)
(invsel <|> combinvsel <|> drawDragSelecting cfig w)
<> concat (drawDragSelected cfig w)
where
invsel = do
@@ -211,14 +206,14 @@ drawExamineInventory cfig w =
)
where
f str =
SelectionItem
SelItem
{ _siPictures = [str]
, _siWidth = 55
, _siHeight = 1
, _siIsSelectable = True
, _siColor = white
, _siOffX = 0
, _siPayload = ()
, _siPayload = Nothing
}
closeObjectInfo :: Int -> Either FloorItem Button -> String
@@ -240,11 +235,10 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
j <- w ^? hud . closeItems . ix i . unNInt
flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix j
return . g $ Left flit
-- g . Left $ w ^?! hud . closeItems . ix i
Just (SelCloseButton i) -> fromMaybe x $ do
j <- w ^? hud . closeButtons . ix i
flit <- w ^? cWorld . lWorld . buttons . ix j
return . g $ Right flit
but <- w ^? cWorld . lWorld . buttons . ix j
return . g $ Right but
_ -> x
drawRBOptions :: Configuration -> World -> Picture
@@ -347,7 +341,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
(i, j) <- msel
si <- sss ^? ix i . ssItems . ix j
let col = _siColor si
lnks <- si ^? siPayload . ciInvIDs
lnks <- si ^? siPayload . _Just . ciInvIDs
return (lnkMidPosInvSelsCol cfig w j col lnks) <> foldMap invcursor lnks
where
invcursor i = do
@@ -372,7 +366,7 @@ drawTerminalDisplay tid cfig w = fold $ do
(drawSelectionListBackground secondColumnParams cfig tsize)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where
toselitm (str, col) = SelectionItem [str] 1 55 True col 0 ()
toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing
-- not sure if the width (55) is correct here
f tm =
map toselitm . displayTermInput tm
@@ -386,7 +380,8 @@ drawTerminalDisplay tid cfig w = fold $ do
TerminalTextInput s ->
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
TerminalPressTo s ->
(++ [(getPromptTM ++ "PRESS TO "++s, white)])
(++ [(getPromptTM ++ "PRESS TO " ++ s, white)])
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
@@ -504,4 +499,4 @@ selNumPosCardinal card cfig ldp sss i j = do
ygap = _ldpVerticalGap ldp
selSecSelCol :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Color
selSecSelCol i j sss = sss ^? ix i . ssItems . ix j . siColor
selSecSelCol i j = (^? ix i . ssItems . ix j . siColor)
src/Dodge/Update/Input/InGame.hs
+2 -1
View File
@@ -385,6 +385,7 @@ updateKeysInTerminal :: Int -> Universe -> Universe
updateKeysInTerminal tmid u = fromMaybe u $ do
tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid
return $ case tm ^. tmStatus of
TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
TerminalPressTo{} -> updateKeyContinueTerminal tmid u
_ -> u
@@ -551,7 +552,7 @@ getCloseObj w = getSelectedCloseObj w <|> firstcitem <|> firstcbut
tryCombine :: (Int, Int) -> World -> World
tryCombine (i, j) w = fromMaybe w $ do
sss <- w ^? hud . hudElement . subInventory . ciSections
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $
snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
src/Dodge/Update/Input/ScreenLayer.hs
+2 -2
View File
@@ -63,11 +63,11 @@ mouseClickOptionsList u = fromMaybe u $ do
case u ^. uvWorld . input . mouseButtons of
mbs | mbs ^. at ButtonLeft == Just 0 -> do
i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
f <- sl ^? ix i . siPayload . _1
f <- sl ^? ix i . siPayload . _Just . _1
return $ f u & uvSoundQueue .:~ click1S
mbs | mbs ^. at ButtonRight == Just 0 -> do
i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
f <- sl ^? ix i . siPayload . _2
f <- sl ^? ix i . siPayload . _Just . _2
return $ f u & uvSoundQueue .:~ click1S
_ -> Nothing
src/Dodge/WorldEffect.hs
+9 -4
View File
@@ -7,6 +7,7 @@ module Dodge.WorldEffect (
lineOutputTerminal,
) where
import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -53,9 +54,12 @@ doWdWd we = case we of
return $ heldEffectMuzzles loc cr w
accessTerminal :: Int -> World -> World
accessTerminal tid =
(hud . hudElement . subInventory .~ DisplayTerminal tid)
. (cWorld . lWorld . terminals . ix tid %~ tryToBoot)
accessTerminal tid w = fromMaybe w $ do
tm <- w ^? cWorld . lWorld . terminals . ix tid
guard (tm ^. tmStatus /= TerminalDeactivated)
return $
w & hud . hudElement . subInventory .~ DisplayTerminal tid
& cWorld . lWorld . terminals . ix tid %~ tryToBoot
where
tryToBoot tm = case _tmStatus tm of
TerminalTextInput{} -> tm
@@ -84,7 +88,8 @@ lineOutputTerminal tls =
}
doDeathTriggers :: Terminal -> World -> World
doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
doDeathTriggers tm = (cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs)
. (cWorld . lWorld . terminals . ix (tm ^. tmID) . tmStatus .~ TerminalDeactivated)
where
xs = M.elems $ _tmToggles tm