
FB II Compiler
PG PRO
Debugging
Memory
System
Mathematics
Resources
Disk I/O
Windows
Controls
Menus
Mouse
Keyboard
Text
Fonts
Drawing
Sound
Clipboard
Printing
Communication
ASM |
MATHEMATICS
Find point in a line intersecting region
<< Next in my list of things is simply this. I build a region (good old fashion polygon).
assume that we have two points (with a line connecting them). One resides in the region and one is outside the region. In plain English, using 1K words or less, is it possible to tell at what point the line between the two points, meets the edge of the region (and convert or get that point in X/Y coordinates)? >>
In plain English using 0.002K words, yes but. In 1750 characters of obscure dialect (see below), "there's gotta be a better way". The "structure" of this program reminds me of a failed FORTRAN assignment in the days of card punches. Remember card punching? the buzz-saw sound as the card reader ripped through your deck? the hiss of the line printer ejecting 200 blank pages that went on _your_ account? And what about PL/I? (For young 'uns, it was a programming language spelled pee ell slash eye but pronounced, incredibly, pee ell one). Anyway, quaint folksy down-home programming is alive and well; now read on...
COMPILE ,_dimmedVarsOnly
LOCAL FN IsRGBEqual(r1&,r2&)
END FN=(r1&.red%=r2&.red% AND r1&.green%=r2&.green% AND r1&.blue%=r2&.blue%)
LOCAL FN FindIsectLineRgn&(rgnHndl&,startX,startY, finX,finY,@succPtr&)
'trace along the line until we are outside the region
DIM initRGB.6, thisRGB.6, delRGB.6, found%,j,k, thisPt.4
delRGB.red%=0: delRGB.green%=65535: delRGB.blue%=0
CALL GETCPIXEL(startX,startY,initRGB) ' initial point
CALL SETCPIXEL(startX,startY,delRGB) ' "delete" it
found%=_false
WHILE (NOT found%) AND ((startX<>finX) OR (startY<>finY))
FOR j=-1 TO 1
FOR k=-1 TO 1
LONG IF j<>0 OR k<> 0 ' search neighboring pixels
CALL GETCPIXEL(startX+j,startY+k,thisRGB)
LONG IF FN IsRGBEqual(@thisRGB,@initRGB)
startX=startX+j: startY=startY+k
CALL SETPT(thisPt,startX,startY)
LONG IF FN PTINRGN(thisPt,rgnHndl&)
CALL SETCPIXEL(startX,startY,delRGB)
GOTO "Skip"
XELSE
found%=_ztrue ' the end
GOTO "Xit"
END IF
END IF
END IF
NEXT k
NEXT j
PRINT "Should not get here"
"Skip"
WEND
"Xit"
POKE WORD succPtr&,found%
END FN=(startY<<16) OR (startX AND &FFFF)
DIM rgnHndl&, myRect.8, startX,startY, finX,finY,succeed%,pnt&
WINDOW 1
rgnHndl&=FN NEWRGN
LONG IF rgnHndl&
CALL SETRECTRGN(rgnHndl&,10,30,250,250)' simple demo rgn
CALL FRAMERGN(rgnHndl&)
startX=30: startY=50
CALL MOVETO (startX,startY)
finX=290: finY 0
COLOR=_zMagenta ' any unique colour
CALL LINETO(finX,finY) ' draw the line from in to out
COLOR=_zBlack
pnt&=FN FindIsectLineRgn&(rgnHndl&,startX,startY, finX,finY,succeed%)
LONG IF succeed%
PRINT @(0,0) "Intersects at (" FN LOWORD(pnt&)","FN HIWORD(pnt&) ")"
XELSE
PRINT @(0,0)"Failed"
END IF
DO: UNTIL FN BUTTON
CALL CLOSERGN(rgnHndl&)
END IF
A Programming Tutor Comments:
The very first line shows stylistic promise out of keeping with the rest.
Attempted fin-de-siecle humour by use of GOTOs is not appreciated, but this line evoked belly laughs in the Pig & Whistl----I mean the staff common room:
END FN=(startY<<16) OR (startX AND &FFFF)
Grade C- (for effort and a talent for obscure code)
<<COMPILE ,_dimmedVarsOnly
LOCAL FN IsRGBEqual(r1&,r2&)
END FN=(r1&.red%=r2&.red% AND r1&.green%=r2&.green% AND r1&.blue%=r2&.blue%)
LOCAL FN FindIsectLineRgn&(rgnHndl&,startX,startY, finX,finY,@succPtr&)
'trace along the line until we are outside the region >>
I don't have time tonight to try to make this work, but maybe I could suggest a slightly more efficient algorithm that you or Mel can work out.
Instead of tracing along the line pixel by pixel, why not cut the line in half until the segment containing the intersection is reduced to a pixel?
Here's some pseudo-code:
First, make sure startPt& is in Rgn& and finPt& is outside Rgn Then,
DIM midPt&;0,midX,midY 'etc.
WHILE ABS(startX - finX) > 1 OR ABS(startY - finY) > 1
midX = (startX + finX) >> 1 'Find midpoint of line
midY = (startY + finY) >> 1
LONG If FN PTINRGN(Rgn&, midPt&) 'Is it in Rgn&
startPt& = midPt& 'If so, make it new startPt&
XELSE
finPt& = midPt& 'If not, make it new finPt&
END IF
WEND
StartPt& is now the intersection point
I'm guessing this will be a lot faster. Let me know if you get it to work.
|