Line clipping

[tsh73]

That is, given a line and rectangle, get part of the line *in* rectangle.
using the Cohen-Sutherland Algorithm,
en.wikipedia.org/wiki/Cohen%E2%80%93Sutherland_algorithm
converted from C# (source link in code)

The only gripes is very Very VERY long list of arguments I got...

Run it, then click-n-drag to draw a line.
Part inside rectangle will be overdrawn with red.

'Clipping Lines to a Rectangle using the Cohen-Sutherland Algorithm
'traslation to LB from C#
'http://www.richardssoftware.net/2014/07/clipping-lines-to-rectangle-using-cohen.html
'tsh73 Aug 2023

global OutCode.Inside, OutCode.Left, OutCode.Right, OutCode.Bottom, OutCode.Top

OutCode.Inside = 0
OutCode.Left = 1
OutCode.Right = 2
OutCode.Bottom = 4
OutCode.Top = 8

'open GUI
open "Line clipping" for graphics_nsb_nf as #gr
#gr "home; down; posxy cx cy"
#gr "trapclose [quit]"

'register mid rectangle
r.Left=2*cx/3
r.Right=2*cx/3*2
r.Top=2*cy/3
r.Bottom=2*cy/3*2
print "Rectangle (left right top bottom)"
print, r.Left,r.Right,r.Top,r.Bottom

#gr "place ";r.Left;" ";r.Top
#gr "box ";r.Right;" ";r.Bottom

#gr "when leftButtonDown [down]"
#gr "when leftButtonUp [up]"
wait

'then mouseDown startDraw
[down]
p1.X=MouseX
p1.Y=MouseY
wait

'then mouseUp draw line
[up]
p2.X=MouseX
p2.Y=MouseY
print "Line "
print p1.X,p1.Y,p2.X,p2.Y
#gr "color black"
#gr "line ";p1.X;" ";p1.Y; " ";p2.X;" ";p2.Y

call ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, _
accept,  pOut1.X,  pOut1.Y,  pOut2.X, pOut2.Y
if accept=0 then
print ,"No intersect"
else
print ,"Clipped segment"
print pOut1.X,pOut1.Y,pOut2.X,pOut2.Y
#gr "color red"
#gr "line ";pOut1.X;" ";pOut1.Y; " ";pOut2.X;" ";pOut2.Y
end if
wait

[quit]
   timer 0
   close #gr
   end


'=======================================================================
' functions for line clipping
'top level is
'sub ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, byRef accept, byRef pOut1.X, byRef pOut1.Y, byRef pOut2.X, byRef pOut2.Y

function ComputeOutCode(x, y, r.Left, r.Right, r.Top, r.Bottom)
   code = OutCode.Inside

   if (x < r.Left) then code = code OR OutCode.Left
   if (x > r.Right) then code = code OR OutCode.Right
   if (y < r.Top) then code = code OR OutCode.Top
   if (y > r.Bottom) then code = code OR OutCode.Bottom

   ComputeOutCode = code
end function

sub CalculateIntersection r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, clipTo, byRef pOut.X, byRef pOut.Y
   dx = (p2.X - p1.X)
   dy = (p2.Y - p1.Y)

'against div by 0 exceptions
slopeY = 1e10
if dy<>0 then slopeY = dx / dy '; // slope to use for possibly-vertical lines
slopeX = 1e10
if dx<>0 then slopeX = dy / dx '; // slope to use for possibly-horizontal lines

   if (clipTo AND OutCode.Top) then
       pOut.X=p1.X + slopeY * (r.Top - p1.Y)
       pOut.Y=r.Top
       exit sub
   end if
   if (clipTo AND OutCode.Bottom) then
pOut.X=p1.X + slopeY * (r.Bottom - p1.Y)
pOut.Y=r.Bottom
       exit sub
   end if
   if (clipTo AND OutCode.Right) then
pOut.X=r.Right
pOut.Y=p1.Y + slopeX * (r.Right - p1.X)
       exit sub
   end if
   if (clipTo AND OutCode.Left) then
pOut.X=r.Left
pOut.Y=p1.Y + slopeX * (r.Left - p1.X)
       exit sub
   end if
   'throw new ArgumentOutOfRangeException("clipTo = " + clipTo);
