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

Fix bugs in zoning

Browse Source
This commit is contained in:
justin
2022-07-30 14:21:13 +01:00
parent c8ad3e1294
commit 82db86f55f
16 changed files with 204 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+1 -1
View File
@@ -327,7 +327,7 @@ canSeeIndirect i j w = hasLOSIndirect ipos jpos w
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
where
hitCr = IS.foldr f False $ crsNearSeg sp ep w
hitCr = IS.foldr f False $ crixsNearSeg sp ep w
f cid bl =
maybe
False
src/Dodge/Damage.hs
+11 -6
View File
@@ -1,23 +1,28 @@
module Dodge.Damage where
{-# LANGUAGE LambdaCase #-}
module Dodge.Damage
( damageCrWl
, damageDirection
, damageCrWlID
, maxDamageType
) where
import qualified Data.Map.Strict as M
import Dodge.Data.CrWlID
import Dodge.Data.World
import Dodge.Wall.Damage
import FoldableHelp
import Geometry.Vector
import LensHelp
import qualified IntMapHelp as IM
damageCrWlID :: Damage -> CrWlID -> World -> World
damageCrWlID dam crwl = case crwl of
damageCrWlID dam = \case
NothingID -> id
CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam
WlID wlid -> cWorld . wallDamages %~ IM.insertWith (++) wlid [dam]
damageCrWall :: Damage -> Either Creature Wall -> World -> World
damageCrWall dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
damageCrWall dt (Right wl) = damageWall dt wl
damageCrWl :: Damage -> Either Creature Wall -> World -> World
damageCrWl dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
damageCrWl dt (Right wl) = cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt]
damageDirection :: [Damage] -> Maybe Float
damageDirection ds = do
src/Dodge/Data.hs
+1 -6
View File
@@ -1,10 +1,5 @@
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
{- |
Contains base datatypes that cannot be seperated into
different modules because they are interdependent;
circular imports are probably not a good idea.
Rexports all Dodge.Data.x files.
-}
module Dodge.Data (
module Dodge.Data.World,
src/Dodge/Data/Config.hs
+1
View File
@@ -46,6 +46,7 @@ data DebugBool
| Bound_box_screen
| Show_wall_search_rays
| Show_dda_test
| Collision_test
| Show_far_wall_detect
| Show_select
| Inspect_wall
src/Dodge/Data/World.hs
+1
View File
@@ -34,6 +34,7 @@ data World = World
, _testFloat :: Float
, _lLine :: (Point2, Point2)
, _rLine :: (Point2, Point2)
, _lrLine :: (Point2, Point2)
, _lSelect :: Point2
, _rSelect :: Point2
, _backspaceTimer :: Int
src/Dodge/Default/World.hs
+1
View File
@@ -23,6 +23,7 @@ defaultWorld =
, _mousePos = V2 0 0
, _hammers = defaultWorldHammers
, _testFloat = 0
, _lrLine = (0, 0)
, _lLine = (0, 0)
, _rLine = (0, 0)
, _lSelect = 0
src/Dodge/Draw.hs
+46
View File
@@ -0,0 +1,46 @@
{- |
Rexports all Dodge.x.Draw files.
-}
module Dodge.Draw (
module Dodge.Beam.Draw,
module Dodge.Block.Draw,
module Dodge.Item.Draw,
module Dodge.Bullet.Draw,
module Dodge.Button.Draw,
module Dodge.Cloud.Draw,
module Dodge.EnergyBall.Draw,
module Dodge.Flame.Draw,
module Dodge.Laser.Draw,
module Dodge.LightSource.Draw,
module Dodge.LinearShockwave.Draw,
module Dodge.Machine.Draw,
module Dodge.Projectile.Draw,
module Dodge.Prop.Draw,
module Dodge.RadarSweep.Draw,
module Dodge.Spark.Draw,
module Dodge.Targeting.Draw,
module Dodge.Tesla.Arc.Draw,
module Dodge.TractorBeam.Draw,
module Dodge.Shockwave.Draw,
) where
import Dodge.Beam.Draw
import Dodge.Item.Draw
import Dodge.Block.Draw
import Dodge.Bullet.Draw
import Dodge.Button.Draw
import Dodge.Cloud.Draw
import Dodge.EnergyBall.Draw
import Dodge.Flame.Draw
import Dodge.Laser.Draw
import Dodge.LightSource.Draw
import Dodge.LinearShockwave.Draw
import Dodge.Machine.Draw
import Dodge.Projectile.Draw
import Dodge.Prop.Draw
import Dodge.RadarSweep.Draw
import Dodge.Shockwave.Draw
import Dodge.Spark.Draw
import Dodge.Targeting.Draw
import Dodge.Tesla.Arc.Draw
import Dodge.TractorBeam.Draw
src/Dodge/Machine/Update.hs
+1 -1
View File
@@ -70,7 +70,7 @@ mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
mcSensorTriggerUpdate se mc = fromMaybe id $ do
trid <- mc ^? mcMounts . ix ObTrigger
bval <- mcTriggerVal se
return $ cWorld . triggers . ix trid .~ bval
return $ cWorld . triggers . ix trid ||~ bval
mcTriggerVal :: Sensor -> Maybe Bool
mcTriggerVal se = case se of
src/Dodge/Placement/Instance/Sensor.hs
+24 -16
View File
@@ -19,26 +19,34 @@ damageSensor ::
PlacementSpot ->
Placement
damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
\lsid -> psPtJpl ps $
PutUsingGenParams $
\gw ->
( gw
, PutMachine
(reverse $ square wdth)
( defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcType .~ McSensor (DamageSensor False 0 dt (_sensorCoding (_genParams (_cWorld gw)) M.! dt) (damageTypeThreshold dt))
)
defaultSensorWall
\lsid -> psPtJpl ps
. PutUsingGenParams
$ \gw ->
( gw
, PutMachine
(reverse $ square wdth)
( defaultMachine
& mcColor .~ yellow
& mcMounts . at ObTrigger .~ mtrid
& mcMounts . at ObLightSource ?~ lsid
& mcType
.~ McSensor
( DamageSensor
False
0
dt
(_sensorCoding (_genParams (_cWorld gw)) M.! dt)
(damageTypeThreshold dt)
)
)
defaultSensorWall
)
damageTypeThreshold :: DamageType -> Int
damageTypeThreshold dt = case dt of
FLAMING -> 1000
LASERING -> 1000
ELECTRICAL -> 5
FLAMING -> 1000
LASERING -> 1000
ELECTRICAL -> 500
_ -> undefined
lightSensor ::
src/Dodge/Render/Label.hs
+31
View File
@@ -0,0 +1,31 @@
module Dodge.Render.Label
where
import Dodge.Base.Coordinate
import Dodge.ShortShow
import Dodge.Base.WinScale
import Picture
import Dodge.Data.Universe
import Geometry
drawLabCrossCol :: Configuration -> World -> Color -> Point2 -> Picture
drawLabCrossCol cfig w col p = drawCrossCol col p
<> drawPointLabel cfig w p
drawPointLabel :: Configuration -> World -> Point2 -> Picture
drawPointLabel cfig w p =
setLayer FixedCoordLayer . winScale cfig
. uncurryV translate p'
. scale 0.1 0.1
. text
$ shortPoint2 p
where
p' = worldPosToScreen w p
drawCrossCol :: Color -> Point2 -> Picture
drawCrossCol col p = setLayer DebugLayer . color col . uncurryV translate p $ crossPic 5
drawCross :: Point2 -> Picture
drawCross = drawCrossCol red
crossPic :: Float -> Picture
crossPic x = line [V2 x x, V2 (- x) (- x)] <> line [V2 (- x) x, V2 x (- x)]
src/Dodge/Render/ShapePicture.hs
+51 -60
View File
@@ -2,7 +2,8 @@ module Dodge.Render.ShapePicture (
worldSPic,
) where
import Dodge.Zoning.Base
import Dodge.Render.Label
import Dodge.WorldEvent.ThingsHit
import Control.Lens
import Data.Foldable
import qualified Data.Graph.Inductive as FGL
@@ -10,47 +11,28 @@ import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as Set
import Dodge.Base
import Dodge.Beam.Draw
import Dodge.Block.Draw
import Dodge.Bullet.Draw
import Dodge.Button.Draw
import Dodge.Cloud.Draw
import Dodge.Creature.Picture
import Dodge.Creature.Picture.Awareness
import Dodge.Data.Config
import Dodge.Data.World
import Dodge.Debug.Picture
import Dodge.EnergyBall.Draw
import Dodge.Flame.Draw
import Dodge.Draw
import Dodge.Flare
import Dodge.GameRoom
import Dodge.Graph
import Dodge.Item.Draw.SPic
import Dodge.Laser.Draw
import Dodge.LightSource.Draw
import Dodge.LinearShockwave.Draw
import Dodge.Machine.Draw
import Dodge.Path
import Dodge.Picture.SizeInvariant
import Dodge.Projectile.Draw
import Dodge.Prop.Draw
import Dodge.RadarBlip
import Dodge.RadarSweep.Draw
import Dodge.Render.InfoBox
import Dodge.Render.List
import Dodge.Shockwave.Draw
import Dodge.ShortShow
import Dodge.SoundLogic.LoadSound
import Dodge.Spark.Draw
import Dodge.Targeting.Draw
import Dodge.Tesla.Arc.Draw
import Dodge.TractorBeam.Draw
import Dodge.Update.Camera
import Dodge.Zone
import Dodge.Zoning
import Dodge.Zoning.Base
import Geometry
import Geometry.ConvexPoly
--import Geometry.Zone
import qualified IntMapHelp as IM
import Padding
import Picture
@@ -172,36 +154,47 @@ debugDraw cfig w
<> setLayer FixedCoordLayer (listPicturesAt (0.5 * halfWidth cfig) 0 cfig $ map text ts)
| otherwise = mempty
where
(ts, pic) = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
ts = map show (Set.toList $ _debug_booleans cfig)
debugDraw' :: Configuration -> World -> DebugBool -> ([String], Picture)
debugDraw' :: Configuration -> World -> DebugBool -> Picture
{-# INLINE debugDraw' #-}
debugDraw' cfig w bl = case bl of
Show_debug -> lstring "Show debug"
Noclip -> lstring "Noclip"
Remove_LOS -> lstring "No line of sight"
Cull_more_lights -> lstring "Cull more lights"
Close_shape_culling -> lstring "Close shape culling"
Bound_box_screen -> lstring "bound box screen, this should be moved"
Show_ms_frame -> rdraw mempty
View_boundaries -> rdraw $ viewBoundaries w
Show_bound_box -> rdraw $ drawBoundingBox w
Show_wall_search_rays -> rdraw $ drawWallSearchRays w
Show_dda_test -> rdraw $ drawDDATest w
Show_far_wall_detect -> rdraw $ drawFarWallDetect w
Show_select -> rdraw $ drawWorldSelect w
Inspect_wall -> rdraw $ drawInspectWalls w
Cr_awareness -> rdraw $ drawCreatureDisplayTexts w
Show_sound -> rdraw $ pictures $ M.map (soundPic cfig w) $ _playingSounds w
Cr_status -> rdraw $ drawCrInfo cfig w
Mouse_position -> rdraw $ drawMousePosition cfig w
Walls_info -> rdraw $ drawWlIDs cfig w
Pathing -> rdraw $ drawPathing cfig w
Show_nodes_near_select -> rdraw $ drawNodesNearSelect w
Show_path_between -> rdraw $ drawPathBetween w
Show_debug -> mempty
Noclip -> mempty
Remove_LOS -> mempty
Cull_more_lights -> mempty
Close_shape_culling -> mempty
Bound_box_screen -> mempty
Show_ms_frame -> mempty
View_boundaries -> viewBoundaries w
Show_bound_box -> drawBoundingBox w
Show_wall_search_rays -> drawWallSearchRays w
Show_dda_test -> drawDDATest w
Show_far_wall_detect -> drawFarWallDetect w
Show_select -> drawWorldSelect w
Inspect_wall -> drawInspectWalls w
Cr_awareness -> drawCreatureDisplayTexts w
Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
Cr_status -> drawCrInfo cfig w
Mouse_position -> drawMousePosition cfig w
Walls_info -> drawWlIDs cfig w
Pathing -> drawPathing cfig w
Show_nodes_near_select -> drawNodesNearSelect w
Show_path_between -> drawPathBetween w
Collision_test -> drawCollisionTest cfig w
drawCollisionTest :: Configuration -> World -> Picture
drawCollisionTest cfig w =
setLayer DebugLayer (color orange $ line [a,b])
<> foldMap (drawCross . fst) (crHit a b w)
<> foldMap (drawCross . _crPos) (crsNearSeg a b w)
-- <> foldMap (drawZoneCol green crZoneSize) (zoneOfSeg' crZoneSize a b)
<> foldMap (drawZoneCol green crZoneSize . zoneOfPoint' crZoneSize) (xIntercepts' crZoneSize a b)
<> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint' crZoneSize) (yIntercepts' crZoneSize a b)
<> foldMap (drawLabCrossCol cfig w blue) (xIntercepts' crZoneSize a b)
where
lstring str = ([str], mempty)
rdraw pic = (mempty, pic)
(a, b) = _lrLine w
drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w))
@@ -229,9 +222,11 @@ drawNodesNearSelect w =
drawInspectWalls :: World -> Picture
drawInspectWalls w =
foldMap (drawInspectWall w) $
setLayer DebugLayer (color orange $ line [a,b]) <>
foldMap (drawInspectWall w) (
filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
IM.elems $ _walls (_cWorld w)
)
where
(a, b) = _lLine w
@@ -287,25 +282,21 @@ drawFarWallDetect w =
drawDDATest :: World -> Picture
drawDDATest w =
foldMap (drawZoneCol orange 50) ps
-- runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
-- <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
-- <> runIdentity (S.foldMap_ drawCross qs)
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
-- runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
-- <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
-- <> runIdentity (S.foldMap_ drawCross qs)
-- <> color blue (runIdentity (S.foldMap_ drawCross qs'))
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = _cameraViewFrom (_cWorld w)
mwp = mouseWorldPos w
--ps = ddaStreamX 50 cvf mwp
ps = zoneOfSeg' 50 cvf mwp
--ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
--qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
--qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
drawCross :: Point2 -> Picture
drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5
--ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
--qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
--qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
crossPic :: Float -> Picture
crossPic x = line [V2 x x, V2 (- x) (- x)] <> line [V2 (- x) x, V2 x (- x)]
drawZoneCol :: Color -> Float -> V2 Int -> Picture
drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p])
src/Dodge/Spark.hs
+11 -13
View File
@@ -7,12 +7,12 @@ module Dodge.Spark (
randSpark,
) where
import Dodge.Damage
import Color
import Control.Monad.State
import Dodge.Data.World
import Dodge.WorldEvent.ThingsHit
import Geometry
import qualified IntMapHelp as IM
import LensHelp
import System.Random
@@ -37,8 +37,7 @@ sparkDam ::
World ->
World
sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of
(hitp, Left cr) -> cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
(hitp, Right wl) -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp]
(hitp, eicrwl) -> damageCrWl (thedam hitp) eicrwl
where
thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
@@ -56,22 +55,21 @@ randColDirSpark ::
World
randColDirSpark randcol randdir pos w =
w
& cWorld . sparks .:~ spark
& randGen .~ g
& cWorld . sparks
.:~ Spark
{ _skVel = rotateV dir (V2 5 0)
, _skColor = col
, _skPos = pos
, _skOldPos = pos
, _skWidth = 1
, _skDamageType = SPARKING
}
where
((col, dir), g) = (`runState` _randGen w) $ do
c <- randcol
d <- randdir
return (c, d)
spark =
Spark
{ _skVel = rotateV dir (V2 5 0)
, _skColor = col
, _skPos = pos
, _skOldPos = pos
, _skWidth = 1
, _skDamageType = SPARKING
}
randSpark ::
DamageType ->
src/Dodge/Update.hs
+7 -4
View File
@@ -158,12 +158,15 @@ zoneClouds w =
updateWorldSelect :: World -> World
updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of
(Nothing, Nothing) -> w
(Just False, Nothing) -> w & lLine . _1 .~ mwp
& lrLine . _1 .~ mwp
(Just True, Nothing) -> w & lLine . _2 .~ mwp
(Nothing, _) -> w
(Just False, _) -> w & rLine . _1 .~ mwp
(Just True, _) -> w & rLine . _2 .~ mwp
& lrLine . _1 .~ mwp
(Nothing,Just False) -> w & rLine . _1 .~ mwp
& lrLine . _2 .~ mwp
(Nothing,Just True) -> w & rLine . _2 .~ mwp
& lrLine . _2 .~ mwp
_ -> w
where
mwp = mouseWorldPos w
f
src/Dodge/WorldEvent/ThingsHit.hs
+5 -46
View File
@@ -10,6 +10,7 @@ module Dodge.WorldEvent.ThingsHit (
thingsHitExceptCr,
crsHitRadial,
wlsHitRadial,
crHit,
) where
import Control.Lens
@@ -38,16 +39,6 @@ thingsHit sp ep w =
(map (second Left) (crsHit sp ep w))
(map (second Right) (wlsHit sp ep w))
--{- List those objects that appear on a line. -}
--thingsHit
-- :: Point2 -- ^ Line start point
-- -> Point2 -- ^ Line end point
-- -> World
-- -> StreamOf (Point2, Either Creature Wall)
--thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
-- (S.map (second Left) (S.each $ crsHit sp ep w))
-- (S.map (second Right) (wlsHit sp ep w))
crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
crsHit sp ep w
| sp == ep = mempty
@@ -56,7 +47,7 @@ crsHit sp ep w
. overlap1SegCrs sp ep
. mapMaybe (\cid -> w ^? cWorld . creatures . ix cid)
. IS.toList
. crsNearSeg sp ep
. crixsNearSeg sp ep
$ w
thingHitFilt ::
@@ -71,16 +62,12 @@ thingHitFilt fcr fwl sp ep = List.find (f . snd) . thingsHit sp ep
f (Left cr) = fcr cr
f (Right wl) = fwl wl
--thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
-- -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
--thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
-- where
-- f (Left cr) = fcr cr
-- f (Right wl) = fwl wl
thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
thingHit sp ep = listToMaybe . thingsHit sp ep
crHit :: Point2 -> Point2 -> World -> Maybe (Point2,Creature)
crHit sp ep = listToMaybe . sortOn (dist sp . fst) . crsHit sp ep
{- List objects that appear on a line.
Can filter out a creature. -}
thingsHitExceptCr ::
@@ -98,20 +85,6 @@ thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
crNotCid (_, Left cr) = _crID cr /= cid
crNotCid _ = True
--{- List objects that appear on a line.
--Can filter out a creature. -}
--thingsHitExceptCr
-- :: Maybe Int -- ^ A possible creature ID
-- -> Point2 -- ^ Line start point
-- -> Point2 -- ^ Line end point
-- -> World
-- -> StreamOf (Point2, Either Creature Wall)
--thingsHitExceptCr Nothing sp ep = thingsHit sp ep
--thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
-- where
-- crNotCid (_,Left cr) = _crID cr /= cid
-- crNotCid _ = True
wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
wlsHit sp ep
| sp == ep = const mempty
@@ -120,13 +93,6 @@ wlsHit sp ep
. overlapSegWalls sp ep
. wlsNearSeg sp ep
--wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
--wlsHit sp ep
-- | sp == ep = const mempty
-- | otherwise = sortStreamOn (dist sp . fst)
-- . overlapSegWalls sp ep
-- . wlsNearSeg sp ep
wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
where
@@ -134,13 +100,6 @@ wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
where
v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
--wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
--wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
-- where
-- f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
-- where
-- v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
crsHitRadial p r = mapMaybe f . crsNearCirc p r
where
src/Dodge/Zoning/Base.hs
+4 -2
View File
@@ -43,9 +43,11 @@ xIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE xIntercepts' #-}
xIntercepts' s (V2 sx sy) (V2 ex ey)
| xdx == 0 = []
| xdx > 0 = zipWith V2 [sx', sx' + xdx * 50 .. ex] ([sy', sy' + ydx * 50 .. ey] ++ repeat ey)
| otherwise = zipWith V2 [sx' -50, sx' + xdx * 50 -50 .. ex -50] ([sy', sy' + ydx * 50 .. ey] ++ repeat ey)
| otherwise = zipWith V2 [halfstep + sx', halfstep + sx' + xdx * s .. ex] ([sy', sy' + ydx * s .. ey] ++ repeat ey)
where
halfstep
| xdx > 0 = -s/2
| otherwise = s/2
xdx = signum (ex - sx)
ydx = (ey - sy) / abs (ex - sx) -- carefull: if this is zero
sy' = sy + ydx * abs (sx - sx')
src/Dodge/Zoning/Creature.hs
+8 -2
View File
@@ -15,8 +15,14 @@ crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. cWorld . crZo
crsNearPoint :: Point2 -> World -> [Creature]
crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
crsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg' crZoneSize sp ep)
crsNearSeg :: Point2 -> Point2 -> World -> [Creature]
crsNearSeg sp ep w =
mapMaybe (\cid -> w ^? cWorld . creatures . ix cid)
. IS.toList
$ crixsNearSeg sp ep w
crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg' crZoneSize sp ep)
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)