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

Replace buggy circle seg intersection with a simpler test

Browse Source
This commit is contained in:
justin
2024-12-26 21:53:18 +00:00
parent 91ba6ee148
commit 0ef28c132e
29 changed files with 528 additions and 332 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/dodge.config.json
+1 -2
View File
@@ -1,8 +1,7 @@
{
"_debug_booleans": [
"Show_ms_frame",
"Circ_collision_test",
"Show_walls_near_segment"
"Circ_collision_test"
],
"_debug_view_clip_bounds": "NoRoomClipBoundaries",
"_gameplay_rotate_to_wall": true,
graph/itemCombinations.gv
+2 -2
View File
@@ -38,9 +38,9 @@ digraph {
44 [shape=box
,label="HELD {_ibtHeld = AUTOAMR}"];
46 [shape=box
,label="HELD {_ibtHeld = LAUNCHER}"];
,label="HELD {_ibtHeld = RLAUNCHER}"];
49 [shape=box
,label="HELD {_ibtHeld = LAUNCHERX {_xNum = 2}}"];
,label="HELD {_ibtHeld = RLAUNCHERX {_xNum = 2}}"];
53 [shape=box
,label="HELD {_ibtHeld = FLAMESPITTER}"];
57 [shape=box
saveSlot/QuickSave
+1 -1
View File
File diff suppressed because one or more lines are too long
src/Dodge/Base/Collide.hs
+8 -4
View File
@@ -147,9 +147,13 @@ overlapCircWalls p r = mapMaybe dointersect
f (a, b) = intersectSegSeg p (p +.+ r *.* normalizeV ((0.5 *.* (a +.+ b)) -.- p)) a b
circHitWall :: Point2 -> Point2 -> Float -> World -> Bool
circHitWall sp ep r w = any (uncurry (intersectSegSegTest sp ep) . _wlLine)
(wlsNearSeg sp ep w)
circHitWall sp ep r w = any (uncurry (intersectSegSegTest xsp xep) . _wlLine)
(wlsNearSeg xsp xep w)
|| circOnSomeWall ep r w
where
x = r *.* normalizeV (ep - sp)
xsp = sp - x
xep = ep + x
-- | note that this does not push the circle away from the wall at all
collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
@@ -241,7 +245,6 @@ canSeeIndirect i j w = hasLOSIndirect ipos jpos w
jpos = w ^?! cWorld . lWorld . creatures . ix j . crPos
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
--anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
where
x = rad *.* normalizeV (ep - sp)
@@ -251,7 +254,8 @@ anythingHitCirc rad sp ep w = hitCr || circHitWall sp ep rad w
f cid bl =
maybe
False
(\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
--(\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
(\cr -> intersectCircSegTest (_crPos cr) (rad + _crRad cr) sp ep)
(w ^? cWorld . lWorld . creatures . ix cid)
|| bl
-- hitWl = collideCircWalls sp ep rad $ wlsNearSeg xsp xep w
src/Dodge/Combine/Combinations.hs
+3 -3
View File
@@ -78,10 +78,10 @@ itemCombinations =
, po [HELD RIFLE, cr PIPE] amr
, po [HELD AMR, cr SPRING] autoAmr
-- , po [HELD AMR, cr MOTOR] machineGun
, p [p 2 $ cr TUBE, o $ cr HARDWARE] launcher
, p [p 2 $ cr TUBE, o $ HELD LAUNCHER] (launcherX 2)
, p [p 2 $ cr TUBE, o $ cr HARDWARE] rLauncher
, p [p 2 $ cr TUBE, o $ HELD RLAUNCHER] (rLauncherX 2)
]
++ [p [p 2 $ cr TUBE, o $ HELD (LAUNCHERX i)] (launcherX (i + 1)) | i <- [2 .. 9]]
++ [p [p 2 $ cr TUBE, o $ HELD (RLAUNCHERX i)] (rLauncherX (i + 1)) | i <- [2 .. 9]]
++ [ po [cr LIGHTER, cr PUMP, cr CAN] flameSpitter
, po [HELD FLAMESPITTER, cr CAN, cr PUMP] blowTorch
, po [HELD FLAMESPITTER, cr STEELDRUM] flameThrower
src/Dodge/Combine/Graph.hs
+1 -1
View File
@@ -52,7 +52,7 @@ maxShowX = \case
HELD (VOLLEYGUN _) -> Just 3
HELD (MINIGUNX _) -> Just 3
HELD (GRAPECANNON _) -> Just 1
HELD (LAUNCHERX _) -> Just 2
HELD (RLAUNCHERX _) -> Just 2
-- HELD (LASWIDE _) -> Just 2
-- LASGUNFOCUS _ -> Just 2
_ -> Nothing
src/Dodge/Creature.hs
+7 -6
View File
@@ -225,10 +225,10 @@ inventoryX c = case c of
]
'M' -> stackedInventory
'N' -> [zoomScope,laser,battery, sniperRifle, tinMag]
'O' -> [ launcherX 2
'O' -> [ rLauncherX 2
, shellMag
, shellMag
, launcherX 3
, rLauncherX 3
, shellMag
, shellMag
, shellMag
@@ -243,19 +243,20 @@ inventoryX c = case c of
[ battery
, laser
, augmentedHUD
, launcher
, rLauncher
, megaShellMag
, homingModule
, remoteScreen
, remoteController
, remoteDetonator
, launcherX 3
, rLauncherX 3
, megaShellMag
, homingModule
, megaShellMag
, homingModule
, megaShellMag
, homingModule
, gLauncher
]
<> [shellModule p | p <- [minBound .. maxBound]]
'V' ->
@@ -317,9 +318,9 @@ stackedInventory =
, bulletSynthesizer
, zoomScope
, drumMag
, launcherX 3
, megaShellMag
, rLauncher
, megaShellMag
, gLauncher
, megaShellMag
, pipe
, timeScroller
src/Dodge/Creature/LauncherCrit.hs
+1 -1
View File
@@ -12,7 +12,7 @@ import Picture
launcherCrit :: Creature
launcherCrit =
defaultCreature
{ _crInv = IM.fromList [(0, launcher)]
{ _crInv = IM.fromList [(0, rLauncher)]
, _crRad = 10
, _crState = defaultState
, _crHP = 300
src/Dodge/Data/Item/Combine.hs
+3 -2
View File
@@ -148,8 +148,9 @@ data HeldItemType
| TESLAGUN
| LASER
| TRACTORGUN
| LAUNCHER
| LAUNCHERX {_xNum :: Int}
| RLAUNCHER
| RLAUNCHERX {_xNum :: Int}
| GLAUNCHER
| POISONSPRAYER
| SHATTERGUN
| TORCH
src/Dodge/Data/Item/Use.hs
+2 -1
View File
@@ -140,7 +140,8 @@ data MuzzleEffect
| MuzzleLaser
| MuzzleTesla
| MuzzleTractor
| MuzzleLauncher
| MuzzleRLauncher
| MuzzleGLauncher
| MuzzleNozzle
{ _nzPressure :: GenFloat
, _nzMaxWalkAngle :: Float
src/Dodge/Data/Item/Use/Consumption/Ammo.hs
+1
View File
@@ -37,6 +37,7 @@ data ProjectileUpdate
,_pjuDetonatorID :: Maybe (NewInt ItmInt)
,_pjuScreenID :: Maybe (NewInt ItmInt)
}
| ApplyGravityPU
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data AmmoType
src/Dodge/Data/Projectile.hs
+1 -1
View File
@@ -14,7 +14,6 @@ import Geometry.Data
data Projectile
= Shell
{ _prjPos :: Point2
, _prjStartPos :: Point2
, _prjVel :: Point2
, _prjAcc :: Point2
, _prjDir :: Float
@@ -24,6 +23,7 @@ data Projectile
, _prjPayload :: Payload
, _prjTimer :: Int
, _prjZ :: Float
, _prjZVel :: Float
, _prjUpdates :: [ProjectileUpdate]
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
src/Dodge/HeldUse.hs
+34 -1
View File
@@ -299,7 +299,8 @@ useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cme
MuzzleLaser -> shootLaser itmtree cr mz w
MuzzleTesla -> shootTeslaArc itm cr mz w
MuzzleTractor -> shootTractorBeam cr w
MuzzleLauncher -> createProjectile magtree mz itmtree cr w
MuzzleRLauncher -> createProjectile magtree mz itmtree cr w
MuzzleGLauncher -> createGProjectile magtree mz itmtree cr w
MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w
MuzzleShatter -> shootShatter itm cr w
MuzzleDetector -> itemDetectorEffect itm cr w
@@ -632,6 +633,38 @@ createProjectile magtree muz itmtree cr = fromMaybe failsound $ do
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
createGProjectile ::
LabelDoubleTree ComposeLinkType Item ->
Muzzle ->
LabelDoubleTree ComposeLinkType Item ->
Creature ->
World ->
World
createGProjectile magtree muz itmtree cr = fromMaybe failsound $ do
magid <- magtree ^? ldtValue . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
let homing = determineProjectileTracking magtree itmtree
rdetonate = fmap (^. ldtValue . itID) $
lookup RemoteDetonatorLink (magtree ^. ldtLeft)
rscreen = fmap (^. ldtValue . itID) $
lookup RemoteScreenLink (magtree ^. ldtLeft)
aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload))
<|> ammoitem ^? itConsumables . magParams . ampPayload
return $
createGShell homing rdetonate rscreen aparams muz cr
. startthesound
where
-- the sound should be moved to the projectile firing
startthesound =
soundMultiFrom
[CrWeaponSound (_crID cr) j | j <- [0 .. 3]]
(_crPos cr)
tap4S
Nothing
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
---- need to add these to muzzle flare?
--makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World
--makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of
src/Dodge/Item/Draw/SPic.hs
+8 -4
View File
@@ -237,8 +237,9 @@ heldItemSPic ht it = case ht of
TESLAGUN -> teslaGunPic
LASER -> lasGunPic it
TRACTORGUN -> tractorGunPic it
LAUNCHER -> launcherPic it
LAUNCHERX _ -> launcherPic it
RLAUNCHER -> rlauncherPic it
RLAUNCHERX _ -> rlauncherPic it
GLAUNCHER -> glauncherPic it
POISONSPRAYER -> flamerPic it
BLINKER -> defSPic
BLINKERUNSAFE -> defSPic
@@ -367,8 +368,11 @@ baseSMGShape = colorSH green $ xCylinderST 3 20
flamerPic :: Item -> SPic
flamerPic _ = noPic . colorSH yellow $ xCylinderST 5 18
launcherPic :: Item -> SPic
launcherPic _ = noPic . colorSH cyan $ xCylinderST 5 20
rlauncherPic :: Item -> SPic
rlauncherPic _ = noPic . colorSH cyan $ xCylinderST 5 20
glauncherPic :: Item -> SPic
glauncherPic _ = noPic . colorSH green $ xCylinderST 5 20
--launcherPic _ = noPic . colorSH cyan $ xCylinder 4 5 20
-- ( colorSH cyan $
src/Dodge/Item/Held.hs
+3 -3
View File
@@ -65,9 +65,9 @@ itemFromHeldType ht = case ht of
-- DUALBEAM -> dualBeam
-- LASWIDE i -> lasWide i
TRACTORGUN -> tractorGun
LAUNCHER -> launcher
LAUNCHERX i -> launcherX i
-- REMOTELAUNCHER -> remoteLauncher
RLAUNCHER -> rLauncher
GLAUNCHER -> gLauncher
RLAUNCHERX i -> rLauncherX i
POISONSPRAYER -> poisonSprayer
DETECTOR d -> detector d
FLATSHIELD -> flatShield
src/Dodge/Item/Held/Launcher.hs
+15 -9
View File
@@ -9,32 +9,38 @@ import Dodge.Data.Item
import qualified IntMapHelp as IM
import Geometry.Data
launcher :: Item
launcher =
rLauncher :: Item
rLauncher =
defaultHeldItem
& itUse . heldDelay . rateMax .~ 20
& itUse . heldAim . aimWeight .~ 8
& itUse . heldAim . aimRange .~ 0.5
& itUse . heldAim . aimStance .~ TwoHandOver
& itUse . heldAim . aimMuzzles . ix 0 . mzInaccuracy .~ 0
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleLauncher
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleRLauncher
& itUse . heldAim . aimMuzzles . ix 0 . mzPos .~ V2 20 0
& itAmmoSlots .~ singleAmmo LauncherAmmo
& itType .~ HELD LAUNCHER
& itType .~ HELD RLAUNCHER
& itUse . heldParams . muzVel .~ ConstFloat 0
& itUse . heldParams . rifling .~ ConstFloat 0
& itUse . heldParams . recoil .~ 0
& itUse . heldParams . torqueAfter .~ 0
& itUse . heldParams . bulGunSound ?~ (tap4S, 0)
launcherX :: Int -> Item
launcherX i =
launcher
& itType .~ HELD (LAUNCHERX i)
gLauncher :: Item
gLauncher = rLauncher
& itType .~ HELD GLAUNCHER
& itUse . heldAim . aimMuzzles . ix 0 . mzEffect .~ MuzzleGLauncher
rLauncherX :: Int -> Item
rLauncherX i =
rLauncher
& itType .~ HELD (RLAUNCHERX i)
& itUse . heldAim . aimMuzzles .~ getZipList
(ZipList [Muzzle (V2 20 0) a 0 | a <- angles]
<*> ZipList [0..]
<*> pure NoFlare
<*> pure MuzzleLauncher
<*> pure MuzzleRLauncher
<*> pure (UseExactly 1)
<*> pure 0
)
src/Dodge/Item/Info.hs
+3 -2
View File
@@ -80,8 +80,9 @@ heldInfo hit = case hit of
TESLAGUN -> "A weapon that discharges a sustained arc of electricity. The arc will attempt to discharge at a nearby object."
LASER -> "A device that, when electrically powered, continuously emits photons in a narrow beam."
TRACTORGUN -> "An item that produces a beam of gravitons."
LAUNCHER -> "A large tube that can launch self propelled projectiles. Moving the tube after launch will cause the projectile to spin."
LAUNCHERX i -> over _head toUpper (showInt i) ++ " tubes that can launch self propelled projectiles. Tubes that do not face forward launch their projecitles at an angle."
GLAUNCHER -> "A large tube that can launch projectiles."
RLAUNCHER -> "A large tube that can launch self propelled projectiles. Moving the tube after launch will cause the projectile to spin."
RLAUNCHERX i -> over _head toUpper (showInt i) ++ " tubes that can launch self propelled projectiles. Tubes that do not face forward launch their projecitles at an angle."
-- REMOTELAUNCHER -> "A large tube that can launch self propelled projectiles. Contains a transmitter allowing for remote control of launched projectiles."
POISONSPRAYER -> "A weapon that releases noxious gases."
SHATTERGUN -> "A seismic device that shatters hard items in its line of fire."
src/Dodge/Item/InvSize.hs
+4 -3
View File
@@ -11,8 +11,9 @@ import Linear.V3
itInvHeight :: Item -> Int
itInvHeight x = case x ^. itType of
HELD (MINIGUNX i) -> (i + 3) `div` 2
HELD LAUNCHER -> 3
HELD LAUNCHERX{} -> 3
HELD GLAUNCHER -> 2
HELD RLAUNCHER -> 3
HELD RLAUNCHERX{} -> 3
HELD FLATSHIELD -> 3
HELD (BANGSTICK i) -> max 1 (i `div` 2)
_ -> 1
@@ -31,7 +32,7 @@ itDim x = case x ^. itType of
HELD MINIGUNX {} -> did & dimRad .~ 20
& dimCenter .~ V3 5 0 0
& dimAttachPos .~ V3 5 (-5) 0
HELD LAUNCHER -> did & dimRad .~ 9
HELD RLAUNCHER -> did & dimRad .~ 9
& dimCenter .~ V3 10 0 0
HELD BANGSTICK{} -> did
& dimRad .~ 5
src/Dodge/LockAndKey.hs
+2 -2
View File
@@ -24,7 +24,7 @@ lockRoomMultiItems =
lockRoomKeyItems :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
lockRoomKeyItems =
[ (lasCenSensEdge, takeOne [HELD LAUNCHER, HELD LASER, HELD SPARKGUN, HELD FLATSHIELD])
[ (lasCenSensEdge, takeOne [HELD RLAUNCHER, HELD LASER, HELD SPARKGUN, HELD FLATSHIELD])
, (sensorRoomRunPast LASERING, return $ HELD LASER)
, (const slowDoorRoomRunPast, return $ HELD (MINIGUNX 3))
, (const longRoomRunPast, takeOne [HELD SNIPERRIFLE, HELD FLATSHIELD])
@@ -39,7 +39,7 @@ keyCardRunPastRand = [(keyCardRoomRunPast 0, return (HELD $ KEYCARD 0))]
itemRooms :: RandomGen g => [(ItemType, State g (MetaTree Room String))]
itemRooms =
[
( HELD LAUNCHER
( HELD RLAUNCHER
, join $
takeOne
[ corridorBoss launcherCrit
src/Dodge/Projectile/Create.hs
+50 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Projectile.Create (
createShell,
createGShell,
) where
import NewInt
@@ -30,7 +31,7 @@ createShell homing mdetonator mscreen payload muz cr w = w
?~ Shell
{ _prjPos = pos
, _prjZ = 20
, _prjStartPos = pos
, _prjZVel = 0
, _prjVel = rotateV dir (V2 1 0) + cr ^. crPos - cr ^. crOldPos
, _prjDraw = homingDrawType homing
, _prjID = i
@@ -65,3 +66,51 @@ createShell homing mdetonator mscreen payload muz cr w = w
i = IM.newKey $ w ^. cWorld . lWorld . projectiles
dir = _crDir cr + _mzRot muz
pos = _crPos cr +.+ rotateV dir (_mzPos muz)
-- assumes the mscreen is in your inventory
createGShell :: ProjectileHoming
-> Maybe (NewInt ItmInt)
-> Maybe (NewInt ItmInt)
-> Payload -> Muzzle -> Creature -> World -> World
createGShell homing mdetonator mscreen payload muz cr w = w
& updatescreen
& updatedetonator
& cWorld . lWorld . projectiles . at i
?~ Shell
{ _prjPos = pos
, _prjZ = 20
, _prjZVel = 5
, _prjVel = rotateV dir (V2 4 0) + cr ^. crPos - cr ^. crOldPos
, _prjDraw = homingDrawType homing
, _prjID = i
, _prjAcc = rotateV dir (V2 3 0)
, _prjDir = dir
, _prjSpin = 0
, _prjPayload = payload
, _prjTimer = 350
, _prjUpdates =
[ CollisionEffectPU (homing ^? phRemoteID) mdetonator mscreen
, TimePU
, StartSpinPU 335 (_crID cr) spinamount
, RemoteDirectionPU (350 - thrustdelay) 0 homing
, ReduceSpinPU (1 - spindrag * 2 / 200)
, ApplyGravityPU
]
}
where
spindrag = 1
spinamount = 2
thrustdelay = 20
updatedetonator = fromMaybe id $ do
screenid <- mdetonator
return $ pointerToItemID screenid . itUse . uaParams
. apLinkedProjectile
?~ i
updatescreen = fromMaybe id $ do
screenid <- homing ^? phRemoteID
return $ pointerToItemID screenid . itUse . uaParams
. apLinkedProjectile
?~ i
i = IM.newKey $ w ^. cWorld . lWorld . projectiles
dir = _crDir cr + _mzRot muz
pos = _crPos cr +.+ rotateV dir (_mzPos muz)
src/Dodge/Projectile/Draw.hs
+1 -1
View File
@@ -20,7 +20,7 @@ drawProjectile prj = case _prjDraw prj of
drawShell :: Projectile -> SPic
drawShell pj =
noPic
. translateSHz 18
. translateSHz (_prjZ pj)
. uncurryV translateSHxy (_prjPos pj)
$ rotateSH (argV $ _prjAcc pj) shellShape
src/Dodge/Projectile/Update.hs
+29 -3
View File
@@ -3,7 +3,7 @@ module Dodge.Projectile.Update (
updateProjectile,
) where
import Control.Lens
import LensHelp
import Control.Monad
import Data.Foldable
import Data.Maybe
@@ -42,18 +42,44 @@ upProjectile pu pj = case pu of
-- the following requires that this is at the top of the update list, which is
-- not ideal
DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_prjID pj) . prjUpdates . ix 0 . pjuTimer -~ 1
ApplyGravityPU -> applyGravityPU pj
where
time = _prjTimer pj
act st et = time <= st && time >= et
applyGravityPU :: Projectile -> World -> World
applyGravityPU pj w
| newz <= 0 && abs (pj ^. prjZVel) < 1 = w
& topj . prjVel %~ decvel
& topj . prjSpin %~ decspin
| newz < 0 = w & topj . prjZ .~ 0
& topj . prjZVel %~ bouncez
& topj . prjVel %~ decvel
& topj . prjSpin %~ decspin
& soundStart (ShellSound (pj ^. prjID)) (pj ^. prjPos) click1S Nothing
| otherwise = w & topj . prjZ .~ newz
& topj . prjZVel -~ 0.5
where
topj = cWorld . lWorld . projectiles . ix (pj ^. prjID)
bouncez z | z < -1 = -0.5 * z
| otherwise = 0
decvel v
| magV v > 1 = rotateV (5 * pj ^. prjSpin) $ 0.8 * v
| otherwise = 0
decspin x
| abs x < 0.01 = 0
| otherwise = x * 0.9
newz = pj ^. prjZ + pj ^. prjZVel
--shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
shellCollisionCheck :: Maybe (NewInt ItmInt)
-> Maybe (NewInt ItmInt)
-> Maybe (NewInt ItmInt)
-> Projectile -> World -> World
shellCollisionCheck controlid detid screenid pj w
| time > 330 && circOnSomeWall oldPos 4 w = g
| time <= 330 && anythingHitCirc 2 oldPos newPos w = g
-- | time > 330 && circOnSomeWall oldPos 4 w = g
-- | time <= 330 && anythingHitCirc 2 oldPos newPos w = g
| anythingHitCirc 2 oldPos newPos w = g
| time <= 0 = g
| otherwise = w
where
src/Dodge/Render/HUD.hs
+11 -8
View File
@@ -4,7 +4,6 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.Item.InvSize
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -29,6 +28,7 @@ import Dodge.Inventory
import Dodge.Item.Display
import Dodge.Item.Grammar
import Dodge.Item.Info
import Dodge.Item.InvSize
import Dodge.ListDisplayParams
import Dodge.Render.Connectors
import Dodge.Render.HUD.Carte
@@ -355,12 +355,13 @@ drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
return $
invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
<> drawSelectionList secondColumnParams cfig (thesellist tm)
<> color (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
(drawSelectionListBackground secondColumnParams cfig tsize)
<> color
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
(drawSelectionListBackground secondColumnParams cfig tsize)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where
toselitm (str, col) = SelectionItem [str] 1 55 True col 0 ()
-- not sure if the width (55) is correct here
-- not sure if the width (55) is correct here
thesellist tm = thelist tm
thelist tm =
map toselitm . displayTermInput tm
@@ -470,15 +471,17 @@ selNumPosCardinal ::
Maybe Point2
selNumPosCardinal card cfig ldp sss i j = do
ipos <- selSecYint i j sss
-- size <- selSecSelSize i j sss
-- size <- selSecSelSize i j sss
ysize <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siHeight
xsize <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siWidth
itmindent <- fromIntegral <$> sss ^? ix i . ssItems . ix j . siOffX
sindent <- fromIntegral <$> sss ^? ix i . ssIndent
let indent = itmindent + sindent
let offset = cardEightVec card * V2
(xsize * 0.5 * 10 * s)
(ysize * 0.5 * 20 * s)
let offset =
cardEightVec card
* V2
(xsize * 0.5 * 10 * s)
(ysize * 0.5 * 20 * s)
return $
screenPosAbs cfig (ldp ^. ldpPos)
+ offset
src/Dodge/Room/Start.hs
+1 -1
View File
@@ -30,7 +30,7 @@ powerFakeout = do
it <-
takeOne
[ miniGunX 6
, launcherX 7
, rLauncherX 7
]
roomwithmini <- pedestalRoom it
randcors <- replicateM ncor $ shuffleLinks corridor
src/Dodge/TestString.hs
+4 -2
View File
@@ -26,8 +26,10 @@ import qualified IntMapHelp as IM
import qualified Data.Map.Strict as M
testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^. uvDebugFloat1
, show $ u ^. uvWorld . input . heldWorldPos . at SDL.ButtonRight]
testStringInit u =
[show (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos)]
<>
(map show $ u ^.. uvWorld . cWorld . lWorld . projectiles . each . prjPos)
--testStringInit u = foldMap prettyShort $ u ^. uvWorld . cWorld . lWorld . projectiles
-- (map (show . _ebPos) $ u ^. uvWorld . cWorld . lWorld . energyBalls)
-- <>
src/Dodge/Update/Input/DebugTest.hs
+37 -2
View File
@@ -3,8 +3,16 @@ module Dodge.Update.Input.DebugTest (
doDebugTest2,
doDebugTestF6,
doDebugTestF7,
doDebugTestF8,
doDebugTestF10,
doDebugTestF11,
doDebugTestF12,
) where
import Text.Read
import System.Clipboard
import Data.Aeson
import AesonHelp
import Control.Lens
import Data.Maybe
import Dodge.Base.Collide
@@ -31,8 +39,10 @@ doDebugTest2 = uvDebugFloat1 .~ 20
doDebugTestF6 :: Universe -> Universe
doDebugTestF6 = uvIOEffects %~ \f u -> do
writeFile "log/heldL" $ show $ u ^. uvWorld . input . heldWorldPos . at ButtonLeft
writeFile "log/heldR" $ show $ u ^. uvWorld . input . heldWorldPos . at ButtonRight
Just ss <- decodeFileStrict "saveSlot/QuickSave"
writeFile "log/prettyQuickSave" ""
mapM_ (\s -> appendFile "log/prettyQuickSave" (s ++ "\n")) $ prettyShort (ss :: CWorld)
putStrLn "log/prettyQuickSave written"
f u
doDebugTestF7 :: Universe -> Universe
@@ -43,3 +53,28 @@ doDebugTestF7 = uvIOEffects %~ \f u -> do
& uvWorld . input . heldWorldPos . at ButtonLeft .~ read l
& uvWorld . input . heldWorldPos . at ButtonRight .~ read r
doDebugTestF8 :: Universe -> Universe
doDebugTestF8 = uvIOEffects %~ \f u -> do
appendFile "log/proj" $ show
(u ^?! uvWorld . cWorld . lWorld . projectiles . ix 5 . prjPos) ++ "/n"
putStrLn "log/proj written"
f u
doDebugTestF10 :: Universe -> Universe
doDebugTestF10 = uvIOEffects %~ \f u -> do
writeFile "log/proj" ""
putStrLn "log/proj cleared"
f u
doDebugTestF11 :: Universe -> Universe
doDebugTestF11 = uvIOEffects %~ \f u -> do
x <- getClipboardString
case x >>= readMaybe of
Nothing -> do
putStrLn "read fail"
f u
Just p -> f $ u
& uvWorld . input . heldWorldPos . at ButtonLeft
.~ (u ^. uvWorld . input . heldWorldPos . at ButtonRight)
& uvWorld . input . heldWorldPos . at ButtonRight ?~ p
doDebugTestF12 :: Universe -> Universe
doDebugTestF12 = id
src/Dodge/Update/Input/InGame.hs
+4
View File
@@ -352,6 +352,10 @@ updateFunctionKey uv sc InitialPress = case sc of
ScancodeF9 -> doQuickload uv
ScancodeF6 -> doDebugTestF6 uv
ScancodeF7 -> doDebugTestF7 uv
ScancodeF8 -> doDebugTestF8 uv
ScancodeF10 -> doDebugTestF10 uv
ScancodeF11 -> doDebugTestF11 uv
ScancodeF12 -> doDebugTestF12 uv
ScancodeEscape -> pauseGame uv
_ -> uv
updateFunctionKey uv ScancodeF3 _ = doDebugTest uv
src/Geometry/Intersect.hs
+8
View File
@@ -300,6 +300,7 @@ inSegArea a b c = param >= 0 && param <= dotV (b -.- a) (b -.- a)
where
param = dotV (b -.- a) (c -.- a)
-- I suspect that this may not be correct...
intersectCircSeg :: Point2 -> Float -> Point2 -> Point2 -> [Point2]
intersectCircSeg c r a b
| y < 0 = []
@@ -311,5 +312,12 @@ intersectCircSeg c r a b
z = sqrt y
v = z *.* normalizeV (b -.- a)
intersectCircSegTest :: Point2 -> Float -> Point2 -> Point2 -> Bool
intersectCircSegTest c r x y = intersectSegSegTest (c + z) (c - z) x y
|| dist c x <= r
|| dist c y <= r
where
z = r *.* vNormal (normalizeV x - y)
intersectCircSegFirst :: Point2 -> Float -> Point2 -> Point2 -> Maybe Point2
intersectCircSegFirst c r a = listToMaybe . intersectCircSeg c r a
tags
+283 -266
View File
File diff suppressed because it is too large Load Diff