Remove wall corner collision test for creatures

This commit is contained in:
2021-09-24 11:31:08 +01:00
parent 1883e0785e
commit 899cf6ef81
10 changed files with 47 additions and 76 deletions
+5 -5
View File
@@ -42,8 +42,8 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
lhsPoints = divideLineExact d (pa -.- yN) (pb +.+ yN)
findDiPoint p = head . sortOn (dist p) $ catMaybes
[intersectLineLine' p (p +.+ diVec) pax pbx
,intersectSegLine' pa pax p (p +.+ diVec)
,intersectSegLine' pb pbx p (p +.+ diVec)
,intersectSegLine pa pax p (p +.+ diVec)
,intersectSegLine pb pbx p (p +.+ diVec)
]
yN = d * 0.5 *.* normalizeV (pa -.- pb)
@@ -67,7 +67,7 @@ girderZ w x y = setDepth 50 $ color red $ pictures $
yt = y -.- n
ps = divideLineExact (w*2) xb yb
dia = rotateV (pi/4) n
ps' = map (\p -> intersectSegLine' xt yt p (p +.+ dia)) ps
ps' = map (\p -> intersectSegLine xt yt p (p +.+ dia)) ps
ls = catMaybes $ zipWith (fmap . (,)) ps ps'
girderV :: Color -> Float -> Point2 -> Point2 -> Picture
girderV col w x y = setDepth 50 $ color col $ pictures $
@@ -84,7 +84,7 @@ girderV col w x y = setDepth 50 $ color col $ pictures $
yt = y -.- n
ps = divideLineExact (w*2) xb yb
(as,_) = evenOddSplit ps
f a = map (\p -> intersectSegLine' xt yt p (p +.+ rotateV a n))
f a = map (\p -> intersectSegLine xt yt p (p +.+ rotateV a n))
as' = catMaybes $ zipWith (fmap . (,)) as $ f (pi/4) as
bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
girder :: Color -> Float -> Point2 -> Point2 -> Picture
@@ -103,7 +103,7 @@ girder col w x y = pictures $
xt = x -.- n
yt = y -.- n
ps = divideLineExact (w*2) xb yb
ps' = map (\p -> intersectSegLine' xt yt p (p +.+ n)) ps
ps' = map (\p -> intersectSegLine xt yt p (p +.+ n)) ps
ls = catMaybes $ zipWith (fmap . (,)) ps ps'