menu @OnPolyTest {
mouse {
var %hw = $window($active).dw / 2 , %hh = $window($active).dh / 2
var %x = $mouse.x - %hw , %y = $mouse.y - %hh
tokenize 32 $window($active).title
var %Poly = $1 , %Mouse = $2
var %Polygon = $OPT.TranslatePolygon($OPT.Polygons(%Poly),0,0,0,2) , %P44 = $regsubex(%Polygon,/\s/g,$chr(44))
var %PolyClosed = %Polygon $gettok(%Polygon,1-2,32)
var %PCount = $numtok(%Polygon,32) , %Points = %PCount / 2
var %Cursor = $OPT.TranslatePolygon($OPT.Polygons(%Mouse),0,%x,%y,2) , %C44 = $regsubex(%Cursor,/\s/g,$chr(44))
var %CCount = $numtok(%Cursor,32) , %CPoints = %CCount / 2
.onpolytest
var %a = $onpoly(%CPoints,%Points, [ %C44 ] , [ %P44 ] ) , %b = $mslonpoly(%CPoints,%Points, [ %C44 ] , [ %P44 ] )
;==== Test #1
if (%a || %b) {
drawtext -n $active 0 0 0 *** Bounding Box on polygon
var %np = $OPT.TranslatePolygon(%Polygon,0,%hw,%hh)
drawline -n @OnpolyTest $iif(%a,7,8) 1 %np $gettok(%np,1-2,32)
var %c = 1 , %d = 4
while (%c <= %PCount) {
var %Seg = $gettok(%PolyClosed,$+(%c,-,%d),32)
tokenize 32 %Seg
;==== Test #2
if ($onpoly(%CPoints,2, [ %C44 ] , [ $regsubex($1-,/\s/g,$chr(44)) ] )) { drawline -n @OnPolyTest 4 1 $regsubex($1-,/([^ ]+) ([^ ]+)/g,$calc(\1 + %hw) $calc(\2 + %hh)) }
elseif ($mslonpoly(%CPoints,2, [ %C44 ] , [ $regsubex($1-,/\s/g,$chr(44)) ] )) { drawline -n @OnPolyTest 13 4 $regsubex($1-,/([^ ]+) ([^ ]+)/g,$calc(\1 + %hw) $calc(\2 + %hh)) }
;==== Test #3
if ($inpoly($1,$2, [ %C44 ] )) { drawdot -n @OnPolyTest 3 4 $calc($1 + %hw) $calc($2 + %hh) }
elseif ($mslinpoly($1,$2, [ %C44 ] )) { drawdot -n @OnPolyTest 11 4 $calc($1 + %hw) $calc($2 + %hh) }
if ($inpoly($3,$4, [ %C44 ] )) { drawdot -n @OnPolyTest 3 4 $calc($3 + %hw) $calc($4 + %hh) }
elseif ($mslinpoly($3,$4, [ %C44 ] )) { drawdot -n @OnPolyTest 11 4 $calc($3 + %hw) $calc($4 + %hh) }
var %c = %c + 2 , %d = %d + 2
}
}
drawdot @OnPolyTest
}
Polygon
.Box:opt.changepoly 1 box
.largeRock1:opt.changepoly 1 largeRock1
.largeRock2:opt.changepoly 1 largeRock2
.largeRock3:opt.changepoly 1 largeRock3
.medRock1:opt.changepoly 1 medRock1
.medRock2:opt.changepoly 1 medRock2
.medRock3:opt.changepoly 1 medRock3
.smallRock1:opt.changepoly 1 smallRock1
.smallRock2:opt.changepoly 1 smallRock2
.smallRock3:opt.changepoly 1 smallRock3
Mouse
.line:opt.changepoly 2 line
.Box:opt.changepoly 2 box
.largeRock1:opt.changepoly 2 largeRock1
.largeRock2:opt.changepoly 2 largeRock2
.largeRock3:opt.changepoly 2 largeRock3
.medRock1:opt.changepoly 2 medRock1
.medRock2:opt.changepoly 2 medRock2
.medRock3:opt.changepoly 2 medRock3
.smallRock1:opt.changepoly 2 smallRock1
.smallRock2:opt.changepoly 2 smallRock2
.smallRock3:opt.changepoly 2 smallRock3
}
alias onpolytest {
if (!$window(@OnPolyTest)) {
window -dpf @OnPolyTest -1 -1 640 480
titlebar @OnPolyTest largeRock1 box
}
tokenize 32 $window(@OnPolyTest).title
var %Poly = $1 , %Mouse = $2
var %w = $window(@OnPolyTest).dw , %h = $window(@OnPolyTest).dh , %hw = %w / 2 , %hh = %h / 2
drawrect -nf @OnPolytest 1 1 0 0 %w %h
drawtext -np @OnPolyTest 0 0 20 Native: 7Onpoly 4LineSeg onpoly 3Point Inpoly
drawtext -np @OnPolyTest 0 0 40 $str($chr(140),2) mSL: 8Onpoly 13LineSeg onpoly 11Point Inpoly
var %Poly = $OPT.TranslatePolygon($OPT.Polygons(%Poly),0,%hw,%hh,2)
drawline -n @OnpolyTest 0 1 %poly $gettok(%poly,1-2,32)
var %poly = $OPT.TranslatePolygon($OPT.Polygons(%Mouse),0,$Mouse.x,$Mouse.y,2)
drawline -n @OnpolyTest 0 1 %poly $gettok(%poly,1-2,32)
drawtext -np @OnPolyTest 0 0 400 #1. Is MousePoly on the other? (7O,8Y)
drawtext -np @OnPolyTest 0 0 420 #2. Any polygon linesegs on the mouse poly? (4R,13M)
drawtext -np @OnPolyTest 0 0 440 #3. Either lineseg point inside the mouse poly? (3G,11B)
if ($show) { drawdot @OnPolyTest }
}
alias -l OPT.changepoly {
var %target = $1 , %val = $2
tokenize 32 $window(@OnPolyTest).title
var %Poly = $1 , %Mouse = $2
if (%target = 1) { %Poly = %val }
else { %Mouse = %val }
titlebar @OnPolyTest %Poly %Mouse
}
alias -l OPT.Polygons {
if ($1 = line) { return -10 0 10 0 }
if ($1 = box) { return -10 -10 10 -10 10 10 -10 10 }
if ($1 = largeRock1) { return -39 -25 -33 -8 -38 21 -23 25 -13 39 24 34 38 7 33 -15 38 -31 16 -39 -4 -34 -16 -39 }
if ($1 = largeRock2) { return -32 35 -4 32 24 38 38 23 31 -4 38 -25 14 -39 -28 -31 -39 -16 -31 4 -38 22 }
if ($1 = largeRock3) { return 12 -39 -2 -26 -28 -37 -38 -14 -21 9 -34 34 -6 38 35 23 21 -14 36 -25 }
if ($1 = medRock1) { return -7 -19 -19 -15 -12 -5 -19 0 -19 13 -9 19 12 16 18 11 13 6 19 -1 16 -17 }
if ($1 = medRock2) { return 9 -19 18 -8 7 0 15 15 -7 13 -16 17 -18 3 -13 -6 -16 -17 }
if ($1 = medRock3) { return 2 18 18 10 8 0 18 -13 6 -18 -17 -14 -10 -3 -13 15 }
if ($1 = smallRock1) { return -8 -8 -5 -1 -8 3 0 9 8 4 8 -5 1 -9 }
if ($1 = smallRock2) { return -6 8 1 4 8 7 10 -1 4 -10 -8 -6 -4 0 }
if ($1 = smallRock3) { return -8 -9 -5 -2 -8 5 6 8 9 6 7 -3 9 -9 0 -7 }
}
alias -l OPT.TranslatePolygon {
var %dx = $cos($2).deg , %dy = $sin($2).deg , %ox = $3 , %oy = $4 , %scale = $iif($5,$5,1)
return $regsubex($1,/([^ ]+) ([^ ]+)/g,$calc(((\1 * %dx + \2 * (%dy * -1)) * %scale) + %ox) $calc(((\1 * %dy + \2 * %dx) * %scale) + %oy))
}
alias MslInPoly {
;=== setup variables and complete polygon
var %cn = 0 , %x = $1 , %y = $2 , %size = $0 , %poly = $3- $3-4
if (%size > 2) {
var %i = 0 , %j = %size - 2
while (%i < %j) {
var %ax = $gettok(%poly,$calc(%i + 1),32) , %ay = $gettok(%poly,$calc(%i + 2),32) , %bx = $gettok(%poly,$calc(%i + 3),32) , %by = $gettok(%poly,$calc(%i + 4),32)
;=== Condition1 = Upward Crossing, Condition2 = downward crossing
if (%ay <= %y && %by > %y) || (%ay > %y && %by <= %y) {
;=== Compute the actual edge-ray intersect x-coordinage
var %vt = $calc((%y - %ay) / (%by - %ay))
;=== Test for valid crossing
if (%x < $calc(%ax + %vt * (%bx - %ax))) { inc %cn }
}
inc %i 2
}
}
var %cn = $and(%cn,1)
if (%cn > 0) { return $true }
}
alias MslOnPoly {
;=== Setup variables
var %s1 = $1 , %s2 = $2 , %p1e = $1 * 2 , %p1 = $gettok($3-,$+(1-,%p1e),32) , %p2 = $gettok($3-,$+($calc(%p1e + 1),-),32)
;=== Early escape test, if either polygon is fully contained in the other, any and every point will be inside the other
var %p1x = $gettok(%p1,1,32) , %p1y = $gettok(%p1,2,32) , %p2x = $gettok(%p2,1,32) , %p2y = $gettok(%p2,2,32)
if ($mslInPoly(%p1x,%p1y, [ $regsubex(%p2,/ /g,$chr(44)) ] ) || $mSLInPoly(%p2x,%p2y, [ $regsubex(%p1,/ /g,$chr(44)) ] )) { return $true }
;=== Complete the polygons
var %p1 = %p1 $gettok(%p1,1-2,32) , %p2 = %p2 $gettok(%p2,1-2,32)
;=== Else: Iterate line segments and check for intersection
var %i = 0
while ($calc(%i / 2) < %s1) {
var %p1ax = $gettok(%p1,$calc(%i + 1),32) , %p1ay = $gettok(%p1,$calc(%i + 2),32)
var %p1bx = $gettok(%p1,$calc(%i + 3),32) , %p1by = $gettok(%p1,$calc(%i + 4),32)
var %j = 0
while ($calc(%j / 2) < %s2) {
var %p2ax = $gettok(%p2,$calc(%j + 1),32) , %p2ay = $gettok(%p2,$calc(%j + 2),32)
var %p2bx = $gettok(%p2,$calc(%j + 3),32) , %p2by = $gettok(%p2,$calc(%j + 4),32)
;=== LineSeg to LineSeg intersection test
if ($intersect(%p1ax,%p1ay,%p1bx,%p1by,%p2ax,%p2ay,%p2bx,%p2by,ll)) { return $true }
inc %j 2
}
inc %i 2
}
}