end sub

'top level function
sub ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, byRef accept, byRef pOut1.X, byRef pOut1.Y, byRef pOut2.X, byRef pOut2.Y
   'classify the endpoints of the line
   outCodeP1 = ComputeOutCode(p1.X,p1.Y, r.Left, r.Right, r.Top, r.Bottom)
   outCodeP2 = ComputeOutCode(p2.X,p2.Y, r.Left, r.Right, r.Top, r.Bottom)
   accept = 0
           
   while (1)  '// should only iterate twice, at most
       '// Case 1:
       '// both endpoints are within the clipping region
       if ((outCodeP1 OR outCodeP2) = OutCode.Inside) then
           accept = 1
           exit while
       end if

       '// Case 2:
       '// both endpoints share an excluded region, impossible for a line between them to be within the clipping region
       if ((outCodeP1 AND outCodeP2) <> 0) then
           exit while
       end if

       '// Case 3:
       '// The endpoints are in different regions, and the segment is partially within the clipping rectangle

       '// Select one of the endpoints outside the clipping rectangle
       'var outCode = outCodeP1 != OutCode.Inside ? outCodeP1 : outCodeP2;
if outCodeP1 <> OutCode.Inside then outCode = outCodeP1 else outCode = outCodeP2

       '// calculate the intersection of the line with the clipping rectangle
       'var p = CalculateIntersection(r, p1, p2, outCode);
call CalculateIntersection r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, outCode, p.X, p.Y

       '// update the point after clipping and recalculate outcode
       if (outCode = outCodeP1) then
           p1.X = p.X
p1.Y = p.Y
           outCodeP1 = ComputeOutCode(p1.X, p1.Y, r.Left, r.Right, r.Top, r.Bottom)
       else
           p2.X = p.X
p2.Y = p.Y
           outCodeP2 = ComputeOutCode(p2.X, p2.Y, r.Left, r.Right, r.Top, r.Bottom)
       end if
   wend
   '// if clipping area contained a portion of the line
   if (accept) then
       'return new Tuple<PointF, PointF>(p1, p2);
pOut1.X=p1.X
pOut1.Y=p1.Y
pOut2.X=p2.X
pOut2.Y=p2.Y
   end if
'else nothing
   '// the line did not intersect the clipping area
   'return null;
end sub

[plus]

Fixed to what I expected for clipping a line. Keep the innards and lose the outers.
'Clipping Lines to a Rectangle using the Cohen-Sutherland Algorithm
'traslation to LB from C#
'http://www.richardssoftware.net/2014/07/clipping-lines-to-rectangle-using-cohen.html
'tsh73 Aug 2023

global OutCode.Inside, OutCode.Left, OutCode.Right, OutCode.Bottom, OutCode.Top

OutCode.Inside = 0
OutCode.Left = 1
OutCode.Right = 2
OutCode.Bottom = 4
OutCode.Top = 8

'open GUI
open "Line clipping" for graphics_nsb_nf as #gr
#gr "home; down; posxy cx cy"
#gr "trapclose [quit]"

'register mid rectangle
r.Left=2*cx/3
r.Right=2*cx/3*2
r.Top=2*cy/3
r.Bottom=2*cy/3*2
print "Rectangle (left right top bottom)"
print, r.Left,r.Right,r.Top,r.Bottom

#gr "place ";r.Left;" ";r.Top
#gr "box ";r.Right;" ";r.Bottom

#gr "when leftButtonDown [down]"
#gr "when leftButtonUp [up]"
wait

'then mouseDown startDraw
[down]
   p1.X=MouseX
   p1.Y=MouseY
wait

'then mouseUp draw line
[up]
   p2.X=MouseX
   p2.Y=MouseY
   print "Line "
   print p1.X,p1.Y,p2.X,p2.Y
   #gr "color black"
   #gr "line ";p1.X;" ";p1.Y; " ";p2.X;" ";p2.Y

   call ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, _
       accept,  pOut1.X,  pOut1.Y,  pOut2.X, pOut2.Y
   if accept=0 then
       print ,"No intersect"
   else
       print ,"Clipped segment"
       print pOut1.X,pOut1.Y,pOut2.X,pOut2.Y
       #gr "color white"
       #gr "size 3"
       #gr "line ";p1.X;" ";p1.Y; " ";pOut1.X;" ";pOut1.Y
       #gr "line ";pOut2.X;" ";pOut2.Y; " ";p2.X;" ";p2.Y
       #gr "size 1"
   end if
