This commit is contained in:
2025-01-07 00:39:59 +00:00
parent beaf65f3f7
commit 1e7611ab81
13 changed files with 76 additions and 60 deletions
Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

+1 -1
View File
File diff suppressed because one or more lines are too long
+8
View File
@@ -49,8 +49,14 @@ data Item = Item
, _itTargeting :: ItemTargeting
, _itAmmoSlots :: IM.IntMap AmmoType
, _itParams :: ItemParams
, _itScroll :: ItemScroll
}
data ItemScroll
= NoItemScroll
| ItemScrollInt {_itsInt :: Int}
| ItemScrollIntRange {_itsMax :: Int, _itsRangeInt :: Int}
data ItemTargeting = NoItTargeting
| ItTargeting
{ _itTgPos :: Maybe Point2
@@ -61,6 +67,8 @@ data ItemTargeting = NoItTargeting
makeLenses ''ItemTargeting
makeLenses ''Consumables
makeLenses ''Item
makeLenses ''ItemScroll
deriveJSON defaultOptions ''ItemScroll
deriveJSON defaultOptions ''Consumables
deriveJSON defaultOptions ''ItemTargeting
deriveJSON defaultOptions ''ItID
+1
View File
@@ -26,6 +26,7 @@ defaultHeldItem =
, _itUse = defaultHeldUse
, _itParams = NoParams
, _itUseCondition = UseableWhenAimed
, _itScroll = NoItemScroll
}
--defaultLeftItem :: Item
+9 -1
View File
@@ -51,12 +51,20 @@ itemDisplay w cr ci = f
f xs _ = xs
g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs
g xs _ = xs
anyextra = maybeToList (anyhotkey <> anyequippos)
anyextra = maybeToList (anyhotkey <> anyequippos <> anyscroll)
anyhotkey = fmap hotkeyToString
(w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
anyequippos = fmap
(rightPad 8 ' ' . (' ' :) . eqPosText)
(ci ^? _1 . itLocation . ilEquipSite . _Just)
anyscroll = fmap absurround $ itemScrollDisplay =<< (ci ^? _1 . itScroll)
absurround str = '<' : str ++ ">"
itemScrollDisplay :: ItemScroll -> Maybe String
itemScrollDisplay = \case
NoItemScroll -> Nothing
ItemScrollInt i -> Just $ show i
ItemScrollIntRange _ i -> Just $ show i
itemDisplayPad :: [Char] -> String -> [Char]
itemDisplayPad ls rs
+3
View File
@@ -89,18 +89,21 @@ copier x =
defaultHeldItem
& itType .~ COPIER x
& itUse .~ UseInt 0
& itScroll .~ ItemScrollInt 0
bgate :: Item
bgate =
defaultHeldItem
& itType .~ BGATE
& itUse .~ UseInt 0
& itScroll .~ ItemScrollIntRange 15 0
ugate :: Item
ugate =
defaultHeldItem
& itType .~ UGATE
& itUse .~ UseInt 0
& itScroll .~ ItemScrollIntRange 3 0
bulletModule :: BulletMod -> Item
bulletModule bm =
+2 -2
View File
@@ -84,7 +84,7 @@ aSound vol status fpos sType mtime w =
, _soundStatus =
SoundStatus
{ _playStatus = status
, _isLooping = isJust mtime
, _soundIsLooping = isJust mtime
}
, _soundChannel = Nothing
, _soundAngDist = Just (a, floor (225 * (1 - vol)))
@@ -192,7 +192,7 @@ soundMultiFrom (so : sos) pos sType mtime w
, _soundStatus =
SoundStatus
{ _playStatus = ToStart
, _isLooping = isJust mtime
, _soundIsLooping = isJust mtime
}
, _soundChannel = Nothing
, _soundAngDist = Just (a, 0)
+1 -1
View File
@@ -26,7 +26,7 @@ import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSelection . _Just]
testStringInit u = prettyShort $ M.elems $ u ^. uvWorld . input . pressedKeys
--testStringInit u = foldMap prettyShort $ u ^. uvWorld . cWorld . lWorld . projectiles
-- (map (show . _ebPos) $ u ^. uvWorld . cWorld . lWorld . energyBalls)
-- <>
+34 -40
View File
@@ -1,4 +1,5 @@
--{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{- |
Module : Dodge.Update
@@ -25,7 +26,6 @@ import Dodge.DrWdWd
import Dodge.EnergyBall
import Dodge.Flame
import Dodge.Inventory
--import Dodge.Item.Location
import Dodge.Laser.Update
import Dodge.LinearShockwave.Update
import Dodge.ListDisplayParams
@@ -83,7 +83,8 @@ updateUniverseFirst :: Universe -> Universe
updateUniverseFirst u =
u
& uvWorld . input . clickWorldPos %~ M.union (setClickWorldPos u)
& uvWorld . input . smoothScrollAmount %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
& uvWorld . input . smoothScrollAmount
%~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
& over (uvWorld . input) updateScrollTestValue
& updateDebugMessageOffset
& over (uvWorld . cWorld . cClock) (+ 1)
@@ -119,21 +120,21 @@ updateWorldEventFlag wef = case wef of
-- for now update inventory positioning every tick
CombineInventoryChange -> updateCombinePositioning
maybeOpenTerminal :: Universe -> Universe
maybeOpenTerminal u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
Just InitialPress -> gotoTerminal u
maybeOpenConsole :: Universe -> Universe
maybeOpenConsole u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of
Just InitialPress -> u & uvScreenLayers %~ openConsole
_ -> u
gotoTerminal :: Universe -> Universe
gotoTerminal w = case _uvScreenLayers w of
(InputScreen{} : _) -> w
_ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command"
openConsole :: [ScreenLayer] -> [ScreenLayer]
openConsole = \case
xs@(InputScreen{} : _) -> xs
xs -> InputScreen mempty "Enter command" : xs
updateUniverseLast :: Universe -> Universe
updateUniverseLast u =
u
& over (uvWorld . input . textInput) (const mempty)
& maybeOpenTerminal
& maybeOpenConsole
& advanceScrollAmount
& updateWorldEventFlags
& uvWorld . input . pressedKeys . each %~ f
@@ -154,17 +155,7 @@ updateUniverseLast u =
updateUniverseMid :: Universe -> Universe
updateUniverseMid u = case _uvScreenLayers u of
(OptionScreen{_scOptionFlag = LoadingScreen} : _) -> u
(sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) ->
u & updateUseInputOnScreen sl
& uvWorld
%~ (
--updateParticles
(cWorld . lWorld . radarBlips .~ [])
-- . updateIMl _props _pjUpdate
-- might want to clear temp light sources here?
. (cWorld . lWorld . lights .~ [])
. updateClouds
)
-- (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
(sl : _) -> u & updateUseInputOnScreen sl
[] ->
timeFlowUpdate . updateUseInputInGame $
@@ -189,11 +180,12 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
pauseTime :: NewInt ItmInt -> World -> World
--pauseTime itmloc w
pauseTime _ w
-- | justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
-- | justPressedButtonLeft || outofcharge = w & timeFlow .~ NormalTimeFlow
| justPressedButtonLeft = w & timeFlow .~ NormalTimeFlow
| otherwise = w -- & pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix (_unNInt itmloc)) . itUse . leftConsumption . wpCharge -~ 1
where
justPressedButtonLeft = w ^? input . mouseButtons . ix ButtonLeft == Just 0
-- outofcharge = maybe True (== 0) charge
-- charge = w ^? pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix (_unNInt itmloc)) . itUse . leftConsumption . wpCharge
@@ -229,8 +221,9 @@ scrollTimeBack w = case w ^? pastWorlds . _head of
mupdateitem _ = fromMaybe id $ do
--i <- w ^? timeFlow . scrollItemID . unNInt
_ <- w ^? timeFlow . scrollItemID . unNInt
-- let pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
-- let pointituse = pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse
return id
-- (pointituse . leftConsumption . wpCharge .~ (x -1))
-- . (pointituse . leftHammer .~ HammerDown)
@@ -250,7 +243,6 @@ scrollTimeForward w = case w ^? timeFlow . futureWorlds . _head of
_ <- w ^? timeFlow . scrollItemID . unNInt
return id -- pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix i) . itUse . leftConsumption . wpCharge .~ ramount
-- | The update step.
functionalUpdate :: Universe -> Universe
functionalUpdate u =
@@ -265,7 +257,8 @@ functionalUpdate u =
. over uvWorld (updateIMl (_doors . _lWorld . _cWorld) (doDrWdWd . _drMech))
. over uvWorld doWorldEvents
. over uvWorld updateDelayedEvents
. over uvWorld (updateIMl (_modifications . _lWorld . _cWorld) (doModificationEffect . _mdUpdate))
. over uvWorld (updateIMl (_modifications . _lWorld . _cWorld)
(doModificationEffect . _mdUpdate))
. over uvWorld updateSparks
. over uvWorld updateRadarSweeps
. over uvWorld updatePosEvents
@@ -305,8 +298,9 @@ functionalUpdate u =
$ over uvWorld updatePastWorlds u
updateMagnets :: LWorld -> LWorld
updateMagnets lw = lw & oldMagnets .~ (lw ^. magnets)
& magnets .~ mempty
updateMagnets lw =
lw & oldMagnets .~ (lw ^. magnets)
& magnets .~ mempty
checkTermDist :: World -> World
checkTermDist w = fromMaybe w $ do
@@ -410,16 +404,13 @@ isOverTerminalScreen cfig tm (V2 x y) =
updateWheelEvents :: World -> World
updateWheelEvents w
| yi == 0 = w
| otherwise = updateWheelEvent yi w
where
yi = w ^. input . scrollAmount
| 0 <- w ^. input . scrollAmount = w
| yi <- w ^. input . scrollAmount = updateWheelEvent yi w
advanceScrollAmount :: Universe -> Universe
advanceScrollAmount u =
u
& uvWorld . input . scrollAmount .~ 0
& uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll
advanceScrollAmount =
(uvWorld . input . scrollAmount .~ 0)
. (uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll)
updatePastWorlds :: World -> World
updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
@@ -486,7 +477,8 @@ setOldPos cr =
-- Nothing' -> w & timeFlow .~ NormalTimeFlow
zoneCreatures :: World -> World
zoneCreatures w = w & crZoning
zoneCreatures w =
w & crZoning
.~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)
updateCreatureSoundPositions :: World -> World
@@ -542,11 +534,13 @@ updateRadarBlips = updateObjMapMaybe radarBlips updateRadarBlip
-- if changing, make sure that bullets can still spawn new bullets
updateBullets :: World -> World
updateBullets w = w'
& cWorld . lWorld . bullets %~ (++ catMaybes ps)
updateBullets w =
w'
& cWorld . lWorld . bullets %~ (++ catMaybes ps)
where
(w', ps) = mapAccumR updateBullet (w & cWorld . lWorld . bullets .~ [])
$ w ^. cWorld . lWorld . bullets
(w', ps) =
mapAccumR updateBullet (w & cWorld . lWorld . bullets .~ []) $
w ^. cWorld . lWorld . bullets
updateTeslaArcs :: World -> World
updateTeslaArcs = updateObjCatMaybes teslaArcs updateTeslaArc
+2
View File
@@ -14,6 +14,7 @@ import Geometry
import LensHelp
import SDL
-- yi should be nonzero
updateWheelEvent :: Int -> World -> World
updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
NoSubInventory -> updateBaseWheelEvent yi w
@@ -22,6 +23,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement . subInventory of
CombineInventory{} -> moveCombineSel yi w
DisplayTerminal tmid -> terminalWheelEvent yi tmid w
-- yi should be nonzero
updateBaseWheelEvent :: Int -> World -> World
updateBaseWheelEvent yi w
| Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w
+1 -1
View File
@@ -90,7 +90,7 @@ tryPlay sd s = do
& soundChannel ?~ i
& soundStatus . playStatus .~ JustStartedPlaying
where
timesToPlay | _isLooping (_soundStatus s) = Mix.Forever
timesToPlay | _soundIsLooping (_soundStatus s) = Mix.Forever
| otherwise = Mix.Once
tryGetChannel :: Sound -> MaybeT IO Mix.Channel
+1 -1
View File
@@ -16,7 +16,7 @@ import qualified SDL.Mixer as Mix
data SoundStatus = SoundStatus
{ _playStatus :: PlayStatus
, _isLooping :: Bool
, _soundIsLooping :: Bool
}
deriving (Eq, Ord, Show)
+13 -13
View File
@@ -2054,7 +2054,7 @@ Update src/Dodge/LightSource/Update.hs 1;" m
Update src/Dodge/LinearShockwave/Update.hs 1;" m
Update src/Dodge/Machine/Update.hs 1;" m
Update src/Dodge/Magnet/Update.hs 1;" m
Update src/Dodge/Projectile/Update.hs 2;" m
Update src/Dodge/Projectile/Update.hs 4;" m
Update src/Dodge/Prop/Update.hs 1;" m
Update src/Dodge/Shockwave/Update.hs 1;" m
Update src/Dodge/TractorBeam/Update.hs 1;" m
@@ -3416,7 +3416,7 @@ applyCME src/Dodge/HeldUse.hs 161;" f
applyCreatureDamage src/Dodge/Creature/Damage.hs 14;" f
applyDamageEffect src/Dodge/Creature/Damage.hs 31;" f
applyEventIO src/Loop.hs 89;" f
applyGravityPU src/Dodge/Projectile/Update.hs 54;" f
applyGravityPU src/Dodge/Projectile/Update.hs 56;" f
applyIndividualDamage src/Dodge/Creature/Damage.hs 49;" f
applyIndividualDamage' src/Dodge/Creature/Damage.hs 52;" f
applyInvLock src/Dodge/HeldUse.hs 176;" f
@@ -3985,7 +3985,7 @@ destroyMatS src/Dodge/Material/Sound.hs 7;" f
destroyMcType src/Dodge/Machine/Destroy.hs 21;" f
destroyMount src/Dodge/Block.hs 102;" f
destroyMounts src/Dodge/Block.hs 99;" f
destroyProjectile src/Dodge/Projectile/Update.hs 137;" f
destroyProjectile src/Dodge/Projectile/Update.hs 139;" f
detV src/Geometry/Vector.hs 93;" f
detector src/Dodge/Item/Held/Utility.hs 41;" f
detectorColor src/Dodge/Item/Draw/SPic.hs 444;" f
@@ -4057,7 +4057,7 @@ doDrawing src/Dodge/Render.hs 35;" f
doDrawing' src/Dodge/Render.hs 46;" f
doFloatFloat src/Dodge/FloatFunction.hs 5;" f
doGenFloat src/Dodge/HeldUse.hs 595;" f
doGravityPU src/Dodge/Projectile/Update.hs 48;" f
doGravityPU src/Dodge/Projectile/Update.hs 50;" f
doHeldUseEffect src/Dodge/HeldUse.hs 126;" f
doInPlacements src/Dodge/Layout.hs 92;" f
doIndividualPlacements src/Dodge/Layout.hs 117;" f
@@ -4099,7 +4099,7 @@ doTerminalCommandEffect src/Dodge/Terminal.hs 135;" f
doTestDrawing src/Dodge/Render.hs 42;" f
doTextInputOver src/Dodge/Update/Input/Text.hs 15;" f
doTextInputOverUniverse src/Dodge/Update/Input/Text.hs 12;" f
doThrust src/Dodge/Projectile/Update.hs 147;" f
doThrust src/Dodge/Projectile/Update.hs 149;" f
doTimeScroll src/Dodge/Update.hs 205;" f
doTmTm src/Dodge/TmTm.hs 6;" f
doTmWdWd src/Dodge/WorldEffect.hs 99;" f
@@ -4310,7 +4310,7 @@ expandPolyCorners src/Dodge/LevelGen/StaticWalls.hs 103;" f
expandToSquare src/Dodge/LevelGen/StaticWalls/Deprecated.hs 83;" f
expireAndDamage src/Dodge/Bullet.hs 195;" f
expireAndDamageFL src/Dodge/Flame.hs 47;" f
explodeShell src/Dodge/Projectile/Update.hs 227;" f
explodeShell src/Dodge/Projectile/Update.hs 238;" f
explosionS src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 416;" f
explosiveBarrel src/Dodge/Creature/Inanimate.hs 29;" f
extTrigLitPos src/Dodge/Placement/Instance/Button.hs 84;" f
@@ -5200,8 +5200,8 @@ pipe src/Dodge/Item/Craftable.hs 32;" f
pistol src/Dodge/Item/Held/Stick.hs 42;" f
pistolCrit src/Dodge/Creature/PistolCrit.hs 12;" f
pistolerRoom src/Dodge/Room/Room.hs 321;" f
pjMovement src/Dodge/Projectile/Update.hs 207;" f
pjRemoteSetDirection src/Dodge/Projectile/Update.hs 192;" f
pjMovement src/Dodge/Projectile/Update.hs 215;" f
pjRemoteSetDirection src/Dodge/Projectile/Update.hs 200;" f
plBlock src/Dodge/Placement/PlaceSpot/Block.hs 18;" f
plDoor src/Dodge/Placement/PlaceSpot/TriggerDoor.hs 22;" f
plLineBlock src/Dodge/Placement/PlaceSpot/Block.hs 50;" f
@@ -5715,7 +5715,7 @@ shardShape src/Dodge/Block/Debris.hs 181;" f
shatterGun src/Dodge/Item/Held/Weapons.hs 8;" f
shatterGunSPic src/Dodge/Item/Draw/SPic.hs 294;" f
shatterWall src/Dodge/Item/Weapon/Shatter.hs 26;" f
shellCollisionCheck src/Dodge/Projectile/Update.hs 83;" f
shellCollisionCheck src/Dodge/Projectile/Update.hs 85;" f
shellMag src/Dodge/Item/Ammo.hs 61;" f
shellModule src/Dodge/Item/Scope.hs 111;" f
shellShape src/Dodge/Projectile/Draw.hs 34;" f
@@ -6113,8 +6113,8 @@ tryPutFloorItemIDInInv src/Dodge/Inventory/Add.hs 26;" f
tryPutItemInInv src/Dodge/Inventory/Add.hs 42;" f
tryPutItemInInvAt src/Dodge/Inventory/Add.hs 32;" f
trySeedFromClipboard src/Dodge/Menu.hs 88;" f
tryShellBounce src/Dodge/Projectile/Update.hs 101;" f
trySpinByCID src/Dodge/Projectile/Update.hs 174;" f
tryShellBounce src/Dodge/Projectile/Update.hs 103;" f
trySpinByCID src/Dodge/Projectile/Update.hs 178;" f
trySynthBullet src/Dodge/Creature/State.hs 203;" f
tryUseParent src/Dodge/Creature/State.hs 196;" f
turnTo src/Dodge/Movement/Turn.hs 4;" f
@@ -6150,7 +6150,7 @@ unusedOffPathAwayFromLink src/Dodge/PlacementSpot.hs 133;" f
unusedSpotAwayFromInLink src/Dodge/PlacementSpot.hs 139;" f
unusedSpotAwayFromLink src/Dodge/PlacementSpot.hs 122;" f
unusedSpotNearInLink src/Dodge/PlacementSpot.hs 191;" f
upProjectile src/Dodge/Projectile/Update.hs 33;" f
upProjectile src/Dodge/Projectile/Update.hs 35;" f
updateAllNodes src/TreeHelp.hs 85;" f
updateArc src/Dodge/Tesla.hs 91;" f
updateArc src/Dodge/Tesla/Arc.hs 100;" f
@@ -6221,7 +6221,7 @@ updatePastWorlds src/Dodge/Update.hs 424;" f
updatePosEvent src/Dodge/PosEvent.hs 11;" f
updatePosEvents src/Dodge/Update.hs 572;" f
updatePreload src/Preload/Update.hs 20;" f
updateProjectile src/Dodge/Projectile/Update.hs 25;" f
updateProjectile src/Dodge/Projectile/Update.hs 27;" f
updateProp src/Dodge/Prop/Update.hs 11;" f
updatePulse src/Dodge/Creature/Update.hs 22;" f
updateRBList src/Dodge/Inventory/RBList.hs 16;" f