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

Commit before attempting to allow for non-convex chasm shapes

Browse Source
This commit is contained in:
justin
2025-10-05 15:06:19 +01:00
parent b3924fb8b8
commit 43db5a2ebc
25 changed files with 333 additions and 303 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/BaseTriggerType.hs
+1 -1
View File
@@ -62,7 +62,7 @@ heldTriggerType = \case
GLAUNCHER -> SemiAutoTrigger 20
POISONSPRAYER -> NoTrigger
SHATTERGUN -> SemiAutoTrigger 20
TORCH -> NoTrigger
LED -> NoTrigger
FLATSHIELD -> NoTrigger
KEYCARD{} -> NoTrigger
BLINKER -> SemiAutoTrigger 20
src/Dodge/Combine/Combinations.hs
+2 -2
View File
@@ -108,8 +108,8 @@ itemCombinations =
, po [cr MICROCHIP, cr TRANSMITTER, cr LIGHTSENSOR] (detector ITEMDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr SOUNDSENSOR] (detector WALLDETECTOR)
, po [cr MICROCHIP, cr TRANSMITTER, cr HEATSENSOR] (detector CREATUREDETECTOR)
, po [AMMOMAG BATTERY, cr LED] torch
, po [hd TORCH, eq HAT] headLamp
-- , po [AMMOMAG BATTERY, cr LED] torch
, po [hd LED, eq HAT] headLamp
-- , po [cr LIGHTER, cr THERMOMETER, cr MICROCHIP] (energyBallCraft IncBall)
-- , po [cr TRANSFORMER, AMMOMAG BATTERY, cr MICROCHIP] (energyBallCraft TeslaBall)
]
src/Dodge/Creature.hs
+1 -1
View File
@@ -319,7 +319,7 @@ stackedInventory =
, megaBattery
, gLauncher
, megaShellMag
, torch
, led
, magShield MagnetRepulse
, bangCone
, megaTinMag 1000
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -78,7 +78,7 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
LASER | loc ^. locDT . dtValue . _2 == WeaponTargetingSF
, itm ^? itLocation . ilIsAttached == Just True -> shineTargetLaser cr loc w
HELD TORCH
HELD LED
| itm ^? itLocation . ilIsAttached == Just True -> shineTorch cr loc w
TARGETING tt
| itm ^? itLocation . ilIsAttached == Just True -> updateItemTargeting tt cr itm w
src/Dodge/Creature/Statistics.hs
+1 -1
View File
@@ -114,7 +114,7 @@ heldItemWeight = \case
GLAUNCHER -> 10
POISONSPRAYER -> 10
SHATTERGUN -> 10
TORCH -> 5
LED -> 5
FLATSHIELD -> 15
KEYCARD {} -> 5
BLINKER -> 5
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -227,7 +227,7 @@ heldItemBulkiness = \case
GLAUNCHER -> 1
POISONSPRAYER -> 1
SHATTERGUN -> 1
TORCH -> 1
LED -> 1
FLATSHIELD -> 0.5
KEYCARD{} -> 1
BLINKER -> 1
src/Dodge/Data/Config.hs
+21 -21
View File
@@ -12,27 +12,27 @@ import qualified Data.Set as S
{-# ANN module "HLint: ignore Use camelCase" #-}
data NumShadowCasters
= NumShadowCasters0
| NumShadowCasters1
| NumShadowCasters2
| NumShadowCasters3
| NumShadowCasters4
| NumShadowCasters5
| NumShadowCasters6
| NumShadowCasters7
| NumShadowCasters8
| NumShadowCasters9
| NumShadowCasters10
| NumShadowCasters11
| NumShadowCasters12
| NumShadowCasters13
| NumShadowCasters14
| NumShadowCasters15
| NumShadowCasters16
| NumShadowCasters17
| NumShadowCasters18
| NumShadowCasters19
| NumShadowCasters20
= NumLight0
| NumLight1
| NumLight2
| NumLight3
| NumLight4
| NumLight5
| NumLight6
| NumLight7
| NumLight8
| NumLight9
| NumLight10
| NumLight11
| NumLight12
| NumLight13
| NumLight14
| NumLight15
| NumLight16
| NumLight17
| NumLight18
| NumLight19
| NumLight20
deriving (Show,Eq,Bounded,Ord,Enum)
data Config = Config
src/Dodge/Data/Item/Combine.hs
+1 -2
View File
@@ -75,7 +75,6 @@ data CraftType
| AIUNIT
| CAMERA
| MINIDISPLAY -- visual display unit
| LED
| NAILBOX
| IRONBAR
| LIGHTSENSOR
@@ -173,7 +172,7 @@ data HeldItemType
| GLAUNCHER
| POISONSPRAYER
| SHATTERGUN
| TORCH
| LED
| FLATSHIELD
| KEYCARD Int
| BLINKER
src/Dodge/Debug/Picture.hs
+1 -1
View File
@@ -95,7 +95,7 @@ extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [
intersectLinefromScreen :: Config -> World -> Point2 -> Point2 -> Maybe Point2
intersectLinefromScreen cfig w a b =
listToMaybe
. mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
. mapMaybe (\(x, y) -> intersectSegRay x y b (b +.+ b -.- a))
. loopPairs
$ screenPolygon cfig (w ^. wCam)
src/Dodge/HeldUse.hs
+8 -8
View File
@@ -235,7 +235,7 @@ heldItemMuzzles itm = \case
BANGCONE -> [Muzzle (V2 15 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet 12]
BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet 12]
GRAPECANNON i -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet (12 + 4 * fromIntegral i)]
TORCH -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0
LED -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0
FLAMETHROWER -> flameMuzzles
FLAMESPITTER -> flameMuzzles & ix 0 . mzEffect . nzPressure .~ UniRandFloat 3 4
RLAUNCHER ->
@@ -411,7 +411,7 @@ itemSidePush = \case
GLAUNCHER -> 0
POISONSPRAYER -> 0
SHATTERGUN -> 0
TORCH -> 0
LED -> 0
FLATSHIELD -> 0
KEYCARD{} -> 0
BLINKER -> 0
@@ -494,7 +494,7 @@ recoilAmount itm
GLAUNCHER -> 0
POISONSPRAYER -> 0
SHATTERGUN -> 0
TORCH -> 0
LED -> 0
FLATSHIELD -> 0
KEYCARD _ -> 0
BLINKER -> 0
@@ -541,7 +541,7 @@ bgunSound itm
GLAUNCHER -> Just (tap4S, 0)
POISONSPRAYER -> Just (foamSprayLoopS, 5)
SHATTERGUN -> Nothing
TORCH -> Nothing
LED -> Nothing
FLATSHIELD -> Nothing
KEYCARD _ -> Nothing
BLINKER -> Nothing
@@ -612,7 +612,7 @@ heldTorqueAmount = \case
GLAUNCHER -> 0
POISONSPRAYER -> 0
SHATTERGUN -> 0
TORCH -> 0
LED -> 0
FLATSHIELD -> 0
KEYCARD{} -> 0
BLINKER -> 0
@@ -1055,7 +1055,7 @@ heldItemMuzVel = \case
GLAUNCHER -> ConstFloat 0
POISONSPRAYER -> ConstFloat 0.8
SHATTERGUN -> ConstFloat 0.8
TORCH -> ConstFloat 0.8
LED -> ConstFloat 0.8
FLATSHIELD -> ConstFloat 0
KEYCARD{} -> ConstFloat 0.8
BLINKER -> ConstFloat 0.8
@@ -1098,7 +1098,7 @@ heldItemRifling = \case
GLAUNCHER -> ConstFloat 0
POISONSPRAYER -> ConstFloat 0.8
SHATTERGUN -> ConstFloat 0.8
TORCH -> ConstFloat 0.8
LED -> ConstFloat 0.8
FLATSHIELD -> ConstFloat 0.8
KEYCARD{} -> ConstFloat 0.8
BLINKER -> ConstFloat 0.8
@@ -1175,7 +1175,7 @@ gasType hit _ = case hit of
GLAUNCHER -> Nothing
POISONSPRAYER -> Just CreatePoisonGas
SHATTERGUN -> Nothing
TORCH -> Nothing
LED -> Nothing
FLATSHIELD -> Nothing
KEYCARD{} -> Nothing
BLINKER -> Nothing
src/Dodge/Item/AimStance.hs
+1 -1
View File
@@ -58,7 +58,7 @@ heldAimStance = \case
GLAUNCHER -> TwoHandUnder
POISONSPRAYER -> TwoHandUnder
SHATTERGUN -> TwoHandUnder
TORCH -> OneHand
LED -> OneHand
FLATSHIELD -> TwoHandFlat
KEYCARD {} -> OneHand
BLINKER -> OneHand
src/Dodge/Item/AmmoSlots.hs
+1 -1
View File
@@ -47,7 +47,7 @@ heldItemAmmoSlots = \case
SPARKGUN -> singleAmmo ElectricalAmmo
TRACTORGUN -> singleAmmo ElectricalAmmo
SHATTERGUN -> singleAmmo ElectricalAmmo
TORCH -> singleAmmo ElectricalAmmo
LED -> singleAmmo ElectricalAmmo
BLINKERUNSAFE -> singleAmmo ElectricalAmmo
BLINKER -> singleAmmo ElectricalAmmo
RLAUNCHER -> singleAmmo LauncherAmmo
src/Dodge/Item/Draw/SPic.hs
+15 -14
View File
@@ -106,7 +106,6 @@ craftItemSPic = \case
colorSH green $
upperPrismPolyST 1 (square 4)
<> upperPrismPolyST 2 (rectNSWE 4 (-4) 3 4)
LED -> colorSH yellow $ upperPrismPolyST 1 (square 2)
NAILBOX -> colorSH green $ upperPrismPolyST 3 (rectXH 4 3)
IRONBAR -> colorSH (greyN 0.5) $ upperPrismPolyST 3 $ rectXH 8 2
LIGHTSENSOR ->
@@ -250,7 +249,7 @@ backpackShape = upperPrismPolyMT 10 $ rectNSWE 5 (-5) (-4) 4
heldItemSPic :: HeldItemType -> Item -> SPic
heldItemSPic ht it = case ht of
FLATSHIELD -> flatShieldEquipSPic
TORCH -> noPic torchShape
LED -> noPic torchShape
BANGSTICK i -> noPic $ baseStickShapeX it i -- <> addBullets it
PISTOL -> noPic baseStickShape
MACHINEPISTOL -> noPic baseStickShape
@@ -291,18 +290,20 @@ heldItemSPic ht it = case ht of
KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic)
torchShape :: Shape
torchShape =
colorSH blue $
translateSHxy 0 1.5 side
<> translateSHxy 0 (-1.5) side
<> translateSHz 2.5 top
<> translateSHz (-0.5) bot
<> back
where
side = upperPrismPolySE 3 $ rectXH 10 0.5
top = upperPrismPolySE 0.5 $ rectXH 10 2
bot = upperPrismPolySE 0.5 $ rectXH 9 2
back = upperPrismPolySE 3 $ rectXH 1 2
torchShape = colorSH blue $ upperPrismPolySE 3 $ rectWH 3 3
-- side = upperPrismPolySE 3 $ rectXH 10 0.5
-- colorSH blue $
-- translateSHxy 0 1.5 side
-- <> translateSHxy 0 (-1.5) side
-- <> translateSHz 2.5 top
-- <> translateSHz (-0.5) bot
-- <> back
-- where
-- side = upperPrismPolySE 3 $ rectXH 10 0.5
-- top = upperPrismPolySE 0.5 $ rectXH 10 2
-- bot = upperPrismPolySE 0.5 $ rectXH 9 2
-- back = upperPrismPolySE 3 $ rectXH 1 2
baseStickShapeX :: Item -> Int -> Shape
baseStickShapeX _ _ = mempty
src/Dodge/Item/Grammar.hs
+2 -2
View File
@@ -53,7 +53,7 @@ itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
(LASER, LaserWeaponSF) -> [PulseBallSF] <> getAmmoLinks itm
(LASER, PulseBallSF) -> [PulseBallSF]
--(HELD LASER, _) -> [PulseBallSF]
(HELD TORCH, _) -> getAmmoLinks itm
(HELD LED, _) -> getAmmoLinks itm
(ATTACH CAPACITOR, _) -> [AmmoMagSF 0 ElectricalAmmo]
(ATTACH UNDERBARRELSLOT, _) -> [UnderBarrelPlatformSF]
(_, HeldPlatformSF) -> getAmmoLinks itm <> extraWeaponLinksBelow itm
@@ -111,7 +111,7 @@ itemToFunction itm = case itm ^. itType of
ITEMSCAN -> ToggleSF
INTROSCAN {} -> IntroScanSF
LASER -> WeaponTargetingSF
HELD TORCH -> TorchSF
HELD LED -> TorchSF
HELD{} -> case itUseCondition itm of
UseableWhenAimed -> HeldPlatformSF
_ -> GadgetPlatformSF
src/Dodge/Item/Held.hs
+1 -1
View File
@@ -30,7 +30,7 @@ itemFromHeldType ht = case ht of
BLINKERUNSAFE -> unsafeBlinker
BLINKER -> blinker
KEYCARD i -> keyCard i
TORCH -> torch
LED -> led
SHATTERGUN -> shatterGun
BANGSTICK i -> bangStick i
PISTOL -> pistol
src/Dodge/Item/Held/Utility.hs
+3 -3
View File
@@ -5,7 +5,7 @@ module Dodge.Item.Held.Utility (
unsafeBlinker,
blinker,
keyCard,
torch,
led,
detector,
flatShield,
) where
@@ -20,8 +20,8 @@ flatShield = defaultHeldItem & itType .~ HELD FLATSHIELD
keyCard :: Int -> Item
keyCard n = defaultHeldItem & itType .~ HELD (KEYCARD n)
torch :: Item
torch = defaultHeldItem & itType .~ HELD TORCH
led :: Item
led = defaultHeldItem & itType .~ HELD LED
-- | Sends out pulses that display walls.
detector :: Detector -> Item
src/Dodge/Item/HeldOffset.hs
+1 -1
View File
@@ -124,7 +124,7 @@ heldHandlePos = \case
GLAUNCHER -> V2 3 0
POISONSPRAYER -> V2 3 0
SHATTERGUN -> V2 3 0
TORCH -> V2 3 0
LED -> V2 3 0
FLATSHIELD -> V2 3 0
KEYCARD{} -> V2 3 0
BLINKER -> V2 3 0
src/Dodge/Item/Info.hs
+1 -2
View File
@@ -131,7 +131,7 @@ heldInfo hit = case hit of
POISONSPRAYER -> "A weapon that releases noxious gases."
SHATTERGUN -> "A seismic device that shatters hard items in its line of fire."
-- FORCEFIELDGUN -> "A device that produces a durable forcefield."
TORCH -> "A stick with a light on the end."
LED -> "A light emitting diode."
FLATSHIELD -> "A panel of metal that blocks unwanted objects from the front of the user."
KEYCARD i -> "A keycard. It is labelled " ++ show i ++ "."
TIMESTOPPER -> "A device that temporarily pauses time."
@@ -196,7 +196,6 @@ craftInfo fit = case fit of
AIUNIT -> "A general purpose artificial intelligence unit."
CAMERA -> "A device designed to capture light signals."
MINIDISPLAY -> "A device designed to display pictures."
LED -> "A light emitting diode."
NAILBOX -> "A box of wood fastenings."
IRONBAR -> "A rigid piece of metal."
LIGHTSENSOR -> "A device that detects photons."
src/Dodge/Item/Orientation.hs
+1 -1
View File
@@ -12,7 +12,7 @@ import qualified Quaternion as Q
orientChild :: Item -> Point3Q
orientChild itm = case _itType itm of
HELD TORCH -> (V3 0 5 0, Q.qID)
HELD LED -> (V3 0 5 0, Q.qID)
--HELD LASER -> (V3 15 (-5) 0, Q.qID)
LASER -> (V3 15 (-5) 0, Q.qID)
ATTACH UNDERBARRELSLOT -> (V3 10 (-8) 0, r)
src/Dodge/Room/Tutorial.hs
+2 -1
View File
@@ -1,5 +1,6 @@
module Dodge.Room.Tutorial where
import Dodge.Item.Held.Utility
import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
@@ -241,7 +242,7 @@ tutHub = do
return $
tToBTree "DoorTest" $
Node
x
(x & rmPmnts .:~ sps0 (PutFlIt led))
[ treeFromPost [triggerDoorRoom i] r1
, treeFromPost [triggerDoorRoom j] r2
, (rmClusterStatus . csLinks . at OnwardCluster .~ Nothing)
src/Dodge/Update/Camera.hs
+1 -1
View File
@@ -183,7 +183,7 @@ heldAimZoom = \case
GLAUNCHER -> 1.5
POISONSPRAYER -> 1
SHATTERGUN -> 1
TORCH -> 1
LED -> 1
FLATSHIELD -> 1
KEYCARD {} -> 1
BLINKER -> 1
src/Geometry/Intersect.hs
+14 -9
View File
@@ -83,14 +83,17 @@ intersectSegSeg (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
{- | Intended to intersect a segment with a half-line-segment, ie a segment
extending infinitely in one direction.
Will intersect with the first endpoint of the segment, but NOT the second.
This is to allow sensible intersections with polygons described as lists of points.
It will also intersect with the point of the ray.
-}
intersectSegLineFrom :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectSegLineFrom #-}
intersectSegLineFrom (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
intersectSegRay :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectSegRay #-}
intersectSegRay (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
| den == 0 = Nothing
| den > 0 && (t' < 0 || u' < 0 || t' > den) =
| den > 0 && (t' < 0 || u' < 0 || t' >= den) =
Nothing
| den < 0 && (t' > 0 || u' > 0 || t' < den) =
| den < 0 && (t' > 0 || u' > 0 || t' <= den) =
Nothing
| otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
where
@@ -114,18 +117,20 @@ intersectSegLineext (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
u' = (y1 - y2) * (x1 - x3) - (x1 - x2) * (y1 - y3)
-- | Intersect a segment with a line.
-- the line intersects with the first endpoint of the segment
-- but NOT the second
intersectSegLine :: Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
{-# INLINE intersectSegLine #-}
intersectSegLine (V2 x1 y1) (V2 x2 y2) (V2 x3 y3) (V2 x4 y4)
| den == 0 = Nothing
| den > 0 && (t' < 0 || t' > den) =
| den > 0 && (t < 0 || t >= den) =
Nothing
| den < 0 && (t' > 0 || t' < den) =
| den < 0 && (t > 0 || t <= den) =
Nothing
| otherwise = Just $ V2 (x1 + (x2 - x1) * t' / den) (y1 + (y2 - y1) * t' / den)
| otherwise = Just $ V2 (x1 + (x2 - x1) * t / den) (y1 + (y2 - y1) * t / den)
where
den = (x1 - x2) * (y3 - y4) - (y1 - y2) * (x3 - x4)
t' = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
t = (x1 - x3) * (y3 - y4) - (y1 - y3) * (x3 - x4)
--u' = (y1-y2)*(x1-x3) - (x1-x2)*(y1-y3)
src/Geometry/LHS.hs
+42 -31
View File
@@ -1,40 +1,51 @@
module Geometry.LHS
( isLHS
, isRHS
) where
module Geometry.LHS (
isLHS,
isRHS,
) where
import Geometry.Data
-- | Test whether a point is stricly on the LHS of a line.
-- Returns False if the line is of zero length.
isLHS
:: Point2 -- ^ First line point.
-> Point2 -- ^ Second line point.
-> Point2 -- ^ Point not on line.
-> Bool
{- | Test whether a point is stricly on the LHS of a line.
Returns False if the line is of zero length.
-}
isLHS ::
-- | First line point.
Point2 ->
-- | Second line point.
Point2 ->
-- | Point not on line.
Point2 ->
Bool
{-# INLINE isLHS #-}
isLHS (V2 x y) (V2 x' y') (V2 x'' y'')
| (x,y) == (x',y') = False
isLHS (V2 x y) (V2 x' y') (V2 x'' y'')
| (x, y) == (x', y') = False
| otherwise = a1 * b2 - a2 * b1 > 0
where
a1 = x' - x
a2 = y' - y
b1 = x'' - x
b2 = y'' - y
-- | Test whether a point is on the RHS of a line.
-- Returns False if the line is of zero length.
isRHS
:: Point2 -- ^ First line point.
-> Point2 -- ^ Second line point.
-> Point2 -- ^ Point not on line.
-> Bool
{- | Test whether a point is on the RHS of a line.
Returns False if the line is of zero length.
-}
isRHS ::
-- | First line point.
Point2 ->
-- | Second line point.
Point2 ->
-- | Point not on line.
Point2 ->
Bool
{-# INLINE isRHS #-}
isRHS
(V2 x y)
(V2 x' y')
(V2 x'' y'')
| (x,y) == (x',y') = False
| otherwise = a1 * b2 - a2 * b1 < 0
where
a1 = x' - x
a2 = y' - y
b1 = x'' - x
b2 = y'' - y
isRHS
(V2 x y)
(V2 x' y')
(V2 x'' y'')
| (x, y) == (x', y') = False
| otherwise = a1 * b2 - a2 * b1 < 0
where
a1 = x' - x
a2 = y' - y
b1 = x'' - x
b2 = y'' - y
src/Geometry/Polygon.hs
+13
View File
@@ -80,11 +80,24 @@ pointInOrOnPolygon _ _ = undefined
{- | Test whether a point is strictly inside a polygon.
Supposes the points in the polygon are listed in anticlockwise order.
Requires that the polygon is convex.
-}
pointInPoly :: Point2 -> [Point2] -> Bool
pointInPoly !p (x : xs) = all (\l -> uncurry isLHS l p) $ zip (x : xs) (xs ++ [x])
pointInPoly _ [] = False
inSimplePoly :: Point2 -> [Point2] -> Bool
inSimplePoly p (x:xs) = foldl' (flip f) True $ zip (x:xs) (xs ++ [x])
where
f (a,b) = case intersectSegRay a b p (p + V2 1 0) of
Nothing -> id
Just {} -> not
inSimplePoly _ [] = False
---- implement Dan Sunday point in polygon algorithm?
--wnPointPoly :: Point2 -> Point2 -> Point2 -> Int
--wnPointPoly p x y = 0
circInPolygon :: Point2 -> Float -> [Point2] -> Bool
circInPolygon !p !r (x : xs) = all f $ zip (x : xs) (xs ++ [x])
where