wait

[quit]
   timer 0
   close #gr
   end


'=======================================================================
' functions for line clipping
'top level is
'sub ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, byRef accept, byRef pOut1.X, byRef pOut1.Y, byRef pOut2.X, byRef pOut2.Y

function ComputeOutCode(x, y, r.Left, r.Right, r.Top, r.Bottom)
   code = OutCode.Inside

   if (x < r.Left)     then code = code OR OutCode.Left
   if (x > r.Right)     then code = code OR OutCode.Right
   if (y < r.Top)         then code = code OR OutCode.Top
   if (y > r.Bottom)     then code = code OR OutCode.Bottom

   ComputeOutCode = code
end function

sub CalculateIntersection r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, clipTo, byRef pOut.X, byRef pOut.Y
   dx = (p2.X - p1.X)
   dy = (p2.Y - p1.Y)

   'against div by 0 exceptions
   slopeY = 1e10
   if dy<>0 then slopeY = dx / dy    '; // slope to use for possibly-vertical lines
   slopeX = 1e10
   if dx<>0 then slopeX = dy / dx    '; // slope to use for possibly-horizontal lines

   if (clipTo AND OutCode.Top) then
       pOut.X=p1.X + slopeY * (r.Top - p1.Y)
       pOut.Y=r.Top
       exit sub
   end if
   if (clipTo AND OutCode.Bottom) then
       pOut.X=p1.X + slopeY * (r.Bottom - p1.Y)
       pOut.Y=r.Bottom
       exit sub
   end if
   if (clipTo AND OutCode.Right) then
       pOut.X=r.Right
       pOut.Y=p1.Y + slopeX * (r.Right - p1.X)
       exit sub
   end if
   if (clipTo AND OutCode.Left) then
       pOut.X=r.Left
       pOut.Y=p1.Y + slopeX * (r.Left - p1.X)
       exit sub
   end if
   'throw new ArgumentOutOfRangeException("clipTo = " + clipTo);
end sub

'top level function
sub ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, byRef accept, byRef pOut1.X, byRef pOut1.Y, byRef pOut2.X, byRef pOut2.Y
   'classify the endpoints of the line
   outCodeP1 = ComputeOutCode(p1.X,p1.Y, r.Left, r.Right, r.Top, r.Bottom)
   outCodeP2 = ComputeOutCode(p2.X,p2.Y, r.Left, r.Right, r.Top, r.Bottom)
   accept = 0

   while (1)  '// should only iterate twice, at most
       '// Case 1:
       '// both endpoints are within the clipping region
       if ((outCodeP1 OR outCodeP2) = OutCode.Inside) then
           accept = 1
           exit while
       end if

       '// Case 2:
       '// both endpoints share an excluded region, impossible for a line between them to be within the clipping region
       if ((outCodeP1 AND outCodeP2) <> 0) then
           exit while
       end if

       '// Case 3:
       '// The endpoints are in different regions, and the segment is partially within the clipping rectangle

       '// Select one of the endpoints outside the clipping rectangle
       'var outCode = outCodeP1 != OutCode.Inside ? outCodeP1 : outCodeP2;
       if outCodeP1 <> OutCode.Inside then outCode = outCodeP1 else outCode = outCodeP2

       '// calculate the intersection of the line with the clipping rectangle
       'var p = CalculateIntersection(r, p1, p2, outCode);
       call CalculateIntersection r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, outCode, p.X, p.Y

       '// update the point after clipping and recalculate outcode
       if (outCode = outCodeP1) then
           p1.X = p.X
           p1.Y = p.Y
           outCodeP1 = ComputeOutCode(p1.X, p1.Y, r.Left, r.Right, r.Top, r.Bottom)
       else
           p2.X = p.X
           p2.Y = p.Y
           outCodeP2 = ComputeOutCode(p2.X, p2.Y, r.Left, r.Right, r.Top, r.Bottom)
       end if
   wend
   '// if clipping area contained a portion of the line
   if (accept) then
       'return new Tuple<PointF, PointF>(p1, p2);
       pOut1.X=p1.X
       pOut1.Y=p1.Y
       pOut2.X=p2.X
       pOut2.Y=p2.Y
   end if
   'else nothing
   '// the line did not intersect the clipping area
   'return null;
