Replace buggy circle seg intersection with a simpler test

data/dodge.config.json

@@ -1,8 +1,7 @@
 {
   "_debug_booleans": [
     "Show_ms_frame",
-    "Circ_collision_test",
+    "Circ_collision_test"
-    "Show_walls_near_segment"
   ],
   "_debug_view_clip_bounds": "NoRoomClipBoundaries",
   "_gameplay_rotate_to_wall": true,

graph/itemCombinations.gv

@@ -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

src/Dodge/Base/Collide.hs

@@ -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)
+circHitWall sp ep r w = any (uncurry (intersectSegSegTest xsp xep) . _wlLine)
-        (wlsNearSeg sp ep w)
+        (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

@@ -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 $ cr HARDWARE] rLauncher
-           , p [p 2 $ cr TUBE, o $ HELD LAUNCHER] (launcherX 2)
+           , 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

@@ -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

@@ -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
+    , rLauncher
-    , megaShellMag
     , megaShellMag
+    , gLauncher
     , megaShellMag
     , pipe
     , timeScroller

src/Dodge/Creature/LauncherCrit.hs

@@ -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

@@ -148,8 +148,9 @@ data HeldItemType
     | TESLAGUN
     | LASER
     | TRACTORGUN
-    | LAUNCHER
+    | RLAUNCHER
-    | LAUNCHERX {_xNum :: Int}
+    | RLAUNCHERX {_xNum :: Int}
+    | GLAUNCHER
     | POISONSPRAYER
     | SHATTERGUN
     | TORCH

src/Dodge/Data/Item/Use.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -237,8 +237,9 @@ heldItemSPic ht it = case ht of
     TESLAGUN -> teslaGunPic
     LASER -> lasGunPic it
     TRACTORGUN -> tractorGunPic it
-    LAUNCHER -> launcherPic it
+    RLAUNCHER -> rlauncherPic it
-    LAUNCHERX _ -> launcherPic 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
+rlauncherPic :: Item -> SPic
-launcherPic _ = noPic . colorSH cyan $ xCylinderST 5 20
+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

@@ -65,9 +65,9 @@ itemFromHeldType ht = case ht of
 --    DUALBEAM -> dualBeam
 --    LASWIDE i -> lasWide i
     TRACTORGUN -> tractorGun
-    LAUNCHER -> launcher
+    RLAUNCHER -> rLauncher
-    LAUNCHERX i -> launcherX i
+    GLAUNCHER -> gLauncher
---    REMOTELAUNCHER -> remoteLauncher
+    RLAUNCHERX i -> rLauncherX i
     POISONSPRAYER -> poisonSprayer
     DETECTOR d -> detector d
     FLATSHIELD -> flatShield

src/Dodge/Item/Held/Launcher.hs

@@ -9,32 +9,38 @@ import Dodge.Data.Item
 import qualified IntMapHelp as IM
 import Geometry.Data
 
-launcher :: Item
+rLauncher :: Item
-launcher =
+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
+gLauncher :: Item
-launcherX i =
+gLauncher = rLauncher
-    launcher
+        & itType .~ HELD GLAUNCHER
-        & itType .~ HELD (LAUNCHERX i)
+        & 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

@@ -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."
+    GLAUNCHER -> "A large tube that can launch projectiles."
-    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."
+    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

@@ -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 GLAUNCHER -> 2
-    HELD LAUNCHERX{} -> 3
+    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

@@ -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

@@ -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

@@ -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

@@ -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 && circOnSomeWall oldPos 4 w = g
-    | time <= 330 && anythingHitCirc 2 oldPos newPos 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

@@ -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
+            <> color
-                    (drawSelectionListBackground secondColumnParams cfig tsize)
+                (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
+    let offset =
-            (xsize * 0.5 * 10 * s) 
+            cardEightVec card
-            (ysize * 0.5 * 20 * s)
+                * V2
+                    (xsize * 0.5 * 10 * s)
+                    (ysize * 0.5 * 20 * s)
     return $
         screenPosAbs cfig (ldp ^. ldpPos)
             + offset

src/Dodge/Room/Start.hs

@@ -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

@@ -26,8 +26,10 @@ import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^. uvDebugFloat1
+testStringInit u = 
-    , show $ u ^. uvWorld . input . heldWorldPos . at SDL.ButtonRight]
+    [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

@@ -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
+    Just ss <- decodeFileStrict "saveSlot/QuickSave"
-    writeFile "log/heldR" $ show $ u ^. uvWorld . input . heldWorldPos . at ButtonRight
+    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

@@ -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

@@ -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