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-10-08 09:20:19 +01:00
parent 77fcf8353a
commit 4e651fcded
9 changed files with 57 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Barreloid.hs
+2 -1
View File
@@ -37,7 +37,8 @@ updateExpBarrel ps cr w = case cr ^. crHP of
damages = cr ^. crDamage damages = cr ^. crDamage
hiss hiss
| null ps = id | 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 :: Creature -> World -> World
updateBarrel cr = case cr ^. crHP of updateBarrel cr = case cr ^. crHP of
src/Dodge/Bullet/Draw.hs
-14
View File
@@ -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]
src/Dodge/Corpse/Make.hs
+9 -26
View File
@@ -1,42 +1,25 @@
module Dodge.Corpse.Make (makeCorpse) where module Dodge.Corpse.Make (makeCorpse) where
import Dodge.Creature.Radius
import Dodge.Creature.Shape
import Control.Lens import Control.Lens
import Dodge.Creature.Picture import Dodge.Creature.Picture
import Dodge.Creature.Radius
import Dodge.Creature.Shape
--import Dodge.Data.Corpse --import Dodge.Data.Corpse
import Dodge.Data.Creature import Dodge.Data.Creature
import Geometry import Geometry
import Shape import Shape
import ShapePicture import ShapePicture
--makeCorpse :: Creature -> Corpse
makeCorpse :: Creature -> SPic makeCorpse :: Creature -> SPic
makeCorpse cr = makeCorpse cr =
-- defaultCorpse noPic
-- & cpPos .~ _crPos cr . scaleSH (V3 crsize crsize crsize)
-- & cpDir .~ _crDir cr $ mconcat
-- & cpSPic [ colorSH (_skinHead cskin) $ deadScalp cr
-- .~ , colorSH (_skinUpper cskin) $ deadUpperBody cr
noPic , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
( scaleSH (V3 crsize crsize crsize) $ ]
mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
)
where where
cskin = crShape $ _crType cr -- this should be fixed cskin = crShape $ _crType cr -- this should be fixed
crsize = 0.1 * crRad (cr ^. crType) crsize = 0.1 * crRad (cr ^. crType)
rotmdir = rotateSH (_crMvDir cr - _crDir cr) rotmdir = rotateSH (_crMvDir cr - _crDir cr)
--defaultCorpse :: Corpse
--defaultCorpse =
-- Corpse
-- { _cpID = 0
-- , _cpPos = 0
-- , _cpDir = 0
-- , _cpSPic = mempty
-- , _cpRes = NoResurrection
-- }
src/Dodge/Data/LWorld.hs
+1 -2
View File
@@ -134,8 +134,7 @@ data LWorld = LWorld
, _delayedEvents :: [(Int, WdWd)] , _delayedEvents :: [(Int, WdWd)]
, _pressPlates :: IM.IntMap PressPlate , _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button , _buttons :: IM.IntMap Button
, _foregroundShapes :: IM.IntMap ForegroundShape , _foreShapes :: IM.IntMap ForegroundShape
-- , _corpses :: IM.IntMap Corpse
, _lightSources :: IM.IntMap LightSource , _lightSources :: IM.IntMap LightSource
, _lights :: [LSParam] , _lights :: [LSParam]
, _seenLocations :: IM.IntMap (WdP2, String) , _seenLocations :: IM.IntMap (WdP2, String)
src/Dodge/Default/World.hs
+1 -1
View File
@@ -144,7 +144,7 @@ defaultLWorld =
, (1, (WdP2Const (V2 0 0), "START POSITION")) , (1, (WdP2Const (V2 0 0), "START POSITION"))
] ]
, _selLocation = 0 , _selLocation = 0
, _foregroundShapes = mempty , _foreShapes = mempty
, _distortions = [] , _distortions = []
, _lClock = 0 , _lClock = 0
, _lTestString = [] , _lTestString = []
src/Dodge/Draw.hs
-2
View File
@@ -5,7 +5,6 @@ module Dodge.Draw (
module Dodge.Beam.Draw, module Dodge.Beam.Draw,
module Dodge.Block.Draw, module Dodge.Block.Draw,
module Dodge.Item.Draw, module Dodge.Item.Draw,
module Dodge.Bullet.Draw,
module Dodge.Button.Draw, module Dodge.Button.Draw,
module Dodge.EnergyBall.Draw, module Dodge.EnergyBall.Draw,
module Dodge.Flame.Draw, module Dodge.Flame.Draw,
@@ -25,7 +24,6 @@ module Dodge.Draw (
import Dodge.Beam.Draw import Dodge.Beam.Draw
import Dodge.Item.Draw import Dodge.Item.Draw
import Dodge.Block.Draw import Dodge.Block.Draw
import Dodge.Bullet.Draw
import Dodge.Button.Draw import Dodge.Button.Draw
import Dodge.EnergyBall.Draw import Dodge.EnergyBall.Draw
import Dodge.Flame.Draw import Dodge.Flame.Draw
src/Dodge/Lampoid.hs
+7 -5
View File
@@ -13,15 +13,17 @@ updateLampoid :: Creature -> World -> World
updateLampoid cr w = case cr ^?! crType . lampLSID of updateLampoid cr w = case cr ^?! crType . lampLSID of
Nothing -> Nothing ->
let i = IM.newKey (w ^. cWorld . lWorld . lightSources) 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 & cWorld . lWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i
Just i Just i
| cr ^?! crHP . _HP < 0 -> | cr ^?! crHP . _HP < 0 ->
w w
-- & cWorld . lWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 cpos) & cWorld . lWorld . worldEvents
& cWorld . lWorld . worldEvents .:~ MakeTempLight .:~ MakeTempLight
(LSParam (addZ 20 cpos) 150 1) 20 (LSParam (addZ 20 cpos) 150 1)
& soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) cpos 20
& soundOriginsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]]
(destroyMatS Glass) cpos
& cWorld . lWorld . lightSources . at i .~ Nothing & cWorld . lWorld . lightSources . at i .~ Nothing
& cWorld . lWorld . creatures . at cid .~ Nothing & cWorld . lWorld . creatures . at cid .~ Nothing
| otherwise -> | otherwise ->
src/Dodge/Placement/PlaceSpot.hs
+1 -1
View File
@@ -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 PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> PutForeground fs ->
plNewUpID plNewUpID
(gwWorld . cWorld . lWorld . foregroundShapes) (gwWorld . cWorld . lWorld . foreShapes)
fsID fsID
(mvFS p rot fs) (mvFS p rot fs)
w w
src/Dodge/Render/ShapePicture.hs
+36 -23
View File
@@ -1,8 +1,5 @@
module Dodge.Render.ShapePicture ( module Dodge.Render.ShapePicture (worldSPic) where
worldSPic,
) where
import Dodge.Item.Draw.SPic
import Control.Lens import Control.Lens
import Data.Foldable import Data.Foldable
import Data.Strict.Tuple import Data.Strict.Tuple
@@ -10,14 +7,15 @@ import Dodge.Creature.Picture
import Dodge.Data.Universe import Dodge.Data.Universe
import Dodge.Debug.Picture import Dodge.Debug.Picture
import Dodge.Draw import Dodge.Draw
import Dodge.Item.Draw.SPic
import Dodge.RadarBlip import Dodge.RadarBlip
import Dodge.Render.Picture import Dodge.Render.Picture
import Geometry import Geometry
import qualified IntMapHelp as IM import qualified IntMapHelp as IM
import Linear.V3
import Picture import Picture
import Shape import Shape
import ShapePicture import ShapePicture
import Linear.V3
worldSPic :: Config -> Universe -> SPic worldSPic :: Config -> Universe -> SPic
worldSPic cfig u = worldSPic cfig u =
@@ -27,36 +25,44 @@ worldSPic cfig u =
<> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles) <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
<> foldup drawPulseBall (filtOn _pbPos _pulseBalls) <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
<> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks) <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes) <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foreShapes)
<> foldup (drawCreature (u ^. uvWorld . cWorld . lWorld . items)) <> foldup (drawCreature (lw ^. items)) (filtOn _crPos _creatures)
(filtOn _crPos _creatures) <> foldup
<> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos _floorItems)) (Prelude.uncurry floorItemSPic)
( IM.intersectionWith
(,)
(lw ^. items)
(filtOn _flItPos _floorItems)
)
<> foldup btSPic (filtOn _btPos _buttons) <> foldup btSPic (filtOn _btPos _buttons)
<> foldup (mcSPic (u ^. uvWorld . cWorld)) (filtOn _mcPos _machines) <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
<> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms) <> foldMap' drawChasm (w ^. cWorld . chasms)
where where
w = _uvWorld u w = u ^. uvWorld
lw = w ^. cWorld . lWorld
foldup = foldMap' foldup = foldMap'
filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w))) filtOn f g = IM.filter (pointIsClose . f) (g lw)
filtOn' f g = filter (pointIsClose . f) (g (_lWorld (_cWorld w))) filtOn' f g = filter (pointIsClose . f) (g lw)
pointIsClose = cullPoint cfig w pointIsClose = cullPoint cfig w
drawChasm :: [Point2] -> SPic drawChasm :: [Point2] -> SPic
drawChasm = foldMap (Prelude.uncurry drawCliff) . loopPairs drawChasm = foldMap (Prelude.uncurry drawCliff) . loopPairs
drawCliff :: Point2 -> Point2 -> SPic drawCliff :: Point2 -> Point2 -> SPic
drawCliff x y = noPic drawCliff x y =
. translateSHz (-500.01) noPic
. colorSH (dark orange) . translateSHz (-500.01)
$ upperPrismPoly Large Important 500 [x,0.5 *(x+y) + normalizeV (vNormal (y - x)),y] . colorSH (dark orange)
$ upperPrismPoly Large Important 500
[x, 0.5 * (x + y) + normalizeV (vNormal (y - x)), y]
drawPulseBall :: PulseBall -> SPic drawPulseBall :: PulseBall -> SPic
drawPulseBall pb = drawPulseBall pb =
translateSPz 20 translateSPz 20
. uncurryV translateSPxy (pb ^. pbPos) . uncurryV translateSPxy (pb ^. pbPos)
. noShape . noShape
. setLayer BloomLayer . setLayer BloomLayer
$ circleSolidCol green white 10 $ circleSolidCol green white 10
drawCreature :: IM.IntMap Item -> Creature -> SPic drawCreature :: IM.IntMap Item -> Creature -> SPic
drawCreature m cr = translateSPz (_crZ cr) . uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $ drawCreature m cr = translateSPz (_crZ cr) . uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
@@ -130,3 +136,10 @@ mcSPic :: CWorld -> Machine -> SPic
mcSPic cw mc = mcSPic cw mc =
uncurryV translateSPxy (_mcPos mc) $ uncurryV translateSPxy (_mcPos mc) $
rotateSP (_mcDir mc) (drawMachine cw 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]