end sub


tsh73 this is very interesting code! Thanks

b = b + ...

[tsh73]

Re: very Very VERY long list of arguments
I rewrote it with strings mimicking line/rectangle (4 numbers) and point (2 numbers)
This way argument list is much smaller, and I can return point/line - use string function ($), no need to use SUB with several byRef parameters. Sure looks nicer.
But works 50% slower ;(
But sometimes it might still be fast enough.

Comment out
drawWhileTest=1
line to measure checking time, without drawing.

'Clipping Lines to a Rectangle using the Cohen-Sutherland Algorithm
'translation to LB from C#
'http://www.richardssoftware.net/2014/07/clipping-lines-to-rectangle-using-cohen.html
'tsh73 Aug 2023

'v4 speed
'~2200 checks, 1500 with draw
'LBB 7980 checks, 1500 draw
'v5
'trying a bit of speed up (current 2300 checks per sec)
' make that rectangle global
' alas, it goes 10% slower in JB but 10% faster in LBB (???)
'v6
' now try to use strings with numbers (rect,line, point) instead of lots of numbers
'it works, it looks nicer, but - about 50% slower
' without/with drawing 1200/1000, LBB 1600/904

global OutCode.Inside, OutCode.Left, OutCode.Right, OutCode.Bottom, OutCode.Top 'bit constants
global ClipRect.Left,ClipRect.Right,ClipRect.Top,ClipRect.Bottom

OutCode.Inside = 0
OutCode.Left = 1
OutCode.Right = 2
OutCode.Bottom = 4
OutCode.Top = 8

drawWhileTest=1

'open GUI
open "Line clipping" for graphics_nsb_nf as #gr
#gr "home; down; posxy cx cy"
#gr "trapclose [quit]"

'register mid rectangle
r.Left=2*cx/3
r.Right=2*cx/3*2
r.Top=2*cy/3
r.Bottom=2*cy/3*2
print "Rectangle (left top right bottom)"
r$=r.Left;" ";r.Top;" ";r.Right;" ";r.Bottom
print, r$

#gr "place ";r.Left;" ";r.Top
#gr "box ";r.Right;" ";r.Bottom

#gr "when leftButtonDown [down]"
#gr "when leftButtonUp [up]"
'wait

k=0
timer 1000, [over]
[again]
SCAN
k=k+1
p1.X=int(rnd(0)*2*cx)
p1.Y=int(rnd(0)*2*cy)
p2.X=int(rnd(0)*2*cx)
p2.Y=int(rnd(0)*2*cy)


p1$=p1.X;" ";p1.Y
p2$=p2.X;" ";p2.Y

lin2$=ClipSegment$( r$, p1$, p2$)
'print lin2$
'wait

if drawWhileTest then
lin1$=p1$;" ";p2$
#gr "color black"
#gr "line ";lin1$
if lin2$<>"" then
#gr "color red"
#gr "line ";lin2$
end if
end if
goto [again]

[over]
timer 0
notice "K checks per second, ";k
wait

'when mouseDown startDraw
[down]
p1.X=MouseX
p1.Y=MouseY
wait

'when mouseUp draw line
[up]
p2.X=MouseX
p2.Y=MouseY

p1$=p1.X;" ";p1.Y
p2$=p2.X;" ";p2.Y
lin1$=p1$;" ";p2$

print "Line "
print lin1$
#gr "color black"
#gr "line ";lin1$

lin2$=ClipSegment$( r$, p1$, p2$)

if lin2$=""  then
print ,"No intersect"
else
print ,"Clipped segment"
print lin2$
#gr "color red"
#gr "line ";lin2$
end if
wait

[quit]
   timer 0
   close #gr
   end


'=======================================================================
' functions for line clipping
'top level is
'sub ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, byRef accept, byRef pOut1.X, byRef pOut1.Y, byRef pOut2.X, byRef pOut2.Y

function ComputeOutCode(pt$)
'uses global ClipRect.* instead of r.Left, r.Right, r.Top, r.Bottom
   code = OutCode.Inside
x=val(word$(pt$,1))
y=val(word$(pt$,2))

   if (x < ClipRect.Left) then code = code OR OutCode.Left
   if (x > ClipRect.Right) then code = code OR OutCode.Right
   if (y < ClipRect.Top) then code = code OR OutCode.Top
   if (y > ClipRect.Bottom) then code = code OR OutCode.Bottom

   ComputeOutCode = code
end function

function CalculateIntersection$( p1$, p2$, clipTo)
'uses global ClipRect.* instead of r.Left, r.Right, r.Top, r.Bottom
p1.X=val(word$(p1$,1))
p1.Y=val(word$(p1$,2))
p2.X=val(word$(p2$,1))
p2.Y=val(word$(p2$,2))
   dx = (p2.X - p1.X)
   dy = (p2.Y - p1.Y)

'against div by 0 exceptions
slopeY = 1e10
if dy<>0 then slopeY = dx / dy '; // slope to use for possibly-vertical lines
slopeX = 1e10
if dx<>0 then slopeX = dy / dx '; // slope to use for possibly-horizontal lines

   if (clipTo AND OutCode.Top) then
       pOut.X=p1.X + slopeY * (ClipRect.Top - p1.Y)
       pOut.Y=ClipRect.Top
CalculateIntersection$=pOut.X;" ";pOut.Y
       exit function
   end if
   if (clipTo AND OutCode.Bottom) then
pOut.X=p1.X + slopeY * (ClipRect.Bottom - p1.Y)
pOut.Y=ClipRect.Bottom
CalculateIntersection$=pOut.X;" ";pOut.Y
       exit function
   end if
   if (clipTo AND OutCode.Right) then
pOut.X=ClipRect.Right
pOut.Y=p1.Y + slopeX * (ClipRect.Right - p1.X)
CalculateIntersection$=pOut.X;" ";pOut.Y
       exit function
   end if
   if (clipTo AND OutCode.Left) then
pOut.X=ClipRect.Left
pOut.Y=p1.Y + slopeX * (ClipRect.Left - p1.X)
CalculateIntersection$=pOut.X;" ";pOut.Y
       exit function
   end if
   'throw new ArgumentOutOfRangeException("clipTo = " + clipTo);
end function

'top level function
function ClipSegment$( r$, p1$, p2$)
ClipRect.Left=val(word$(r$,1))
ClipRect.Top=val(word$(r$,2))
ClipRect.Right=val(word$(r$,3))
ClipRect.Bottom =val(word$(r$,4))
   'classify the endpoints of the line
   outCodeP1 = ComputeOutCode(p1$)
   outCodeP2 = ComputeOutCode(p2$)
   accept = 0
           
   while (1)  '// should only iterate twice, at most
       '// Case 1:
       '// both endpoints are within the clipping region
       if ((outCodeP1 OR outCodeP2) = OutCode.Inside) then
           accept = 1
           exit while
       end if

       '// Case 2:
       '// both endpoints share an excluded region, impossible for a line between them to be within the clipping region
       if ((outCodeP1 AND outCodeP2) <> 0) then
           exit while
       end if

       '// Case 3:
       '// The endpoints are in different regions, and the segment is partially within the clipping rectangle

       '// Select one of the endpoints outside the clipping rectangle
       'var outCode = outCodeP1 != OutCode.Inside ? outCodeP1 : outCodeP2;
if outCodeP1 <> OutCode.Inside then outCode = outCodeP1 else outCode = outCodeP2

       '// calculate the intersection of the line with the clipping rectangle
       'var p = CalculateIntersection(r, p1, p2, outCode);
p$= CalculateIntersection$( p1$, p2$, outCode)

       '// update the point after clipping and recalculate outcode
       if (outCode = outCodeP1) then
           p1$ = p$
           outCodeP1 = ComputeOutCode(p1$)
       else
           p2$ = p$
           outCodeP2 = ComputeOutCode(p2$)
       end if
   wend
   '// if clipping area contained a portion of the line
   if (accept) then
       'return new Tuple<PointF, PointF>(p1, p2);
ClipSegment$=p1$;" ";p2$
   end if
'else nothing
   '// the line did not intersect the clipping area
   'return null;
end function


[tsh73]

Trying to keep simplicity of string version
(ease of use, mostly)
with speed of numbers version ;)

