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

Make hud non-saveable

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