From 4e651fcdedb438fffbe5d67c8df164eefb7eee1f Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 8 Oct 2025 09:20:19 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Barreloid.hs | 3 +- src/Dodge/Bullet/Draw.hs | 14 -------- src/Dodge/Corpse/Make.hs | 35 +++++-------------- src/Dodge/Data/LWorld.hs | 3 +- src/Dodge/Default/World.hs | 2 +- src/Dodge/Draw.hs | 2 -- src/Dodge/Lampoid.hs | 12 ++++--- src/Dodge/Placement/PlaceSpot.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 59 +++++++++++++++++++------------- 9 files changed, 57 insertions(+), 75 deletions(-) delete mode 100644 src/Dodge/Bullet/Draw.hs diff --git a/src/Dodge/Barreloid.hs b/src/Dodge/Barreloid.hs index fdba23a9a..ecf87cc73 100644 --- a/src/Dodge/Barreloid.hs +++ b/src/Dodge/Barreloid.hs @@ -37,7 +37,8 @@ updateExpBarrel ps cr w = case cr ^. crHP of damages = cr ^. crDamage hiss | null ps = id - | otherwise = soundContinue (BarrelHiss (_crID cr)) (_crPos cr) foamSprayLoopS (Just 1) + | otherwise = soundContinue + (BarrelHiss (_crID cr)) (_crPos cr) foamSprayLoopS (Just 1) updateBarrel :: Creature -> World -> World updateBarrel cr = case cr ^. crHP of diff --git a/src/Dodge/Bullet/Draw.hs b/src/Dodge/Bullet/Draw.hs deleted file mode 100644 index a24a1f387..000000000 --- a/src/Dodge/Bullet/Draw.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Dodge.Bullet.Draw ( - drawBullet, -) where - -import Dodge.Data.Bullet -import Linear -import Picture - -drawBullet :: Bullet -> Picture -drawBullet pt = - setLayer BloomLayer - . setDepth 20 - . color (V4 200 200 200 2) - $ thickLine 2 [_buOldPos pt, _buPos pt] diff --git a/src/Dodge/Corpse/Make.hs b/src/Dodge/Corpse/Make.hs index 1f7d57371..9344affd4 100644 --- a/src/Dodge/Corpse/Make.hs +++ b/src/Dodge/Corpse/Make.hs @@ -1,42 +1,25 @@ module Dodge.Corpse.Make (makeCorpse) where -import Dodge.Creature.Radius -import Dodge.Creature.Shape import Control.Lens import Dodge.Creature.Picture +import Dodge.Creature.Radius +import Dodge.Creature.Shape --import Dodge.Data.Corpse import Dodge.Data.Creature import Geometry import Shape import ShapePicture ---makeCorpse :: Creature -> Corpse makeCorpse :: Creature -> SPic makeCorpse cr = --- defaultCorpse --- & cpPos .~ _crPos cr --- & cpDir .~ _crDir cr --- & cpSPic --- .~ - noPic - ( scaleSH (V3 crsize crsize crsize) $ - mconcat - [ colorSH (_skinHead cskin) $ deadScalp cr - , colorSH (_skinUpper cskin) $ deadUpperBody cr - , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr - ] - ) + noPic + . scaleSH (V3 crsize crsize crsize) + $ mconcat + [ colorSH (_skinHead cskin) $ deadScalp cr + , colorSH (_skinUpper cskin) $ deadUpperBody cr + , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr + ] where cskin = crShape $ _crType cr -- this should be fixed crsize = 0.1 * crRad (cr ^. crType) rotmdir = rotateSH (_crMvDir cr - _crDir cr) - ---defaultCorpse :: Corpse ---defaultCorpse = --- Corpse --- { _cpID = 0 --- , _cpPos = 0 --- , _cpDir = 0 --- , _cpSPic = mempty --- , _cpRes = NoResurrection --- } diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index 89b36eab6..8177b4398 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/src/Dodge/Data/LWorld.hs @@ -134,8 +134,7 @@ data LWorld = LWorld , _delayedEvents :: [(Int, WdWd)] , _pressPlates :: IM.IntMap PressPlate , _buttons :: IM.IntMap Button - , _foregroundShapes :: IM.IntMap ForegroundShape --- , _corpses :: IM.IntMap Corpse + , _foreShapes :: IM.IntMap ForegroundShape , _lightSources :: IM.IntMap LightSource , _lights :: [LSParam] , _seenLocations :: IM.IntMap (WdP2, String) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 59f269ae0..f641e7f9f 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -144,7 +144,7 @@ defaultLWorld = , (1, (WdP2Const (V2 0 0), "START POSITION")) ] , _selLocation = 0 - , _foregroundShapes = mempty + , _foreShapes = mempty , _distortions = [] , _lClock = 0 , _lTestString = [] diff --git a/src/Dodge/Draw.hs b/src/Dodge/Draw.hs index 42e289b6d..c88498ad4 100644 --- a/src/Dodge/Draw.hs +++ b/src/Dodge/Draw.hs @@ -5,7 +5,6 @@ module Dodge.Draw ( module Dodge.Beam.Draw, module Dodge.Block.Draw, module Dodge.Item.Draw, - module Dodge.Bullet.Draw, module Dodge.Button.Draw, module Dodge.EnergyBall.Draw, module Dodge.Flame.Draw, @@ -25,7 +24,6 @@ module Dodge.Draw ( import Dodge.Beam.Draw import Dodge.Item.Draw import Dodge.Block.Draw -import Dodge.Bullet.Draw import Dodge.Button.Draw import Dodge.EnergyBall.Draw import Dodge.Flame.Draw diff --git a/src/Dodge/Lampoid.hs b/src/Dodge/Lampoid.hs index 521e0a7da..e12344ffc 100644 --- a/src/Dodge/Lampoid.hs +++ b/src/Dodge/Lampoid.hs @@ -13,15 +13,17 @@ updateLampoid :: Creature -> World -> World updateLampoid cr w = case cr ^?! crType . lampLSID of Nothing -> let i = IM.newKey (w ^. cWorld . lWorld . lightSources) - in w & cWorld . lWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i) + in w & cWorld . lWorld . lightSources . at i ?~ lsColPosID lcol (addZ h cpos) i & cWorld . lWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i Just i | cr ^?! crHP . _HP < 0 -> w - -- & cWorld . lWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 cpos) - & cWorld . lWorld . worldEvents .:~ MakeTempLight - (LSParam (addZ 20 cpos) 150 1) 20 - & soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) cpos + & cWorld . lWorld . worldEvents + .:~ MakeTempLight + (LSParam (addZ 20 cpos) 150 1) + 20 + & soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] + (destroyMatS Glass) cpos & cWorld . lWorld . lightSources . at i .~ Nothing & cWorld . lWorld . creatures . at cid .~ Nothing | otherwise -> diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 2dfec1c01..8e9f7a645 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -120,7 +120,7 @@ placeSpotID rid ps pt w = case pt of PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w PutForeground fs -> plNewUpID - (gwWorld . cWorld . lWorld . foregroundShapes) + (gwWorld . cWorld . lWorld . foreShapes) fsID (mvFS p rot fs) w diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index c094d3413..dfc730d31 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,8 +1,5 @@ -module Dodge.Render.ShapePicture ( - worldSPic, -) where +module Dodge.Render.ShapePicture (worldSPic) where -import Dodge.Item.Draw.SPic import Control.Lens import Data.Foldable import Data.Strict.Tuple @@ -10,14 +7,15 @@ import Dodge.Creature.Picture import Dodge.Data.Universe import Dodge.Debug.Picture import Dodge.Draw +import Dodge.Item.Draw.SPic import Dodge.RadarBlip import Dodge.Render.Picture import Geometry import qualified IntMapHelp as IM +import Linear.V3 import Picture import Shape import ShapePicture -import Linear.V3 worldSPic :: Config -> Universe -> SPic worldSPic cfig u = @@ -27,36 +25,44 @@ worldSPic cfig u = <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles) <> foldup drawPulseBall (filtOn _pbPos _pulseBalls) <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks) - <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes) - <> foldup (drawCreature (u ^. uvWorld . cWorld . lWorld . items)) - (filtOn _crPos _creatures) - <> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos _floorItems)) + <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foreShapes) + <> foldup (drawCreature (lw ^. items)) (filtOn _crPos _creatures) + <> foldup + (Prelude.uncurry floorItemSPic) + ( IM.intersectionWith + (,) + (lw ^. items) + (filtOn _flItPos _floorItems) + ) <> foldup btSPic (filtOn _btPos _buttons) - <> foldup (mcSPic (u ^. uvWorld . cWorld)) (filtOn _mcPos _machines) - <> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms) + <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines) + <> foldMap' drawChasm (w ^. cWorld . chasms) where - w = _uvWorld u + w = u ^. uvWorld + lw = w ^. cWorld . lWorld foldup = foldMap' - filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w))) - filtOn' f g = filter (pointIsClose . f) (g (_lWorld (_cWorld w))) + filtOn f g = IM.filter (pointIsClose . f) (g lw) + filtOn' f g = filter (pointIsClose . f) (g lw) pointIsClose = cullPoint cfig w drawChasm :: [Point2] -> SPic drawChasm = foldMap (Prelude.uncurry drawCliff) . loopPairs drawCliff :: Point2 -> Point2 -> SPic -drawCliff x y = noPic - . translateSHz (-500.01) - . colorSH (dark orange) - $ upperPrismPoly Large Important 500 [x,0.5 *(x+y) + normalizeV (vNormal (y - x)),y] +drawCliff x y = + noPic + . translateSHz (-500.01) + . colorSH (dark orange) + $ upperPrismPoly Large Important 500 + [x, 0.5 * (x + y) + normalizeV (vNormal (y - x)), y] drawPulseBall :: PulseBall -> SPic drawPulseBall pb = - translateSPz 20 - . uncurryV translateSPxy (pb ^. pbPos) - . noShape - . setLayer BloomLayer - $ circleSolidCol green white 10 + translateSPz 20 + . uncurryV translateSPxy (pb ^. pbPos) + . noShape + . setLayer BloomLayer + $ circleSolidCol green white 10 drawCreature :: IM.IntMap Item -> Creature -> SPic drawCreature m cr = translateSPz (_crZ cr) . uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $ @@ -130,3 +136,10 @@ mcSPic :: CWorld -> Machine -> SPic mcSPic cw mc = uncurryV translateSPxy (_mcPos mc) $ rotateSP (_mcDir mc) (drawMachine cw mc) + +drawBullet :: Bullet -> Picture +drawBullet pt = + setLayer BloomLayer + . setDepth 20 + . color (V4 200 200 200 2) + $ thickLine 2 [_buOldPos pt, _buPos pt]