'Clipping Lines to a Rectangle using the Cohen-Sutherland Algorithm
'translation to LB from C#
'http://www.richardssoftware.net/2014/07/clipping-lines-to-rectangle-using-cohen.html
'tsh73 Aug 2023

'sept 2023
'trying to make it better while keeping fast
'use global clipRect, set in separate sub (single assignment, multiple use)

'on a fast machine
'strings version 2810/3549 (https://justbasiccom.proboards.com/thread/1035/line-clipping post 3)
'this version 4277/6350

global OutCode.Inside, OutCode.Left, OutCode.Right, OutCode.Bottom, OutCode.Top
global ClipRect.Left,ClipRect.Right,ClipRect.Top,ClipRect.Bottom


OutCode.Inside = 0
OutCode.Left = 1
OutCode.Right = 2
OutCode.Bottom = 4
OutCode.Top = 8

drawWhileTest=1

'open GUI
open "Line clipping" for graphics_nsb_nf as #gr
#gr "home; down; posxy cx cy"
#gr "trapclose [quit]"

'register mid rectangle
r.Left=2*cx/3
r.Right=2*cx/3*2
r.Top=2*cy/3
r.Bottom=2*cy/3*2
print "Rectangle (left top right bottom)"
r$=r.Left;" ";r.Top;" ";r.Right;" ";r.Bottom
print, r$
call SetClipRect r.Left,r.Top,r.Right,r.Bottom

