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
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
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
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
-- }
src/Dodge/Data/LWorld.hs
+1 -2
View File
@@ -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)
src/Dodge/Default/World.hs
+1 -1
View File
@@ -144,7 +144,7 @@ defaultLWorld =
, (1, (WdP2Const (V2 0 0), "START POSITION"))
]
, _selLocation = 0
, _foregroundShapes = mempty
, _foreShapes = mempty
, _distortions = []
, _lClock = 0
, _lTestString = []
src/Dodge/Draw.hs
-2
View File
@@ -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
src/Dodge/Lampoid.hs
+7 -5
View File
@@ -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 ->
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
PutForeground fs ->
plNewUpID
(gwWorld . cWorld . lWorld . foregroundShapes)
(gwWorld . cWorld . lWorld . foreShapes)
fsID
(mvFS p rot fs)
w
src/Dodge/Render/ShapePicture.hs
+36 -23
View File
@@ -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]