Make hud non-saveable

This commit is contained in:
2022-12-29 01:10:09 +00:00
parent be41d51819
commit 7fc3b788b4
17 changed files with 57 additions and 59 deletions
+3 -3
View File
@@ -86,12 +86,12 @@ fullModuleName :: ItemModuleType -> String
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
toggleCombineInv :: World -> World
toggleCombineInv w = case w ^. cWorld . lWorld . hud . hudElement of
DisplayInventory CombineInventory{} -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory
toggleCombineInv w = case w ^. hud . hudElement of
DisplayInventory CombineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & enterCombineInv
enterCombineInv :: World -> World
enterCombineInv w = w & cWorld . lWorld . hud . hudElement . subInventory .~ CombineInventory mi
enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory mi
where
mi = 0 <$ listToMaybe (combineItemListYou w)
+4 -6
View File
@@ -6,9 +6,9 @@
module Dodge.Data.HUD where
--import Dodge.Data.SelectionList
import Dodge.Data.Button
import Dodge.Data.FloorItem
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
data HUDElement
@@ -31,12 +31,10 @@ data HUD = HUD
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
, _closeObjects :: [Either FloorItem Button]
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
deriveJSON defaultOptions ''SubInventory
deriveJSON defaultOptions ''HUDElement
deriveJSON defaultOptions ''HUD
-2
View File
@@ -148,10 +148,8 @@ data LWorld = LWorld
, _pathGraph :: Gr Point2 PathEdge
, _pnZoning :: IM.IntMap (IM.IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IM.IntMap (IM.IntMap (Set PathEdgeNodes))
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (WdP2, String)
, _selLocation :: Int
, _distortions :: [Distortion]
+1
View File
@@ -32,6 +32,7 @@ data World = World
, _input :: Input
, _testFloat :: Float
, _rbOptions :: RightButtonOptions
, _hud :: HUD
}
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
+2 -2
View File
@@ -39,6 +39,7 @@ defaultWorld =
, _randGen = mkStdGen 2
, _testFloat = 0
, _rbOptions = NoRightButtonOptions
, _hud = defaultHUD
}
defaultCWGen :: CWGen
@@ -128,10 +129,8 @@ defaultLWorld =
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _pnZoning = mempty
, _peZoning = mempty
, _hud = defaultHUD
, _lightSources = IM.empty
, _tempLightSources = []
, _closeObjects = []
, _seenLocations =
IM.fromList
[ (0, (WdYouPos, "CURRENT POSITION"))
@@ -150,6 +149,7 @@ defaultHUD =
, _carteCenter = V2 0 0
, _carteZoom = 0.5
, _carteRot = 0
, _closeObjects = []
}
defaultWorldHammers :: M.Map WorldHammer HammerPosition
+1 -1
View File
@@ -6,7 +6,7 @@ import LensHelp
inTermFocus :: World -> Bool
inTermFocus w = fromMaybe False $ do
tmid <- w ^? cWorld . lWorld . hud . hudElement . subInventory . termID
tmid <- w ^? hud . hudElement . subInventory . termID
hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
return $ hasfocus && connectionstatus == TerminalReady
+15 -14
View File
@@ -30,7 +30,8 @@ import Dodge.Inventory.Color
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Data.Universe
import Dodge.Data.World
import Dodge.Data.Config
import Dodge.Euse
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.CloseObject
@@ -107,7 +108,7 @@ trimapAugmentInv f x g w =
IM.insert n x $
IM.union
(f <$> yourInv w)
(IM.fromAscList $ zip [n + 1 ..] $ map g $ w ^. cWorld . lWorld . closeObjects)
(IM.fromAscList $ zip [n + 1 ..] $ map g $ w ^. hud . closeObjects)
where
n = length $ yourInv w
@@ -152,8 +153,8 @@ updateTerminal :: World -> World
updateTerminal = checkTermDist
checkTermDist :: World -> World
checkTermDist w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory) $ do
checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & hud . hudElement . subInventory .~ NoSubInventory) $ do
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
@@ -163,7 +164,7 @@ checkTermDist w = case w ^? cWorld . lWorld . hud . hudElement . subInventory .
updateCloseObjects :: World -> World
updateCloseObjects w =
w
& cWorld . lWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& hud . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ updateinvsel
where
updateinvsel curinvsel
@@ -178,7 +179,7 @@ updateCloseObjects w =
. IM.elems
$ w ^. cWorld . lWorld . buttons
currentClose = filt $ map Left (IM.elems $ w ^. cWorld . lWorld . floorItems) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ w ^. cWorld . lWorld . closeObjects
oldClose = filt $ mapMaybe updatebyid $ w ^. hud . closeObjects
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
@@ -304,8 +305,8 @@ equipSiteToPositions es = case es of
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
| x > 0 = over (cWorld . lWorld . closeObjects) rotU
| x < 0 = over (cWorld . lWorld . closeObjects) rotD
| x > 0 = over (hud . closeObjects) rotU
| x < 0 = over (hud . closeObjects) rotD
| otherwise = id
changeInvSel :: Int -> World -> World
@@ -323,7 +324,7 @@ changeInvSel i w
-- arguably this should jump the invpos into the inventory proper
pointcrInvSel = cWorld . lWorld . creatures . ix 0 . crInvSel
n = length $ w ^?! cWorld . lWorld . creatures . ix 0 . crInv
numCO = length $ w ^. cWorld . lWorld . closeObjects
numCO = length $ w ^. hud . closeObjects
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w
@@ -333,7 +334,7 @@ changeSwapInvSel k w
| yourInvSel w > n =
w
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos .~ ico'
& cWorld . lWorld . closeObjects %~ swapIndices (i - (n+1)) (ico' - (n+1))
& hud . closeObjects %~ swapIndices (i - (n+1)) (ico' - (n+1))
| otherwise = w
where
updatecreature =
@@ -355,7 +356,7 @@ changeSwapInvSel k w
i = crSel cr
ico' = ((i - (k + n + 1)) `mod` numCO) + n + 1
n = length $ _crInv cr
numCO = length $ w ^. cWorld . lWorld . closeObjects
numCO = length $ w ^. hud . closeObjects
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
@@ -365,10 +366,10 @@ changeAugInvSel i w
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . lWorld . creatures . ix 0 . crInvSel . iselAction .~ NoInvSelAction
where
n = length (yourInv w) + length (w ^. cWorld . lWorld . closeObjects) + 1
n = length (yourInv w) + length (w ^. hud . closeObjects) + 1
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ w ^. cWorld . lWorld . closeObjects
bestCloseObjectIndex w = findIndex f $ w ^. hud . closeObjects
where
f (Right _) = True
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
@@ -384,4 +385,4 @@ selectedCloseObject w
inv = _crInv cr
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n + 1,) <$> (_closeObjects (_lWorld (_cWorld w)) !? n)
selectNthCloseObject w n = (length (yourInv w) + n + 1,) <$> (_closeObjects (_hud w) !? n)
+2 -2
View File
@@ -20,7 +20,7 @@ makeInventorySelectionList w = defaultSelectionList
inventorySelectionList :: World -> [SelectionItem ()]
inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
++ [SelectionItem displayFreeSlots 1 True (length thetext) invDimColor 2 ()]
++ map (closeObjectToSelectionItem nfreeslots) (w ^. cWorld . lWorld . closeObjects)
++ map (closeObjectToSelectionItem nfreeslots) (w ^. hud . closeObjects)
where
cr = you w
inv = _crInv cr
@@ -32,7 +32,7 @@ inventorySelectionList w = map (invSelectionItem cr) (IM.toList inv)
displayFreeSlots = [color invDimColor $ text thetext]
inventoryCursorPos :: World -> Maybe Int
inventoryCursorPos w = case w ^? cWorld . lWorld . hud . hudElement . subInventory of
inventoryCursorPos w = case w ^? hud . hudElement . subInventory of
Just CombineInventory{} -> Nothing
_ -> Just $ yourInvSel w
+4 -4
View File
@@ -32,7 +32,7 @@ import Picture
import SDL (MouseButton (..))
drawHUD :: Configuration -> World -> Picture
drawHUD cfig w = case w ^. cWorld . lWorld . hud . hudElement of
drawHUD cfig w = case w ^. hud . hudElement of
DisplayCarte -> drawCarte cfig w
DisplayInventory subinv ->
drawInGameHUD sl cfig w
@@ -76,7 +76,7 @@ invDisplayParams w =
selcursortype
| isexaminesub || ButtonRight `M.member` _mouseButtons (_input w) = [North, South, East, West]
| otherwise = [North, South, West]
isexaminesub = case w ^? cWorld . lWorld . hud . hudElement . subInventory of
isexaminesub = case w ^? hud . hudElement . subInventory of
Just ExamineInventory{} -> True
_ -> False
@@ -342,7 +342,7 @@ drawCarte cfig w =
where
iPos = w ^. cWorld . lWorld . selLocation
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locPoss = map (cartePosToScreen cfig (w ^. cWorld . lWorld . hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locTexts = map fst locs
displayListEndCoords :: Configuration -> [String] -> [Point2]
@@ -356,7 +356,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w =
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
(mapMaybe (mapWall cfig (w ^. cWorld . lWorld . hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
mapWall cfig thehud wl
+2 -2
View File
@@ -218,8 +218,8 @@ disconnectTerminal tm w =
.~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of
Just _ -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w
damageCodeCommand :: TerminalCommand
+1 -1
View File
@@ -25,7 +25,7 @@ terminalReturnEffect tm w = guardDisconnected tm w $
defocusTerminalInput :: World -> World
defocusTerminalInput w = fromMaybe w $ do
tmid <- w ^? cWorld . lWorld . hud . hudElement . subInventory . termID
tmid <- w ^? hud . hudElement . subInventory . termID
return $ w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const False
runTerminalString :: String -> Terminal -> World -> World
+1 -1
View File
@@ -138,7 +138,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
Just (InputScreen thetext _) -> doInputScreenInput thetext u
Just screen@OptionScreen{_scPositionedMenuOption = mop, _scOptionFlag = flag, _scSelectionList = sellist, _scListDisplayParams = ldps} ->
optionScreenUpdate screen mop flag ldps sellist u
_ -> case u ^? uvWorld . cWorld . lWorld . hud . hudElement . subInventory of
_ -> case u ^? uvWorld . hud . hudElement . subInventory of
Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
_ -> M.foldlWithKey' updateKeyInGame u pkeys
where
+1 -1
View File
@@ -198,7 +198,7 @@ rotateCamera cfig w
-- TODO check where/how this is used
notAtTerminal :: World -> Bool
notAtTerminal w = isNothing $ w ^? cWorld . lWorld . hud . hudElement . subInventory . termID
notAtTerminal w = isNothing $ w ^? hud . hudElement . subInventory . termID
--zoomCamBy :: Float -> World -> World
--zoomCamBy x w = w {_cameraZoom = max (_cameraZoom w + x) 0.01}
+9 -9
View File
@@ -88,27 +88,27 @@ pauseGame :: Universe -> Universe
pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
spaceAction :: World -> World
spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of
DisplayCarte -> w & cWorld . lWorld . hud . carteCenter .~ theLoc
spaceAction w = case w ^?! hud . hudElement of
DisplayCarte -> w & hud . carteCenter .~ theLoc
DisplayInventory NoSubInventory -> case selectedCloseObject w of
Just (_, Left flit) -> pickUpItem 0 flit w
Just (_, Right but) -> doButtonEvent (_btEvent but) but w
_ -> w
DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory
_ -> w & cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory
DisplayInventory DisplayTerminal{} -> w & hud . hudElement . subInventory .~ NoSubInventory
_ -> w & hud . hudElement . subInventory .~ NoSubInventory
where
--theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
toggleMap :: World -> World
toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of
DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & cWorld . lWorld . hud . hudElement .~ DisplayCarte
toggleMap w = case w ^?! hud . hudElement of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayCarte
toggleTweakInv :: World -> World
toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
toggleTweakInv w = case w ^. hud . hudElement of
DisplayInventory ExamineInventory{} -> w & thepointer .~ NoSubInventory
_ -> w & thepointer .~ ExamineInventory mi
where
thepointer = cWorld . lWorld . hud . hudElement . subInventory
thepointer = hud . hudElement . subInventory
mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
+3 -3
View File
@@ -19,9 +19,9 @@ import LensHelp
import SDL
updateWheelEvent :: Int -> World -> World
updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
updateWheelEvent yi w = case w ^. hud . hudElement of
DisplayCarte
| rbDown -> w & cWorld . lWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
| rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
| otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi)
DisplayInventory NoSubInventory
-- functions that modify the inventory should be centralised so that
@@ -54,7 +54,7 @@ moveCombineSel yi w = moveSubSel yi (length $ combineItemListYou w) w
moveSubSel :: Int -> Int -> World -> World
moveSubSel yi maxyi =
cWorld . lWorld . hud . hudElement . subInventory . subInvSel . _Just
hud . hudElement . subInventory . subInvSel . _Just
%~ ((`mod` maxyi) . subtract yi)
guardDisconnectedID :: Int -> World -> World -> World
+7 -7
View File
@@ -18,7 +18,7 @@ import ListHelp
import SDL
updateUsingInput :: World -> World
updateUsingInput w = case w ^. cWorld . lWorld . hud . hudElement of
updateUsingInput w = case w ^. hud . hudElement of
DisplayInventory subinv ->
pressedMBEffects subinv (_mouseButtons (_input w)) w
DisplayCarte ->
@@ -47,7 +47,7 @@ pressedMBEffects subinv pkeys w = case subinv of
where
maybeexitcombine
| ButtonRight `M.member` _mouseButtons (_input w) = id
| otherwise = cWorld . lWorld . hud . hudElement . subInventory .~ NoSubInventory
| otherwise = hud . hudElement . subInventory .~ NoSubInventory
pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World
pressedMBEffectsNoInventory pkeys w
@@ -65,7 +65,7 @@ pressedMBEffectsNoInventory pkeys w
| isDown ButtonLeft = w & input . hammers . ix DoubleMouseHam .~ HammerDown
| otherwise = w
where
inTopInv = case w ^. cWorld . lWorld . hud . hudElement of
inTopInv = case w ^. hud . hudElement of
DisplayInventory NoSubInventory -> True
_ -> False
justPressedDown but = (pkeys ^. at but) == Just False
@@ -91,15 +91,15 @@ updatePressedButtonsCarte pkeys w
| isDown ButtonRight =
w
& input . clickMousePos .~ _mousePos (_input w)
& cWorld . lWorld . hud . carteCenter %~ (-.- trans)
& hud . carteCenter %~ (-.- trans)
| isDown ButtonLeft =
w
& input . clickMousePos .~ _mousePos (_input w)
& cWorld . lWorld . hud . carteRot -~ rot
& cWorld . lWorld . hud . carteZoom *~ czoom
& hud . carteRot -~ rot
& hud . carteZoom *~ czoom
| otherwise = w
where
isDown but = but `M.member` pkeys
rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w))
trans = rotateV (w ^. cWorld . lWorld . hud . carteRot) $ 1 / (w ^. cWorld . lWorld . hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))
trans = rotateV (w ^. hud . carteRot) $ 1 / (w ^. hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))
+1 -1
View File
@@ -44,7 +44,7 @@ accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = case mtmid of
Nothing -> w
Just tmid ->
w & cWorld . lWorld . hud . hudElement . subInventory .~ DisplayTerminal tmid
w & hud . hudElement . subInventory .~ DisplayTerminal tmid
& cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus .~ True
& cWorld . lWorld . terminals . ix tmid %~ tryToBoot
where