#gr "place ";r.Left;" ";r.Top
#gr "box ";r.Right;" ";r.Bottom

#gr "when leftButtonDown [down]"
#gr "when leftButtonUp [up]"

'wait

k=0
timer 1000, [over]
[again]
   SCAN
   k=k+1
   p1.X=int(rnd(0)*2*cx)
   p1.Y=int(rnd(0)*2*cy)
   p2.X=int(rnd(0)*2*cx)
   p2.Y=int(rnd(0)*2*cy)


   p1$=p1.X;" ";p1.Y
   p2$=p2.X;" ";p2.Y

   lin2$=ClipSegment$(p1.X,p1.Y, p2.X,p2.Y)
   'print lin2$
   'wait

   if drawWhileTest then
       lin1$=p1$;" ";p2$
       #gr "color black"
       #gr "line ";lin1$
       if lin2$<>"" then
           #gr "color red"
           #gr "line ";lin2$
       end if
   end if
goto [again]

[over]
   timer 0
   notice "K checks per second, ";k
   #gr "home"
   #gr "\Press a key to clear"
   #gr "\then drad to draw line"
   #gr "when characterInput [cls]"
   #gr "setfocus"
wait

[cls]
   #gr "cls"
   #gr "place ";r.Left;" ";r.Top
   #gr "box ";r.Right;" ";r.Bottom
wait

'then mouseDown startDraw
[down]
   p1.X=MouseX
   p1.Y=MouseY
wait

'then mouseUp draw line
[up]
   p2.X=MouseX
   p2.Y=MouseY
   print "Line "
   print p1.X,p1.Y,p2.X,p2.Y
   #gr "color black"
   #gr "line ";p1.X;" ";p1.Y; " ";p2.X;" ";p2.Y

   lin2$=ClipSegment$(p1.X,p1.Y, p2.X,p2.Y)
   if lin2$="" then
       print ,"No intersect"
   else
       print ,"Clipped segment"
       print lin2$
       #gr "color red"
       #gr "line ";lin2$
   end if
wait

[quit]
   timer 0
   close #gr
   end


'=======================================================================
' functions for line clipping
'top level is
'sub ClipSegment r.Left,r.Right,r.Top,r.Bottom, p1.X,p1.Y, p2.X,p2.Y, byRef accept, byRef pOut1.X, byRef pOut1.Y, byRef pOut2.X, byRef pOut2.Y

sub SetClipRect x1, y1, x2, y2
   ClipRect.Left    =x1
   ClipRect.Top    =y1
   ClipRect.Right    =x2
   ClipRect.Bottom =y2
end sub

