_TITLE "Two Triangles Overlap v2 2020-03-24" 'b+ 2020-03-24 ' Just worked Rosetta Code for Line Intersect Line
' but what if we want to know if two line segments intersect?
'2020-03-14 "Two Line Segments Intersect" 'b+ 2020-03-14 start
'2020-03-15 rework this code so we identify points all on same line and
' if there is overlap of line segments say the two x endpoints of the segments
' otherwise, if there is an intersect of 2 line segments say the point x, y.
' Return 0 no intersect or overlap
' Return 1 if intersect and ix, iy point of intersect
' Return -1 if segments are on same and there is overlap: ix = overlap start x, iy overlap end x
'2020-03-16 "Segments Intersect mod tester" >>> just post testing code
'mod tester for 2 segments of vertical line and found I need to add more parameters to
' FUNCTION twoLineSegmentsIntersect% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix, iy)
' mod that name and parameters to:
' FUNCTION twoSegmentsIntersect% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix1, iy1, ix2, iy2)
'2020-03-16 Segments Intersect revised 2020-03-16
' OK now get the new FUNCTION working
' ah! I had to tighten down D from >.2 to >.05 but loosen y-axis intersect
'2020-03-18 apply routines to two triangles
' modified FUNCTION twoSegmentsIntersect% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix1, iy1)
' to do only intersect. This code proved, Segments Intersect revised 2020-03-16, was faulty.
'2020-03-18 a more exactling test of triangle overlaps with line segments over lapping
' purposely to the random triangles already tested and working well.
' 2020-03-24 Two Triangles Overlap v2 2020-03-24
' Can I tighten up the code for getting the Intersect of 2 Line Segments?
' beat 3 + 26 + 27 = 56 lines of code in 3 procedures?
' Oh yes!!! now have 3 + 18 + 11 = 32 lines of code
' lineIntersectLine% cut 8 lines of code :)
' twoSegmentsIntersect cut 16 lines of cutting from 27 lines to 11!
CONST xmax
= 800, ymax
= 600 DIM lCnt
, dista2a3
, adx
, ady
, ix1
, i
, x1
, y1
, sect
, iy1
, dista1a3
DIM dista1a2
, distb2b3
, bdx
, bdy
, distb1b3
, distb1b2
, again$
DO 'main testing loop sets up two triangles to test overlap area lCnt = lCnt + 1 'loop counter to control some purposeful test triangles
IF lCnt
MOD 4 = 0 THEN 'purpose overlap vertical lines cText 400, 580, 32, &HFF0088FF, "Two Triangles with Common Vertical Segment"
ax1 = 400: ay1 = 20
ax2 = 400: ay2 = 570
ax3
= (xmax
- 20) * RND + 10: ay3
= (ymax
- 20) * RND + 10 bx1 = 400: by1 = 200
bx2 = 400: by2 = 450
bx3
= (xmax
- 20) * RND + 10: by3
= (ymax
- 20) * RND + 10
cText 400, 580, 32, &HFF008800, "Two Triangles with Common Horizontal Segment"
ax1 = 10: ay1 = 300
ax2 = 400: ay2 = 300
ax3
= (xmax
- 20) * RND + 10: ay3
= (ymax
- 20) * RND + 10 bx1 = 125: by1 = 300
bx2 = 700: by2 = 300
bx3
= (xmax
- 20) * RND + 10: by3
= by3
= (ymax
- 20) * RND + 10
cText 400, 580, 32, &HFFFF8800, "Two Triangles with Common 45 Degree Segment"
ax1 = 100: ay1 = 100
ax2 = 400: ay2 = 400
ax3
= (xmax
- 20) * RND + 10: ay3
= (ymax
- 20) * RND + 10 bx1 = 50: by1 = 50
bx2 = 500: by2 = 500
bx3
= (xmax
- 20) * RND + 10: by3
= (ymax
- 20) * RND + 10
cText 400, 580, 32, &HFF0000FF, "Two Completely Random Triangles"
ax1
= (xmax
- 20) * RND + 10: ay1
= (ymax
- 20) * RND + 10 ax2
= (xmax
- 20) * RND + 10: ay2
= (ymax
- 20) * RND + 10 ax3
= (xmax
- 20) * RND + 10: ay3
= (ymax
- 20) * RND + 10 bx1
= (xmax
- 20) * RND + 10: by1
= (ymax
- 20) * RND + 10 bx2
= (xmax
- 20) * RND + 10: by2
= (ymax
- 20) * RND + 10 bx3
= (xmax
- 20) * RND + 10: by3
= (ymax
- 20) * RND + 10 'tri a
LINE (ax1
, ay1
)-(ax2
, ay2
), &HFFFF0000 LINE (ax2
, ay2
)-(ax3
, ay3
), &HFFFF0000 LINE (ax3
, ay3
)-(ax1
, ay1
), &HFFFF0000 'tri b
LINE (bx1
, by1
)-(bx2
, by2
), &HFF0000FF LINE (bx2
, by2
)-(bx3
, by3
), &HFF0000FF LINE (bx3
, by3
)-(bx1
, by1
), &HFF0000FF
dista2a3
= _HYPOT(ax2
- ax3
, ay2
- ay3
) adx = (ax3 - ax2) / dista2a3: ady = (ay3 - ay2) / dista2a3
x1 = ax2 + adx * i: y1 = ay2 + ady * i
sect = twoSegmentsIntersect%(ax1, ay1, x1, y1, bx1, by1, bx2, by2, ix1, iy1)
sect = twoSegmentsIntersect%(ax1, ay1, x1, y1, bx3, by3, bx2, by2, ix1, iy1)
sect = twoSegmentsIntersect%(ax1, ay1, x1, y1, bx1, by1, bx3, by3, ix1, iy1)
dista1a3
= _HYPOT(ax1
- ax3
, ay1
- ay3
) adx = (ax3 - ax1) / dista1a3: ady = (ay3 - ay1) / dista1a3
x1 = ax1 + adx * i: y1 = ay1 + ady * i
sect = twoSegmentsIntersect%(ax2, ay2, x1, y1, bx1, by1, bx2, by2, ix1, iy1)
sect = twoSegmentsIntersect%(ax2, ay2, x1, y1, bx3, by3, bx2, by2, ix1, iy1)
sect = twoSegmentsIntersect%(ax2, ay2, x1, y1, bx1, by1, bx3, by3, ix1, iy1)
dista1a2
= _HYPOT(ax1
- ax2
, ay1
- ay2
) adx = (ax2 - ax1) / dista1a2: ady = (ay2 - ay1) / dista1a2
x1 = ax1 + adx * i: y1 = ay1 + ady * i
sect = twoSegmentsIntersect%(ax3, ay3, x1, y1, bx1, by1, bx2, by2, ix1, iy1)
sect = twoSegmentsIntersect%(ax3, ay3, x1, y1, bx3, by3, bx2, by2, ix1, iy1)
sect = twoSegmentsIntersect%(ax3, ay3, x1, y1, bx1, by1, bx3, by3, ix1, iy1)
distb2b3
= _HYPOT(bx2
- bx3
, by2
- by3
) bdx = (bx3 - bx2) / distb2b3: bdy = (by3 - by2) / distb2b3
x1 = bx2 + bdx * i: y1 = by2 + bdy * i
sect = twoSegmentsIntersect%(bx1, by1, x1, y1, ax1, ay1, ax2, ay2, ix1, iy1)
sect = twoSegmentsIntersect%(bx1, by1, x1, y1, ax3, ay3, ax2, ay2, ix1, iy1)
sect = twoSegmentsIntersect%(bx1, by1, x1, y1, ax1, ay1, ax3, ay3, ix1, iy1)
distb1b3
= _HYPOT(bx1
- bx3
, by1
- by3
) bdx = (bx3 - bx1) / distb1b3: bdy = (by3 - by1) / distb1b3
x1 = bx1 + bdx * i: y1 = by1 + bdy * i
sect = twoSegmentsIntersect%(bx2, by2, x1, y1, ax1, ay1, ax2, ay2, ix1, iy1)
sect = twoSegmentsIntersect%(bx2, by2, x1, y1, ax3, ay3, ax2, ay2, ix1, iy1)
sect = twoSegmentsIntersect%(bx2, by2, x1, y1, ax1, ay1, ax3, ay3, ix1, iy1)
distb1b2
= _HYPOT(bx1
- bx2
, by1
- by2
) bdx = (bx2 - bx1) / distb1b2: bdy = (by2 - by1) / distb1b2
x1 = bx1 + bdx * i: y1 = by1 + bdy * i
sect = twoSegmentsIntersect%(bx3, by3, x1, y1, ax1, ay1, ax2, ay2, ix1, iy1)
sect = twoSegmentsIntersect%(bx3, by3, x1, y1, ax3, ay3, ax2, ay2, ix1, iy1)
sect = twoSegmentsIntersect%(bx3, by3, x1, y1, ax1, ay1, ax3, ay3, ix1, iy1)
INPUT "Press enter for another demo, any + enter to quit...", again$
'center the text at x, y with given height and color
'screen snapshot
mult = textHeight / 16
xlen
= LEN(txt$
) * 8 * mult
_PUTIMAGE (x
- .5 * xlen
, y
- .5 * textHeight
)-STEP(xlen
, textHeight
), I&
, cur&
' ======================================== end tester code functions ===========================98
' For segments intersect first we need to know if lines do and for that we need to knoww stuff
' about the line from the segment given.
' Return 0 if x = x2 and line is perpendicular otherwise return -1, slope = M and yIntersect = Y0
' Return 1, ix, iy if lines intersect, Return -1 if they overlap, return 0 if neither.
' This function needs:
' Return 0 if x = x2 and line is perpendicular otherwise return -1, slope = M and yIntersect = Y0
' FUNCTION slopeY0% (X, Y, X2, Y2, M, Y0)
FUNCTION lineIntersectLine%
(ax1
, ay1
, ax2
, ay2
, bx1
, by1
, bx2
, by2
, ix
, iy
) DIM ai
, bi
, aM
, bM
, aY0
, bY0
, d
ai = slopeY0%(ax1, ay1, ax2, ay2, aM, aY0) ' here's the scoop on line a
bi = slopeY0%(bx1, by1, bx2, by2, bM, bY0) ' here's the dope on line b
IF ai
= 0 AND bi
= 0 THEN ' both are perpendicular how bout that! IF ax1
= bx1
THEN lineIntersectLine%
= -1 ' whole line overlaps more amazing!! ELSEIF ai
= 0 AND bi
THEN ' a is perpendicular and b is not so ix = ax ix = ax1: iy = bM * ix + bY0: lineIntersectLine% = 1 ' signal a point was found
ELSEIF ai
AND bi
= 0 THEN ' b is perpendicular and a is not so ix = bx ix = bx1: iy = aM * ix + aY0: lineIntersectLine% = 1 ' signal a point was found
d = -aM + bM ' if = 0 then parallel or equal because slopes are same
IF d
= 0 THEN ' lines a and b are parallel IF aY0
= bY0
THEN lineIntersectLine%
= -1 ' the same Y0 means signal overlapping lines ELSE ' get values of ix, iy intersect point and signal intersect ix = (aY0 - bY0) / d: iy = (-aM * bY0 + bM * aY0) / d: lineIntersectLine% = 1
' Return 1, ix, iy if line segments intersect, Return 0 if they don't
' This function needs:
' Return 0 if x = x2 and line is perpendicular otherwise return -1, slope = M and yIntersect = Y0
' FUNCTION slopeY0% (X, Y, X2, Y2, M, Y0)
' Return 1, ix, iy if lines intersect, Return -1 if they overlap, return 0 if neither.
' FUNCTION lineIntersectLine% (ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix, iy)
FUNCTION twoSegmentsIntersect%
(ax1
, ay1
, ax2
, ay2
, bx1
, by1
, bx2
, by2
, ix
, iy
) intersect = lineIntersectLine%(ax1, ay1, ax2, ay2, bx1, by1, bx2, by2, ix, iy)
a1
= _ATAN2(ay1
- iy
, ax1
- ix
): a2
= _ATAN2(ay2
- iy
, ax2
- ix
) a1
= _ATAN2(by1
- iy
, bx1
- ix
): a2
= _ATAN2(by2
- iy
, bx2
- ix
) twoSegmentsIntersect% = 1