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

Introduce idea of world event flags

Browse Source
This commit is contained in:
justin
2023-02-23 11:46:45 +00:00
parent da49d7003e
commit fc0fd5fa37
7 changed files with 87 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/texture/charMap.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.4 KiB

After

Width:  |  Height:  |  Size: 3.4 KiB

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