function ComputeOutCode(x, y)
'uses global ClipRect.*
   code = OutCode.Inside

   if (x < ClipRect.Left)     then code = code OR OutCode.Left
   if (x > ClipRect.Right)     then code = code OR OutCode.Right
   if (y < ClipRect.Top)         then code = code OR OutCode.Top
   if (y > ClipRect.Bottom)     then code = code OR OutCode.Bottom

   ComputeOutCode = code
end function

sub CalculateIntersection p1.X,p1.Y, p2.X,p2.Y, clipTo, byRef pOut.X, byRef pOut.Y
'uses global ClipRect.*
   dx = (p2.X - p1.X)
   dy = (p2.Y - p1.Y)

   'against div by 0 exceptions
   slopeY = 1e10
   if dy<>0 then slopeY = dx / dy    '; // slope to use for possibly-vertical lines
   slopeX = 1e10
   if dx<>0 then slopeX = dy / dx    '; // slope to use for possibly-horizontal lines

   if (clipTo AND OutCode.Top) then
       pOut.X=p1.X + slopeY * (ClipRect.Top - p1.Y)
       pOut.Y=ClipRect.Top
       exit sub
   end if
   if (clipTo AND OutCode.Bottom) then
       pOut.X=p1.X + slopeY * (ClipRect.Bottom - p1.Y)
       pOut.Y=ClipRect.Bottom
       exit sub
   end if
   if (clipTo AND OutCode.Right) then
       pOut.X=ClipRect.Right
       pOut.Y=p1.Y + slopeX * (ClipRect.Right - p1.X)
       exit sub
   end if
   if (clipTo AND OutCode.Left) then
       pOut.X=ClipRect.Left
       pOut.Y=p1.Y + slopeX * (ClipRect.Left - p1.X)
       exit sub
   end if
   'throw new ArgumentOutOfRangeException("clipTo = " + clipTo);
end sub

'top level function
function ClipSegment$(p1.X,p1.Y, p2.X,p2.Y)
   'classify the endpoints of the line
   outCodeP1 = ComputeOutCode(p1.X,p1.Y)
   outCodeP2 = ComputeOutCode(p2.X,p2.Y)
   accept = 0

   while (1)  '// should only iterate twice, at most
       '// Case 1:
       '// both endpoints are within the clipping region
       if ((outCodeP1 OR outCodeP2) = OutCode.Inside) then
           accept = 1
           exit while
       end if

       '// Case 2:
       '// both endpoints share an excluded region, impossible for a line between them to be within the clipping region
       if ((outCodeP1 AND outCodeP2) <> 0) then
           exit while
       end if

       '// Case 3:
       '// The endpoints are in different regions, and the segment is partially within the clipping rectangle

       '// Select one of the endpoints outside the clipping rectangle
       'var outCode = outCodeP1 != OutCode.Inside ? outCodeP1 : outCodeP2;
       if outCodeP1 <> OutCode.Inside then outCode = outCodeP1 else outCode = outCodeP2

       '// calculate the intersection of the line with the clipping rectangle
       'var p = CalculateIntersection(r, p1, p2, outCode);
       call CalculateIntersection p1.X,p1.Y, p2.X,p2.Y, outCode, p.X, p.Y

       '// update the point after clipping and recalculate outcode
       if (outCode = outCodeP1) then
           p1.X = p.X
           p1.Y = p.Y
           outCodeP1 = ComputeOutCode(p1.X, p1.Y)
       else
           p2.X = p.X
           p2.Y = p.Y
           outCodeP2 = ComputeOutCode(p2.X, p2.Y)
       end if
   wend
   '// if clipping area contained a portion of the line
   if (accept) then
       'return new Tuple<PointF, PointF>(p1, p2);
       'three variants:
       'as is
       'ClipSegment$ = p1.X;" ";p1.Y ;" "; p2.X;" ";p2.Y
       'this one should be faster
       ClipSegment$ = int(p1.X);" ";int(p1.Y) ;" "; int(p2.X);" ";int(p2.Y)
       'this might be rounded better - better looking (?)
       'ClipSegment$ = int(p1.X)+.5;" ";int(p1.Y)+.5 ;" "; int(p2.X)+.5;" ";int(p2.Y)+.5
   end if
   'else nothing
   '// the line did not intersect the clipping area
   'return null;
end function