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

Cleanup

Browse Source
This commit is contained in:
justin
2025-01-07 00:39:59 +00:00
parent beaf65f3f7
commit 1e7611ab81
13 changed files with 76 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Item.hs
+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
src/Dodge/Default/Item.hs
+1
View File
@@ -26,6 +26,7 @@ defaultHeldItem =
, _itUse = defaultHeldUse
, _itParams = NoParams
, _itUseCondition = UseableWhenAimed
, _itScroll = NoItemScroll
}
--defaultLeftItem :: Item
src/Dodge/Inventory/SelectionList.hs
+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
src/Dodge/Item/Scope.hs
+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 =
src/Dodge/SoundLogic.hs
+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)
src/Dodge/TestString.hs
+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)
-- <>
src/Dodge/Update.hs
+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
src/Dodge/Update/Scroll.hs
+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