Replace buggy circle seg intersection with a simpler test

2024-12-26 21:53:18 +00:00
parent 91ba6ee148
commit 0ef28c132e
29 changed files with 528 additions and 332 deletions
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -148,8 +148,9 @@ data HeldItemType
    | TESLAGUN
    | LASER
    | TRACTORGUN
-    | LAUNCHER
-    | LAUNCHERX {_xNum :: Int}
+    | RLAUNCHER
+    | RLAUNCHERX {_xNum :: Int}
+    | GLAUNCHER
    | POISONSPRAYER
    | SHATTERGUN
    | TORCH
@@ -140,7 +140,8 @@ data MuzzleEffect
    | MuzzleLaser
    | MuzzleTesla
    | MuzzleTractor
-    | MuzzleLauncher
+    | MuzzleRLauncher
+    | MuzzleGLauncher
    | MuzzleNozzle
        { _nzPressure :: GenFloat
        , _nzMaxWalkAngle :: Float
@@ -37,6 +37,7 @@ data ProjectileUpdate
        ,_pjuDetonatorID :: Maybe (NewInt ItmInt)
        ,_pjuScreenID :: Maybe (NewInt ItmInt)
        }
+    | ApplyGravityPU
    deriving (Show, Eq, Ord, Read) --Generic, Flat)

 data AmmoType
@@ -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)
@@ -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
@@ -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 $
@@ -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
@@ -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
            )
@@ -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."
@@ -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
@@ -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
@@ -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)
@@ -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

@@ -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
@@ -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
@@ -30,7 +30,7 @@ powerFakeout = do
    it <-
        takeOne
            [ miniGunX 6
-            , launcherX 7
+            , rLauncherX 7
            ]
    roomwithmini <- pedestalRoom it
    randcors <- replicateM ncor $ shuffleLinks corridor
@@ -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)
 --    <>
@@ -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
@@ -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
@@ -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