This commit is contained in:
2025-06-24 08:48:08 +01:00
parent 5537efe584
commit 366b998989
10 changed files with 25 additions and 28 deletions
+5 -8
View File
@@ -2,7 +2,7 @@ module Dodge.Base.Coordinate (
cartePosToScreen,
worldPosToScreen,
screenToWorldPos,
mouseWorldPos',
mouseWorldPos,
) where
import Control.Lens
@@ -37,7 +37,7 @@ coordinates.
cartePosToScreen :: HUD -> Point2 -> Point2
cartePosToScreen thehud = doRotate . doZoom . doTranslate
where
doTranslate p = p -.- (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w))
doTranslate p = p - (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w))
doZoom p = (thehud ^. carteZoom) *.* p
doRotate p = rotateV (negate $ thehud ^. carteRot) p
@@ -45,16 +45,13 @@ cartePosToScreen thehud = doRotate . doZoom . doTranslate
--crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
-- | The mouse position in world coordinates.
mouseWorldPos' :: Input -> Camera -> Point2
mouseWorldPos' inp cam =
(cam ^. camCenter)
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos inp)
mouseWorldPos :: Input -> Camera -> Point2
mouseWorldPos inp cam = screenToWorldPos cam (inp ^. mousePos)
screenToWorldPos :: Camera -> Point2 -> Point2
screenToWorldPos cam p =
(cam ^. camCenter)
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
---- | The mouse position in map coordinates
--mouseCartePos :: World -> Point2
+1 -1
View File
@@ -28,7 +28,7 @@ applyPiercingDamage cr dm
/ V2 x x
x = crMass (_crType cr)
p = _dmPos dm
p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
p1 = p + 2 *.* squashNormalizeV (p - _crPos cr)
damageHP :: Creature -> Int -> World -> World
damageHP cr x =
+1 -1
View File
@@ -18,7 +18,7 @@ data EnergyBall = EnergyBall
{ _ebVel :: Point2
, _ebPos :: Point2
, _ebTimer :: Int
, _ebEff :: EnergyBallType
, _ebType :: EnergyBallType
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
+1 -1
View File
@@ -120,4 +120,4 @@ closestCreatureID u =
. crsHitRadial mwp 100
$ _uvWorld u
where
mwp = mouseWorldPos' (u ^. uvWorld . input) (u ^. uvWorld . wCam)
mwp = mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
+4 -4
View File
@@ -215,7 +215,7 @@ drawWallsNearYou w = concat $ do
drawWallsNearCursor :: World -> Picture
drawWallsNearCursor w =
foldMap f $ wlsNearPoint (mouseWorldPos' (_input w) (_wCam w)) w
foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_wCam w)) w
where
f wl =
setLayer DebugLayer (color rose $ thickLine 3 [a, b])
@@ -280,7 +280,7 @@ drawZoneNearPointCursor :: World -> Picture
drawZoneNearPointCursor w =
foldMap (drawZoneCol orange 50) ps
where
mwp = mouseWorldPos' (w ^. input) (w ^. wCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
ps = [zoneOfPoint 50 mwp]
drawDDATest :: World -> Picture
@@ -289,7 +289,7 @@ drawDDATest w =
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = w ^. wCam . camViewFrom
mwp = mouseWorldPos' (w ^. input) (w ^. wCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
ps = zoneOfSeg 50 cvf mwp
drawWallSearchRays :: World -> Picture
@@ -354,7 +354,7 @@ drawMousePosition w =
. text
$ shortPoint2 mwp
where
mwp = mouseWorldPos' (w ^. input) (w ^. wCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
drawCoord :: Point2 -> World -> Picture
drawCoord p w =
+7 -7
View File
@@ -27,7 +27,7 @@ makeFlamelet p v s t w =
{ _ebVel = v
, _ebPos = p
, _ebTimer = t
, _ebEff = FlameletBall s a
, _ebType = FlameletBall s a
}
where
(a, g) = randomR (0, 3) $ _randGen w
@@ -36,18 +36,18 @@ updateEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
updateEnergyBall w eb
| _ebTimer eb <= 0 = (w, Nothing)
| otherwise =
( ebEffect eb . ebFlicker eb $ ebDamage (_ebPos eb) (_ebEff eb) w
( ebEffect eb . ebFlicker eb $ ebDamage (_ebPos eb) (_ebType eb) w
, Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ drag * bv
)
where
drag = case eb ^. ebEff of
drag = case eb ^. ebType of
ExplosiveBall -> 0.9
_ -> 0.85
p = eb ^. ebPos + eb ^. ebVel
(bp, bv) = fromMaybe (p, eb ^. ebVel) $ bouncePoint (const True) 0 (eb ^. ebPos) p w
ebEffect :: EnergyBall -> World -> World
ebEffect eb = case _ebEff eb of
ebEffect eb = case _ebType eb of
ElectricalBall i ->
soundContinue (EBSound i) (_ebPos eb) elecCrackleS (Just 2)
. randSparkExtraVel
@@ -68,7 +68,7 @@ energyBallAt ebt p =
{ _ebVel = 0
, _ebPos = p
, _ebTimer = 20
, _ebEff = ebt
, _ebType = ebt
}
makeMovingEB :: Point2 -> EnergyBallType -> Point2 -> World -> World
@@ -78,7 +78,7 @@ makeMovingEB v ebt p =
{ _ebVel = v
, _ebPos = p
, _ebTimer = 20
, _ebEff = ebt
, _ebType = ebt
}
makeFlashBall :: Point2 -> World -> World
@@ -92,7 +92,7 @@ ebFlicker pt
| otherwise = id
ebColor :: EnergyBall -> Color
ebColor eb = case eb ^. ebEff of
ebColor eb = case eb ^. ebType of
IncendiaryBall{} -> red
FlameletBall{} -> red
ElectricalBall{} -> cyan
+3 -3
View File
@@ -1,11 +1,11 @@
module Dodge.EnergyBall.Draw ( drawEnergyBall) where
module Dodge.EnergyBall.Draw (drawEnergyBall) where
import Dodge.Data.EnergyBall
import Geometry
import Picture
drawEnergyBall :: EnergyBall -> Picture
drawEnergyBall eb = case _ebEff eb of
drawEnergyBall eb = case _ebType eb of
FlameletBall x a -> drawFlamelet x a eb
IncendiaryBall -> drawFlamelet 5 0 eb
ElectricalBall{} -> drawStaticBall eb
@@ -20,7 +20,7 @@ drawExplosiveBall eb =
. color white
$ thickCircle r x
where
x = 1 + 3 * (1 - (1-y**2))
x = 1 + 3 * (1 - (1 - y ** 2))
r = 15 - (12 * y)
y = fromIntegral (_ebTimer eb - 10) / 10
+1 -1
View File
@@ -29,7 +29,7 @@ updateFlame w pt
damageInCircle (const $ Flaming 1) ep r w
thit = List.safeHead $ thingsHit sp ep w
sp = _flPos pt
ep = sp +.+ _flVel pt
ep = sp + _flVel pt
mvflame = pt & flTimer -~ 1 & flPos .~ ep & flVel *~ 0.98
r = max 0 $ flameSize pt - 1
+1 -1
View File
@@ -304,7 +304,7 @@ functionalUpdate u =
updateAimPos :: Universe -> Universe
updateAimPos u = u & uvWorld . cWorld . lWorld . lAimPos
.~ mouseWorldPos' (u ^. uvWorld . input) (u ^. uvWorld . wCam)
.~ mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
updateDoor :: Door -> World -> World
updateDoor dr = doDrWdWd (_drMech dr) dr
+1 -1
View File
@@ -73,4 +73,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
spawnSmokeAtCursor :: World -> World
spawnSmokeAtCursor w = shellTrailCloud 400 100 (V3 x y 20) w
where
V2 x y = mouseWorldPos' (w ^. input) (w ^. wCam)
V2 x y = mouseWorldPos (w ^. input) (w ^. wCam)