diff --git a/data/texture/charMap.png b/data/texture/charMap.png index e646154b7..fabef9ac6 100644 Binary files a/data/texture/charMap.png and b/data/texture/charMap.png differ diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 6ece4c7fc..270b383c5 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -26,6 +26,7 @@ useItem cr' w = fromMaybe (f w) $ do itRef <- cr ^? crManipulation . manObject . inInventory . ispItem it <- cr ^? crInv . ix itRef return $ itemEffect cr it w + & worldEventFlags . at InventoryChange ?~ () where f = cWorld . lWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 9a2147057..857c6017d 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -13,6 +13,7 @@ module Dodge.Data.World ( module Dodge.Data.Input, ) where +import Data.Set (Set) import Dodge.Data.SaveSlot import Control.Lens import qualified Data.Map.Strict as M @@ -24,6 +25,10 @@ import Dodge.Data.SoundOrigin import Sound.Data import System.Random +data WorldEventFlag = InventoryChange + | CombineInventoryChange + deriving (Eq,Ord,Enum,Bounded) + data World = World { _cWorld :: CWorld , _randGen :: StdGen @@ -33,6 +38,7 @@ data World = World , _testFloat :: Float , _rbOptions :: RightButtonOptions , _hud :: HUD + , _worldEventFlags :: Set WorldEventFlag } -- deriving (Eq, Ord, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 8d75e574c..a4fb1c75a 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -40,6 +40,7 @@ defaultWorld = , _testFloat = 0 , _rbOptions = NoRightButtonOptions , _hud = defaultHUD + , _worldEventFlags = mempty } defaultCWGen :: CWGen diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 0dd209990..bb80ac9e7 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/src/Dodge/DisplayInventory.hs @@ -2,8 +2,9 @@ module Dodge.DisplayInventory ( toggleCombineInv, - updatePositionHUD, updateInventorySectionItems, + updateInventoryPositioning, + updateCombinePositioning, ) where import Dodge.ListDisplayParams @@ -25,21 +26,17 @@ import LensHelp import Picture.Base import Regex --- this should ONLY change the shownitems -updatePositionHUD :: Universe -> Universe -updatePositionHUD u = case u ^? uvWorld . hud . hudElement . subInventory of - Just NoSubInventory -> u & updateDisplayInventory - Just CombineInventory {} -> u & uvWorld . hud . hudElement . subInventory . ciSections - %~ updateCombineInventory (_uvWorld u) (_uvConfig u) - _ -> u - toggleCombineInv :: Universe -> Universe toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of Just CombineInventory{} -> uv & uvWorld . hud . hudElement . subInventory .~ NoSubInventory _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig) -updateCombineInventory :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem -updateCombineInventory w cfig sss = +updateCombinePositioning :: Universe -> Universe +updateCombinePositioning u = u & uvWorld . hud . hudElement . subInventory . ciSections + %~ updateCombineSections (_uvWorld u) (_uvConfig u) + +updateCombineSections :: World -> Configuration -> SelectionSections CombinableItem -> SelectionSections CombinableItem +updateCombineSections w cfig sss = sss & sssSections %~ updateSectionsPositioning mselpos @@ -83,8 +80,8 @@ orRegex f x str = case words str of [] -> True xs -> any (f x) xs -updateDisplayInventory :: Universe -> Universe -updateDisplayInventory u = u & uvWorld . hud . hudElement . diSections +updateInventoryPositioning :: Universe -> Universe +updateInventoryPositioning u = u & uvWorld . hud . hudElement . diSections %~ updateDisplaySections (_uvWorld u) (_uvConfig u) updateDisplaySections :: World -> Configuration -> SelectionSections () -> SelectionSections () diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index dff86db15..8760c253c 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -22,22 +22,22 @@ module Dodge.Inventory ( setInvPosFromSS, ) where -import Dodge.DisplayInventory -import Dodge.SelectionSections -import Control.Applicative -import Dodge.Data.SelectionList import Color +import Control.Applicative import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base import Dodge.Data.Config +import Dodge.Data.SelectionList import Dodge.Data.World +import Dodge.DisplayInventory import Dodge.Euse import Dodge.Inventory.CheckSlots import Dodge.Inventory.CloseObject import Dodge.Inventory.Color import Dodge.ItEffect import Dodge.Reloading +import Dodge.SelectionSections import Geometry import qualified IntMapHelp as IM import LensHelp @@ -45,6 +45,7 @@ import ListHelp import Padding -- TODO check what happens to selection index when dropping non-selected items + -- | after this the item at the inventory position will no longer exist rmInvItem :: -- | Creature id @@ -55,6 +56,7 @@ rmInvItem :: World rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount of Just x | x > 1 -> w & pointcid . crInv . ix invid . itUse . useAmount -~ 1 + & worldEventFlags . at InventoryChange ?~ () _ -> w & pointcid %~ crCancelReloading @@ -66,16 +68,16 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount & pointcid . crInvEquipped %~ IM.delete invid & pointcid . crInvEquipped %~ IM.mapKeys g & updateselection + & worldEventFlags . at InventoryChange ?~ () where - getcid = cWorld . lWorld . creatures . ix cid pointcid = cWorld . lWorld . creatures . ix cid updateselection - | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid - = scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems - | otherwise - = pointcid . crManipulation . manObject . inInventory . ispItem %~ g + | cid == 0 && cr ^? crManipulation . manObject . inInventory . ispItem == Just invid = + scrollAugInvSel (-1) . scrollAugInvSel 1 . updateInventorySectionItems + | otherwise = + pointcid . crManipulation . manObject . inInventory . ispItem %~ g cr = w ^?! cWorld . lWorld . creatures . ix cid itm = _crInv cr IM.! invid @@ -111,13 +113,14 @@ rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crMan Nothing -> w selNumPos :: ManipulatedObject -> World -> Maybe Int -selNumPos mo w = w ^? hud . hudElement . diSections >>= - case mo of - InInventory SortInventory -> selSecSelPos (-1) 0 - InInventory (SelItem i _) -> selSecSelPos 0 i - SelNothing -> selSecSelPos 1 0 - InNearby SortNearby -> selSecSelPos 2 0 - InNearby (SelCloseObject i) -> selSecSelPos 3 i +selNumPos mo w = + w ^? hud . hudElement . diSections + >>= case mo of + InInventory SortInventory -> selSecSelPos (-1) 0 + InInventory (SelItem i _) -> selSecSelPos 0 i + SelNothing -> selSecSelPos 1 0 + InNearby SortNearby -> selSecSelPos 2 0 + InNearby (SelCloseObject i) -> selSecSelPos 3 i -- there are still more ListDisplayParams to integrate here selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2 @@ -130,8 +133,13 @@ selNumTextEndPos cfig ldp sss i j = do hh = halfHeight cfig hw = halfWidth cfig -selNumEndMidHeight :: Configuration -> ListDisplayParams -> SelectionSections a -> Int - -> Int -> Maybe Point2 +selNumEndMidHeight :: + Configuration -> + ListDisplayParams -> + SelectionSections a -> + Int -> + Int -> + Maybe Point2 selNumEndMidHeight cfig ldp sss i j = do ipos <- selSecSelPos i j sss size <- selSecSelSize i j sss @@ -165,12 +173,12 @@ updateCloseObjects w = & updatecursorposifnecessary where newcloseobjects = unionBy closeObjEq oldCloseFiltered currentClose - updatecursorposifnecessary - = case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject. inNearby . ispCloseObject of - Just i + updatecursorposifnecessary = + case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject of + Just i | i >= length newcloseobjects -> scrollAugInvSel 1 - | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) - -> scrollAugInvSel (-1) + | isNothing (w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems . ix i) -> + scrollAugInvSel (-1) _ -> id filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w ypos = _crPos $ you w @@ -321,17 +329,21 @@ closeObjScrollDir x changeSwapInvSel :: Int -> World -> World changeSwapInvSel k w = case you w ^? crManipulation . manObject of - Just (InInventory (SelItem i _)) -> w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i - Just (InNearby (SelCloseObject i)) -> w - & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject + Just (InInventory (SelItem i _)) -> + w & cWorld . lWorld . creatures . ix 0 %~ updatecreature i + & worldEventFlags . at InventoryChange ?~ () + Just (InNearby (SelCloseObject i)) -> + w + & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inNearby . ispCloseObject .~ ((i - k) `mod` numCO) & hud . closeObjects %~ swapIndices i ((i - k) `mod` numCO) + & worldEventFlags . at InventoryChange ?~ () _ -> w where updatecreature i = (crInv %~ IM.safeSwapKeys (i `mod` n) (swapi i)) . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel i) - . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k) + . (crManipulation . manObject . inInventory . ispItem %~ (`mod` n) . subtract k) . (crInvEquipped %~ IM.safeSwapKeys i (swapi i)) . swapSite i (swapi i) . swapSite (swapi i) i @@ -352,15 +364,17 @@ scrollAugInvSel yi w | yi == 0 = w | otherwise = w & hud . hudElement . diSections %~ scrollSelectionSections yi + & worldEventFlags . at InventoryChange ?~ () & setInvPosFromSS setInvPosFromSS :: World -> World -setInvPosFromSS w = w - & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel +setInvPosFromSS w = + w + & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel where thesel = fromMaybe SelNothing $ do sss <- w ^? hud . hudElement . diSections - (i,j) <- sss ^? sssExtra . sssSelPos . _Just + (i, j) <- sss ^? sssExtra . sssSelPos . _Just case i of (-1) -> Just $ InInventory SortInventory 0 -> Just $ InInventory (SelItem j NoInvSelAction) @@ -368,10 +382,10 @@ setInvPosFromSS w = w 2 -> Just $ InNearby SortNearby 3 -> Just $ InNearby $ SelCloseObject j _ -> error "selection out of bounds" - selectedCloseObject :: World -> Maybe (Either FloorItem Button) selectedCloseObject w = do - i <- you w ^? crManipulation . manObject . inNearby . ispCloseObject - <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems) + i <- + you w ^? crManipulation . manObject . inNearby . ispCloseObject + <|> fmap fst (IM.lookupMin =<< w ^? hud . hudElement . diSections . sssSections . ix 3 . ssItems) w ^? hud . closeObjects . ix i diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e7c179f46..de47ca501 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -7,8 +7,7 @@ Description : Simulation update module Dodge.Update (updateUniverse) where --import Dodge.InputFocus -import Dodge.DisplayInventory -import Dodge.ScrollValue + import Color import Control.Applicative import Data.List @@ -21,6 +20,7 @@ import Dodge.CrGroupUpdate import Dodge.Creature.Update --import Dodge.Data.SelectionList import Dodge.Data.Universe +import Dodge.DisplayInventory import Dodge.Distortion import Dodge.DrWdWd import Dodge.EnergyBall @@ -43,6 +43,7 @@ import Dodge.Projectile.Update import Dodge.Prop.Update import Dodge.RadarBlip import Dodge.RadarSweep +import Dodge.ScrollValue import Dodge.Shockwave.Update import Dodge.SoundLogic import Dodge.Spark @@ -69,10 +70,10 @@ updateUniverse :: Universe -> Universe updateUniverse u = updateUniverseLast . advanceScrollAmount + . updateWorldEventFlags . maybeOpenTerminal . over (uvWorld . input . textInput) (const mempty) . updateUniverseMid - . updatePositionHUD . updateUseInput . over uvWorld (updateCamera cfig) . over (uvWorld . input) updateScrollTestValue @@ -81,6 +82,17 @@ updateUniverse u = where cfig = u ^. uvConfig +updateWorldEventFlags :: Universe -> Universe +updateWorldEventFlags u = + (uvWorld . worldEventFlags .~ mempty) + . updateInventoryPositioning + $ foldr updateWorldEventFlag u (u ^. uvWorld . worldEventFlags) + +updateWorldEventFlag :: WorldEventFlag -> Universe -> Universe +updateWorldEventFlag wef = case wef of + InventoryChange -> id -- TODO determine more precisely when the inventory does change + CombineInventoryChange -> updateCombinePositioning + maybeOpenTerminal :: Universe -> Universe maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of Just InitialPress -> gotoTerminal u @@ -91,11 +103,6 @@ gotoTerminal w = case _uvScreenLayers w of (InputScreen{} : _) -> w _ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command" - - - - - updateUniverseLast :: Universe -> Universe updateUniverseLast = over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held @@ -248,13 +255,12 @@ functionalUpdate w = -- where -- y = w ^. input . scrollAmount updateWheelEvents :: World -> World -updateWheelEvents w +updateWheelEvents w | yi == 0 = w | otherwise = updateWheelEvent yi w where yi = w ^. input . scrollAmount - advanceScrollAmount :: Universe -> Universe advanceScrollAmount u = u @@ -267,10 +273,11 @@ updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. lWorld --updatePastWorlds w = w & pastWorlds .~ [] doWorldEvents :: World -> World -doWorldEvents w = foldl' - (flip doWdWd) - (w & cWorld . lWorld . worldEvents .~ []) - (w ^. cWorld . lWorld . worldEvents) +doWorldEvents w = + foldl' + (flip doWdWd) + (w & cWorld . lWorld . worldEvents .~ []) + (w ^. cWorld . lWorld . worldEvents) updateLasers :: World -> World updateLasers w = @@ -565,6 +572,7 @@ updateSeenWalls w = foldl' markWallSeen w (map (_wlID . snd) $ allVisibleWalls w markWallSeen :: World -> Int -> World markWallSeen w i = w & cWorld . seenWalls . at i ?~ () + --markWallSeen !w !i = w & cWorld . lWorld . walls %~ IM.adjust markSeen i -- in the past there might have been a space leak, which the following was meant -- to fix