Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Beginner's GRAPHICS

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Beginner's GRAPHICS

    After discussion at: http://www.powerbasic.com/support/pb...ad.php?t=39099, I decided to post the code I've been using to learn.

    The purpose of the program I'm posting here was to get me started with GRAPHICS statements. I've never used them before, and I wanted to see what was involved.

    I quickly found that in order to use the GRAPHIC PAINT statement, I needed to provide a point inside the shape, and it took a bit of brushing up on geometry and trig to do it. I think I came up with some interesting stuff...??

    Thus, I'm sharing my "sandbox code" with other beginners who might find some of my approaches interesting, and hopefully useful. My program is simplistic, and is nothing like Patrice Terrier's graphics powerhouse. (See link in discussion thread.)

    My program uses Paul Dixon's intersect function, but I had to create a wrapper function in order to cast my SINGLEs to his DOUBLEs... I know it's availble elsewhere on this site, but I post here below my program for convenience.

    Thanks to all who helped guide me. Let me know (in the discussion thread) what you like (or don't) about it.

    -John

    Code:
    'jmGraphicsTest1.bas
    '------------------------------------------------------------------------------------------------------
    ' Learning to use GRAPHICS statements, and to develop related math functions...
    '------------------------------------------------------------------------------------------------------
    ' Most of this program came about because I wanted to be certain that I could reliably
    '  provide the GRAPHIC PAINT statement with a start point inside the shape.
    '------------------------------------------------------------------------------------------------------
    ' This is NOT intended to be a finished product, just a beginner's playground.
    ' Never-the-less, there are lots of little things here that could be useful!
    ' For example:
    '   - the "Set_(shape)_Properties" routines,
    '   - the "FindPointIn_(shape)_" routines,
    ' but especially:
    '   - the "AngleOppSideC" function!
    '------------------------------------------------------------------------------------------------------
    ' PBMAIN begins with the presumption that the only user-supplied inputs are the points of the shape.
    ' My initial concern was simply to drive the "FindPointIn..." function calls. Thus the scruffy design...
    '------------------------------------------------------------------------------------------------------
    ' I admit upfront that my use of Macros, Types and members, and param passing are not ideal.
    ' I'm just learning them or variations of them, and I tried a mix of styles to get things to work...
    ' ...Please be kind.
    '------------------------------------------------------------------------------------------------------
    
    #COMPILER PBCC  'only because of the PRINT statements; can convert easily to PBWin...
    #COMPILE EXE
    #DIM ALL
    #INCLUDE ONCE "win32api.inc"
    
    'for controlling testing during development:
    '%ppts = 5 'polygon
    '%ppts = 4 'let's try a quadrilateral...
    %ppts = 3 'triangle - got this working great now!
    
    %MaxPoints = 10
    
    MACRO Pi = 3.141592653589793##
    MACRO DegreesToRadians(dpDegrees) = (dpDegrees * 0.0174532925199433##)
    MACRO RadiansToDegrees(dpRadians) = (dpRadians * 57.29577951308232##)
    MACRO ST(mItem) = TRIM$(STR$(mItem))
    
    TYPE PolyPoint
      x AS SINGLE
      y AS SINGLE
    END TYPE
    
    TYPE grphStraightLine
       p1 AS PolyPoint      'required: some point that is on the line
       p2 AS PolyPoint      'required: some other point that is on the line
       SegLen AS SINGLE
       Rise   AS SINGLE
       Run    AS SINGLE
       Slope  AS SINGLE
       ID AS STRING * 15    ' for internal naming
    END TYPE
    
    TYPE PolyArray    'a general, all-purpose, non-specialized place to hold coordinate points...
      COUNT AS LONG
      xy(1 TO %MaxPoints) AS PolyPoint  'how to redim dynamically? Can't, but seems that extras aren't harmful
      Other AS STRING * 15  '
    END TYPE
    
    TYPE grphTriangle
       Points AS PolyArray      ' general points-list; allows easy startup; not used later...
       S12 AS grphStraightLine  'Side
       S23 AS grphStraightLine  'Side
       S13 AS grphStraightLine  'Side
       AO12 AS SINGLE           'Angle that is opposite S12
       AO23 AS SINGLE           'Angle that is opposite S23
       AO13 AS SINGLE           'Angle that is opposite S13
       Centroid AS PolyPoint'intersection of medians
       TriangleClassA AS STRING *  7  'Classification based on Angles
       TriangleClassS AS STRING * 11  'Classification based on Sides
       ' class strings are long accomodate full text descriptors
       '  (if we stored only the first char, we'd need programatic interpretations later)
       ID AS STRING * 15              ' for internal naming
    END TYPE
    
    'this is a good generalized abstraction. we could actually handle triangles with it. maybe even lines???
    TYPE grphPolygon
       COUNT AS LONG                            'MAX is %MaxPoints, as in following statements...
       Points (1 TO %MaxPoints) AS PolyPoint           ' PolygonName.Points.xy(1).x
       Sides  (1 TO %MaxPoints) AS grphStraightLine    '
       Angles (1 TO %MaxPoints) AS SINGLE              '
       Centroid AS PolyPoint                    '
       PolygonClassA AS STRING * 15             'for a technical external descriptor (concave, etc)
       ID AS STRING * 15                        ' for internal naming
    END TYPE
    '==============================================================================
    
    '============
    'SUBROUTINES:
    '============
    #INCLUDE ONCE "INTERSECT1.inc"
    '-----------------------   Initialization   --------------------
    SUB SetPlotPoints(BYREF PlotPoints AS PolyArray)
       'sets up coordinate points for triangle or polygon in the general points-list (like a global...)
    #IF %ppts = 3
       'triangle
       #DEBUG PRINT "PPTS -- " & ST(%ppts)
       PlotPoints.Count = 3
       PlotPoints.xy(1).x =   5 : PlotPoints.xy(1).y =  10
    '   PlotPoints.xy(2).x =  20 : PlotPoints.xy(2).y = 110     'ORIG  ' change the angle to test my CosC calc...
       PlotPoints.xy(2).x =  20 : PlotPoints.xy(2).y =  80     'to make a REALLY obtuse angle...
       PlotPoints.xy(3).x = 125 : PlotPoints.xy(3).y = 100
    
    '   'for testing, we create a triangle of common dimensions: 3, 4, 5
    '   PlotPoints.xy(1).x =  10 : PlotPoints.xy(1).y =  10                      's/b 200 long  5 x 40
    '   PlotPoints.xy(2).x =  10 : PlotPoints.xy(2).y = 130   '120 high  3 x 40
    '   PlotPoints.xy(3).x = 170 : PlotPoints.xy(3).y = 130   '160 wide  4 x 40
    #ELSEIF %ppts = 4
       'quadrilateral
       #DEBUG PRINT "PPTS -- " & ST(%ppts)
       PlotPoints.Count = 4
    '   PlotPoints.xy(1).x =   5 : PlotPoints.xy(1).y =  10
    '   PlotPoints.xy(2).x =  20 : PlotPoints.xy(2).y = 110
    '   PlotPoints.xy(3).x =  80 : PlotPoints.xy(3).y = 125
    '   PlotPoints.xy(4).x = 125 : PlotPoints.xy(4).y = 100
    
       PlotPoints.xy(1).x =  10 : PlotPoints.xy(1).y =  10
       PlotPoints.xy(2).x =   5 : PlotPoints.xy(2).y = 120
    '   PlotPoints.xy(3).x = 120 : PlotPoints.xy(3).y =  10  'hmm... "bowtie effect"
    '   PlotPoints.xy(4).x = 125 : PlotPoints.xy(4).y = 120
    'shows as "bowtie", so let's switch 2 points...   (line segs are drawn in the order given...)
       PlotPoints.xy(3).x = 125 : PlotPoints.xy(3).y = 120
       PlotPoints.xy(4).x = 120 : PlotPoints.xy(4).y =  10
    'Yes! that did the trick...
    
    #ELSEIF %ppts = 5
       'polygon
       #DEBUG PRINT "PPTS -- " & ST(%ppts)
       PlotPoints.Count = 5
       PlotPoints.xy(1).x =   5 : PlotPoints.xy(1).y =  10
       PlotPoints.xy(2).x =  20 : PlotPoints.xy(2).y = 110
       PlotPoints.xy(3).x =  80 : PlotPoints.xy(3).y = 125
       PlotPoints.xy(4).x = 125 : PlotPoints.xy(4).y = 100
    '   PlotPoints.xy(5).x = 110 : PlotPoints.xy(5).y =  25
       PlotPoints.xy(5).x =  40 : PlotPoints.xy(5).y =  55
    #ELSE
       #DEBUG PRINT "PPTS -- " & ST(%ppts)
    #ENDIF
    END SUB
    
    '------------------------   Set Properties functions   -----------------------
    FUNCTION SetLineProperties (BYREF Line1 AS grphStraightLine) AS SINGLE
       'Given only the x,y coords of a line segment's 2 endpoints, we calc its slope and length...
       '
       ' This employs the pythagorean theorem, by means of an imaginary right triangle...
       ' We create an imaginary a point near the line that has the X of the first point and the Y of the second.
       '    RightAngle.x = X1
       '    RightAngle.y = Y2
       '
       ' Just for reference - the slope formula is:  m = (y2-y1)/(x2-x1)
       '
       LOCAL AdjacentSide, OppositeSide AS SINGLE
    
       AdjacentSide = Line1.p2.x - Line1.p1.x
       OppositeSide = Line1.p2.y - Line1.p1.y
    
       Line1.Rise    = OppositeSide                   ' rise  = the diffs in Y
       Line1.Run     = AdjacentSide                   ' run   = the diffs in X
       Line1.Slope   = Line1.Rise / Line1.Run         ' slope = rise/run
       Line1.SegLen = ABS(SQR((AdjacentSide * AdjacentSide) + (OppositeSide * OppositeSide))) 'C = sqrt (A^2 + B^2)
       #DEBUG PRINT "Rise   Run   Slope   SegLen -- " & ST(Line1.Rise) & "  " & ST(Line1.Run) & "  " & ST(Line1.Slope) & "  " & ST(Line1.SegLen)
       FUNCTION = Line1.SegLen  'this seems the most useful return value...
    END FUNCTION
    
    SUB SetTriangleProperties (BYREF This AS grphTriangle)
    'Receive a triangle with the Points filled in, and we'll do the rest...
    '
       LOCAL lRet AS LONG
       LOCAL LargestSide, LargestAngle, SecondLargestAngle, SmallestAngle AS SINGLE
    
       '================
       'Solve the Sides:
       '================
       'Transfer the given points-list into the triangle's explicit members, then do calcs
       This.S12.p1 = This.Points.xy(1)
       This.S12.p2 = This.Points.xy(2)
       lRet = SetLineProperties (This.S12)
       #DEBUG PRINT "This.S12 - Slope and Length --            " & ST(This.S12.Slope) & "  " & ST(This.S12.SegLen)
    
       This.S23.p1 = This.Points.xy(2)
       This.S23.p2 = This.Points.xy(3)
       lRet = SetLineProperties (This.S23)
       #DEBUG PRINT "This.S23 - Slope and Length --            " & ST(This.S23.Slope) & "  " & ST(This.S23.SegLen)
    
       This.S13.p1 = This.Points.xy(1)
       This.S13.p2 = This.Points.xy(3)
       lRet = SetLineProperties (This.S13)
       #DEBUG PRINT "This.S13 - Slope and Length --            " & ST(This.S13.Slope) & "  " & ST(This.S13.SegLen)
    
       '=================
       'Solve the Angles:
       '=================
       'Select the side having the longest length in order to see if we're working with an obtuse angle...
       '  (thus, opposite the largest angle)  Why?  From the Note in the box under Step 1 on:
       '+++++++++++++   http://www.teacherschoice.com.au/Maths_Library/Trigonometry/solve_trig_SSS.htm   +++++++++++++'
       ' We find the largest angle first, because there can only be one angle in a triangle that is obtuse            '
       ' (greater than 90°). If a triangle has an obtuse angle, then this will be it.                                 '
       ' The reason for finding it first is that in the next step we will use the sine rule to find the second angle. '
       ' The inverse sin operation that we will use can only give us acute angles (less than 90°), so                 '
       ' we avoid a possible wrong answer by first eliminating the only possibility of an obtuse angle.               '
       '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
       ' I decided to NOT use the mixed approach (first solve the obtuse angle then use the sine rule for another)    '
       ' Instead, I'm just going to make repeated calls to: AngleOppSideC()    (It's direct and has been proven!)     '
       ' However, I am leaving the "largest first" stuff in place just because it's logical.                          '
       '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
    
       'First, find the angle that is opposite the side in the 3rd param...
    
       #DEBUG PRINT "This.S12.SegLen   This.S23.SegLen   This.S13.SegLen -- " & ST(This.S12.SegLen) & " " & ST(This.S23.SegLen) & " " & ST(This.S13.SegLen)
       LargestSide = MAX ( This.S12.SegLen, This.S23.SegLen, This.S13.SegLen )
       SELECT CASE LargestSide
       CASE This.S12.SegLen
          This.AO12 = AngleOppSideC (This.S13.SegLen, This.S23.SegLen, This.S12.SegLen)   'AO12 is opposite S12
          LargestAngle = This.AO12
          'and let's do the others
          This.AO23 = AngleOppSideC (This.S12.SegLen, This.S13.SegLen, This.S23.SegLen)
          This.AO13 = AngleOppSideC (This.S12.SegLen, This.S23.SegLen, This.S13.SegLen)
          SecondLargestAngle = MAX ( This.AO23, This.AO13 )
          SmallestAngle = MIN ( This.AO23, This.AO13 )
       CASE This.S23.SegLen
          This.AO23 = AngleOppSideC (This.S12.SegLen, This.S13.SegLen, This.S23.SegLen)
          LargestAngle = This.AO23
          This.AO12 = AngleOppSideC (This.S13.SegLen, This.S23.SegLen, This.S12.SegLen)
          This.AO13 = AngleOppSideC (This.S12.SegLen, This.S23.SegLen, This.S13.SegLen)
          SecondLargestAngle = MAX ( This.AO12, This.AO13 )
          SmallestAngle = MIN ( This.AO12, This.AO13 )
       CASE This.S13.SegLen
          This.AO13 = AngleOppSideC (This.S12.SegLen, This.S23.SegLen, This.S13.SegLen)
          LargestAngle = This.AO13
          This.AO12 = AngleOppSideC (This.S13.SegLen, This.S23.SegLen, This.S12.SegLen)
          This.AO23 = AngleOppSideC (This.S12.SegLen, This.S13.SegLen, This.S23.SegLen)
          SecondLargestAngle = MAX ( This.AO12, This.AO23 )
          SmallestAngle = MIN ( This.AO12, This.AO23 )
       END SELECT
    
       #DEBUG PRINT "AO12   AO23   AO13 -- " & ST(This.AO12) & " " & ST(This.AO23) & " " & ST(This.AO13)
       #DEBUG PRINT "Largest   SecondLargest  SmallestAngle -- " & _
                     ST(LargestAngle) & "  " & ST(SecondLargestAngle)& "  " & ST(SmallestAngle)
    
       'now set other properties of the TYPE...
       '+++++++++++++++++++++++++++++++++++++++
       'determine TriangleClass (A/S)             http://en.wikipedia.org/wiki/Triangle#Types_of_triangles
       'Classifications, based on Angles:
       ' Right   - one 90 angle
       ' Obtuse  - one angle greater than 90
       ' Acute   - all angles less than 90
       '           (An equilateral triangle is an acute triangle, but not all acute triangles are equilateral.)
       '(oBlique - no 90 angle; includes both Obtuse and Acute triangles, so we won't be storing this)
       '
       'Classifications, based on Sides:           (interesting but not so useful)
       ' Equilateral - three sides equal
       ' Isosceles   -   two sides equal
       ' Scalene     -    no sides equal
       '+++++++++++++++++++++++++++++++++++++++
       'Largest angle is primary determinant
       SELECT CASE LargestAngle
       CASE = 90
          This.TriangleClassA = "Right"
       CASE > 90
          This.TriangleClassA = "Obtuse"
       CASE < 90
          '  (This.AO12 < 90 AND This.AO23 < 90 AND This.AO13 < 90)
          IF SecondLargestAngle < 90 AND SmallestAngle < 90 THEN
             This.TriangleClassA = "Acute"        ' all 3 angles are less than 90 degrees
          END IF
       CASE ELSE
          This.TriangleClassA = "Unknown"
       END SELECT
       
       'Set TriangleClassS, based on Sides...
       IF (This.S12.SegLen = This.S23.SegLen) AND (This.S23.SegLen = This.S13.SegLen) THEN
          This.TriangleClassS = "Equilateral"  ' all 3 sides are equal
       ELSEIF (This.S12.SegLen <> This.S23.SegLen) AND (This.S23.SegLen <> This.S13.SegLen) AND (This.S13.SegLen <> This.S12.SegLen) THEN
          This.TriangleClassS = "Scalene"  ' none of the 3 sides are equal
       ELSEIF (This.S12.SegLen = This.S23.SegLen) OR (This.S23.SegLen = This.S13.SegLen) OR (This.S13.SegLen <> This.S12.SegLen) THEN
          'to avoid misinterpretation, this condition must be tested last
          This.TriangleClassS = "Isosceles"  ' only 2 of the 3 sides are equal (we already know all 3 are not equal)
       END IF
    
       'Find and set the Centroid point:
       lRet = FindPointInTriangle (This.Points, This.Centroid)
       IF lRet <> %TRUE THEN
          'this just gives the debugger something to step onto and execute...
          #DEBUG PRINT "Error in SetTriangleProperties - set Centroid..."
       END IF
    
       'other properties to set?
    END SUB
    
    '---------------------   Math Functions   ---------------------
    FUNCTION AngleOppSideC (BYVAL SideA AS SINGLE, BYVAL SideB AS SINGLE, BYVAL SideC AS SINGLE) AS SINGLE
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    '  Always be sure that the SideC param contains the side whose opposite angle is the one we're solving for!!!!
    '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
       'To solve an angle when 3 sides are known, use the Law Of Cosines:
       '   c^2 = a^2 + b^2 – 2*a*b * cos(C)  'That's in trig format. For code, transform so that all knowns on one side.
       'Law Of Cosines gives us the cosine of the angle. But we still need to find the actual angle.
       'We get the actual angle by applying the Inverse Cosine function (a/k/a ARCCOS) to the found cosine value.
       'The ARCCOS calculation uses ATN, so the return is in RADIANs. We'll need to convert it to DEGREEs.
       '
       LOCAL CosC, ArcCosC, temp AS SINGLE
    
       'this is a published variation of the Law of Cosines function:
       CosC = ((SideA * SideA) + (SideB * SideB) - (SideC * SideC)) / (2 * SideA * SideB)
       #DEBUG PRINT "CosC --  " & ST(CosC)
    
       'Now we have the Cos of the angle, but to get the actual angle from that Cos value...
       ArcCosC = (Pi / 2) - (ATN(CosC / SQR(1 - (CosC * CosC))))  '...we use the Inverse Cosine (ARCCOS) function
       'the radian result needs conversion to degrees:
       FUNCTION = RadiansToDegrees(ArcCosC) 'I haven't gotten the macro to work in above calc, so I'm using it separately.
    END FUNCTION
    
    FUNCTION SLIntersect (BYREF Line1 AS grphStraightLine, BYREF Line2 AS grphStraightLine, BYREF IntersectPoint AS PolyPoint) AS LONG
    ' "Straight Line Intersect" -- see if there exists a point that is common to both lines
    '
    ' This is a wrapper function to interface my SINGLEs to the Paul Dixon routine that uses DOUBLEs,
    ' and to handle the function return values more according to my style...
    '
    ' WARNING: IntersectPoint values are valid ONLY IF this function returns %TRUE (-1)
       IntersectPoint.x = 0
       IntersectPoint.y = 0
    '
       LOCAL x1, y1, x2, y2, x3, y3, x4, y4 AS DOUBLE 'MUST cast line points as DOUBLE or the function won't work!
       LOCAL lRet AS LONG
    
       'Cast our stored SINGLEs as DOUBLEs...
       x1 = Line1.p1.x
       y1 = Line1.p1.y
       x2 = Line1.p2.x
       y2 = Line1.p2.y
       x3 = Line2.p1.x
       y3 = Line2.p1.y
       x4 = Line2.p2.x
       y4 = Line2.p2.y
       '   ...and call Paul Dixon's excellent ASM routine:
       lRet = intersect(x1, y1, x2, y2, x3, y3, x4, y4) 'returns values in Globals: xc and yc
    
       SELECT CASE lRet
       CASE  1 'line segments are parallel and can never intersect
       CASE  0 'line segments do NOT intersect (due to lenghts; but if longer, they would)
       CASE -1 'line segments DO intersect (-1 = %TRUE)
          IntersectPoint.x = xc
          IntersectPoint.y = yc
       END SELECT
    
       FUNCTION = lRet
    END FUNCTION
    
    'need other math functions?
    
    '+++++++++++++++   FindPoint FUNCTIONS   ++++++++++++++++
    FUNCTION FindPointInQuadrilateral (BYVAL TopLeft  AS PolyPoint, _
                                       BYVAL BotRight AS PolyPoint, _
                                       BYREF RetVal   AS PolyPoint) AS LONG
       'we have the upper left and lower right corners of the actual QL...
       LOCAL CenterX, CenterY AS SINGLE
       LOCAL lRet AS LONG
       DIM Diag1 AS grphStraightLine
       DIM Diag2 AS grphStraightLine
    
    'either of the two following approaches work fine - pick the one you like best
    #IF 0 '1   'the bounding box approach - find the center points of the sides
       '   center = half the diff of the bounding box's x's and y's, PLUS the x,y offsets to the box edge!!!
       CenterX = INT((BotRight.x - TopLeft.x) /2) + TopLeft.x
       CenterY = INT((BotRight.y - TopLeft.y) /2) + TopLeft.y
       RetVal.x = CenterX
       RetVal.y = CenterY
    #ELSE  'the more mathematical approach - find the point where the diagonals intersect...
       'move these to a setup routine...
       Diag1.p1.x = TopLeft.x
       Diag1.p1.y = TopLeft.y
       Diag1.p2.x = BotRight.x
       Diag1.p2.y = BotRight.y
    
       Diag2.p1.x = TopLeft.x
       Diag2.p1.y = BotRight.y
       Diag2.p2.x = BotRight.x
       Diag2.p2.y = TopLeft.y
    
       DIM IntPoint AS PolyPoint
       lRet = SLIntersect (Diag1, Diag2, IntPoint) 'wrapper for recasting variable types to the ASM routine
       RetVal.x = IntPoint.x
       RetVal.y = IntPoint.y
    #ENDIF
       #DEBUG PRINT "RetVal.x   RetVal.y -- " & ST(RetVal.x) & "  " & ST(RetVal.y)
       FUNCTION = %TRUE
    END FUNCTION
    
    FUNCTION FindPointInEllipse (BYVAL TopLeft  AS PolyPoint, _
                                 BYVAL BotRight AS PolyPoint, _
                                 BYREF RetVal  AS PolyPoint) AS LONG
    'although for now this code is identical to Box, sep func allows for future differentiation more approp to ellipses...
       'we have the upper left and lower right corners of the bounding box surrounding the ellipse...
       LOCAL CenterX, CenterY AS SINGLE
       'determine the center and the radius
       '   center = half the diff of the bounding box's x's and y's, PLUS the x,y offsets to the box edge!!!
       CenterX = INT((BotRight.x - TopLeft.x) /2) + TopLeft.x
       CenterY = INT((BotRight.y - TopLeft.y) /2) + TopLeft.y
    '   Radius  = INT((BotRight.x - TopLeft.x) /2)  'move this to a someday function:  SetEllipseProperties()
       #DEBUG PRINT "CenterX,  CenterY -- " & ST(CenterX) & "  " & ST(CenterY)
       RetVal.x = CenterX
       RetVal.y = CenterY
       #DEBUG PRINT "RetVal.x   RetVal.y -- " & ST(RetVal.x) & "  " & ST(RetVal.y)
       FUNCTION = %TRUE
    END FUNCTION
    
    FUNCTION FindPointInTriangle (BYREF PointsList AS PolyArray, BYREF RetVal AS PolyPoint) AS LONG
       'just for finding an inside point, we only need Points, not an entire Triangle structure...
       '   So, if the caller already has a Triangle, they can simply
       '   call this routine while passing:  CallersTriangle.Points   as the first param
    
       'A known point inside a triangle is called it's "centroid"; where the medians of the angles intersect
       RetVal.x = (PointsList.xy(1).x + PointsList.xy(2).x + PointsList.xy(3).x) / 3
       RetVal.y = (PointsList.xy(1).y + PointsList.xy(2).y + PointsList.xy(3).y) / 3
       #DEBUG PRINT "RetVal.x   RetVal.y -- " & ST(RetVal.x) & "  " & ST(RetVal.y)
       FUNCTION = %TRUE
    END FUNCTION
    
    FUNCTION FindPointInPolygon (BYREF PointsList AS PolyArray, BYREF RetVal AS PolyPoint) AS LONG
       'this is generally known as the "point-in-polygon" problem...  refer to the RayTrace Newsletters
       'Method1: pick a point, shoot a ray, and count the intersections: odd/even tells if point is in or out...
       'Method2: sum the vertices, check for angle of deviation... (I really don't have all the details on this yet.)
    
    'ZCZC 'still under construction...
    
    '   RetVal.x = (PointsList.xy(1).x + PointsList.xy(2).x + PointsList.xy(3).x) / PointsList.Count  'this is fake!!
    '   RetVal.y = (PointsList.xy(1).y + PointsList.xy(2).y + PointsList.xy(3).y) / PointsList.Count
       #DEBUG PRINT "RetVal.x   RetVal.y -- " & ST(RetVal.x) & "  " & ST(RetVal.y)
       FUNCTION = %TRUE
    END FUNCTION
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    '++++++++++++   END OF FindPoint FUNCTIONS   ++++++++++++
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    
    
    '==============================================================
    '======================   PB MAIN   ===========================
    '==============================================================
    FUNCTION PBMAIN () AS LONG
       'The object of this exercise is to learn how to use GRAPHICS statements,
       '  and particuarly to drive my "FindPointIn_(shape)_" functions.
    
       LOCAL hSquare, hCircle, hTriangle, hPoly, lRet AS LONG
    
       DIM PlotPoints AS PolyArray  'a general points-list to get us started
    
       DIM UpLeft     AS PolyPoint
       DIM DownRight  AS PolyPoint
       DIM CenterPoint AS PolyPoint
    
       'position the console window
       CONSOLE SET LOC 25, 250
    
       'create separate windows
       GRAPHIC WINDOW "Square"  ,  25, 10, 200, 200 TO hSquare
       GRAPHIC WINDOW "Circle"  , 250, 10, 200, 200 TO hCircle
       GRAPHIC WINDOW "Triangle", 475, 10, 200, 200 TO hTriangle
       GRAPHIC WINDOW "Polygon" , 700, 10, 200, 200 TO hPoly
    
       'retrieve the user-supplied coordinates for a triangle, quadrilateral, or polygon
       CALL SetPlotPoints(PlotPoints)
    
       'display the square
       '------------------
       CenterPoint.x = 1 : CenterPoint.y = 1
       UpLeft.x = 10 : UpLeft.y = 10  : DownRight.x = 120  : DownRight.y = 120  'could be done in SetPlotPoints...
       'the above works off only 2 points, but a true QL would require 4...  future mods, or just use Polygon? ******
       GRAPHIC ATTACH hSquare, 0
       GRAPHIC BOX (UpLeft.x, UpLeft.y) - (DownRight.x, DownRight.y), 0, %RED
       lRet = FindPointInQuadrilateral (UpLeft, DownRight, CenterPoint)
       'if isfalse(lRet) then
       #DEBUG PRINT "CenterPoint.x,  CenterPoint.y -- " & ST(CenterPoint.x) & "  " & ST(CenterPoint.y)
       GRAPHIC PAINT (CenterPoint.x, CenterPoint.y) , %RED
       CALL SetCtrPt (CenterPoint.x, CenterPoint.y, %WHITE)
       SLEEP 1000
       CALL SetCtrPt (CenterPoint.x, CenterPoint.y, %RED)
       SLEEP 500
    
       'display the circle
       '------------------
       GRAPHIC ATTACH hCircle, 0
       GRAPHIC ELLIPSE (UpLeft.x, UpLeft.y) - (DownRight.x, DownRight.y), 0, %WHITE 'same coords as above QL...
       lRet = FindPointInEllipse (UpLeft, DownRight, CenterPoint)
       #DEBUG PRINT "CenterPoint.x,  CenterPoint.y -- " & ST(CenterPoint.x) & "  " & ST(CenterPoint.y)
       GRAPHIC PAINT (CenterPoint.x, CenterPoint.y) , %WHITE
       CALL SetCtrPt (CenterPoint.x, CenterPoint.y, %RED)
       SLEEP 1000
       CALL SetCtrPt (CenterPoint.x, CenterPoint.y, %WHITE)
       SLEEP 500
    
       'for starters, I'm only doing either the triangle OR the polygon. Can rework later to do both...
    
       'display the triangle
       '--------------------
       IF PlotPoints.Count = 3 THEN 'the points list is for a Triangle
          GRAPHIC ATTACH hTriangle, 0
          GRAPHIC POLYGON PlotPoints, %BLUE
          '
          DIM TestTriangle AS grphTriangle
          TestTriangle.Points = PlotPoints           'copy the given points into our full Triangle structure...
          CALL SetTriangleProperties (TestTriangle)  'we were given only the points, so we figure out the rest...
          GRAPHIC PAINT (TestTriangle.Centroid.x, TestTriangle.Centroid.y) , %BLUE
          CALL SetCtrPt (TestTriangle.Centroid.x, TestTriangle.Centroid.y, %WHITE)
          SLEEP 1000
          CALL SetCtrPt (TestTriangle.Centroid.x, TestTriangle.Centroid.y, %BLUE)
               CALL PrintTriangleProperties ( TestTriangle )
          SLEEP 500
       END IF
    
       'display the polygon
       '-------------------
       IF PlotPoints.Count > 3 THEN  '
          GRAPHIC ATTACH hPoly, 0
          GRAPHIC POLYGON PlotPoints, %BLUE 'note that PlotPoints must be ordered so as to not cross (unless you want that)
          lRet = FindPointInPolygon (PlotPoints, CenterPoint)    'someday instead, do SetPolygonProperties()
          #DEBUG PRINT "CenterPoint.x,  CenterPoint.y -- " & ST(CenterPoint.x) & "  " & ST(CenterPoint.y)
          GRAPHIC PAINT (CenterPoint.x, CenterPoint.y) , %BLUE
          CALL SetCtrPt (CenterPoint.x, CenterPoint.y, %WHITE)
          SLEEP 1000
          CALL SetCtrPt (CenterPoint.x, CenterPoint.y, %BLUE)
          SLEEP 1000
       END IF
    
       'just messing around...
       CONSOLE SET FOCUS
       MOUSE 3, DOUBLE, DOWN : MOUSE ON
       LOCAL m AS STRING, r AS LONG
       m = RTRIM$(CSET$("Click or press a key to exit", 78))
       r = CURSORY
       WHILE NOT INSTAT
          LOCATE r + 2, 1 : PRINT m;
          SLEEP 700
          LOCATE r + 2, 1 : PRINT STRING$(LEN(m), " ");
          SLEEP 100
       WEND
    
    END FUNCTION
    '==============================================================
    '===================   END OF PB MAIN   =======================
    '==============================================================
    
    '-------------   Utility Functions   ------------
    SUB SetCtrPt (BYVAL CenterX AS LONG, BYVAL CenterY AS LONG, BYVAL RGBColor AS LONG)
       'Given a point, set a tiny cross-hair.
       '    To clear it, call again with another color...
       GRAPHIC SET PIXEL (CenterX,    CenterY   ), RGBColor
       GRAPHIC SET PIXEL (CenterX +1, CenterY   ), RGBColor
       GRAPHIC SET PIXEL (CenterX -1, CenterY   ), RGBColor
       GRAPHIC SET PIXEL (CenterX,    CenterY +1), RGBColor
       GRAPHIC SET PIXEL (CenterX,    CenterY -1), RGBColor
    END SUB
    
    SUB PrintTriangleProperties (BYVAL MyTri AS grphTriangle)
       LOCAL i AS LONG
    
       PRINT "Triangle Properties"
       PRINT "==================="
       PRINT "Points.Count:   " & ST(MyTri.Points.Count)
       FOR i = 1 TO MyTri.Points.Count
          PRINT "Points.xy(i):   " & ST(MyTri.Points.xy(i).x) & ", " & ST(MyTri.Points.xy(i).y)
       NEXT i
    
       PRINT "S12:   (" & ST(MyTri.S12.p1.x) & ", " & ST(MyTri.S12.p1.y) & ") - (" _
                        & ST(MyTri.S12.p2.x) & ", " & ST(MyTri.S12.p2.y) & ")
       PRINT "     Rise   Run   Slope   SegLen:   " & ST(MyTri.S12.Rise) & "  " & ST(MyTri.S12.Run) & "  " & _
                                              ST(MyTri.S12.Slope) & "  " & ST(MyTri.S12.SegLen)
    
       PRINT "S23:   (" & ST(MyTri.S23.p1.x) & ", " & ST(MyTri.S23.p1.y) & ") - (" _
                        & ST(MyTri.S23.p2.x) & ", " & ST(MyTri.S23.p2.y) & ")
       PRINT "     Rise   Run   Slope   SegLen:   " & ST(MyTri.S23.Rise) & "  " & ST(MyTri.S23.Run) & "  " & _
                                              ST(MyTri.S23.Slope) & "  " & ST(MyTri.S23.SegLen)
    
       PRINT "S13:   (" & ST(MyTri.S13.p1.x) & ", " & ST(MyTri.S13.p1.y) & ") - (" _
                        & ST(MyTri.S13.p2.x) & ", " & ST(MyTri.S13.p2.y) & ")
       PRINT "     Rise   Run   Slope   SegLen:   " & ST(MyTri.S13.Rise) & "  " & ST(MyTri.S13.Run) & "  " & _
                                              ST(MyTri.S13.Slope) & "  " & ST(MyTri.S13.SegLen)
    
       PRINT "AO12  AO23  AO13:   " & ST(MyTri.AO12) & "  " & ST(MyTri.AO23) & "  " & ST(MyTri.AO13)
       PRINT "Centroid x,y:   " & ST(MyTri.Centroid.x) & "  " & ST(MyTri.Centroid.y)
       PRINT "Triangle Class by Angles:   " & MyTri.TriangleClassA
       PRINT "Triangle Class by  Sides:   " & MyTri.TriangleClassS
    END SUB
    
    SUB PrintLineProperties (BYVAL MyLine AS grphStraightLine)
       LOCAL i AS LONG
    
       PRINT "Line Properties"
       PRINT "==============="
       PRINT "p1.x   p1.y:   " & SPACE$(2) & ST(MyLine.p1.x) & SPACE$(2) & ST(MyLine.p1.y)
       PRINT "p2.x   p2.y:   " & SPACE$(2) & ST(MyLine.p2.x) & SPACE$(2) & ST(MyLine.p2.y)
       PRINT "Rise   Run   Slope   SegLen:   " & ST(MyLine.Rise) & "  " & ST(MyLine.Run) & "  " & _
                                              ST(MyLine.Slope) & "  " & ST(MyLine.SegLen)
    END SUB
    
    
    #IF 0  ' not yet implemented...
       ' Typical LPRINT printing strategy (from the Helpfile)
       ERRCLEAR
       LPRINT ATTACH "LPT2"   ' Use LPT2 device
       IF ERR <> 0 OR LPRINT$ = "" THEN
          PRINT "Printer connection failed"
       ELSEIF ISFALSE ERR AND ISTRUE LEN(LPRINT$) THEN
          LPRINT "This is your line-printer talking"
          LPRINT FORMFEED      ' Issue a formfeed
          LPRINT FLUSH         ' flush the buffer
          LPRINT CLOSE         ' detach the printer
       END IF
    #ENDIF

    INTERSECT1.INC
    Code:
    'INTERSECT1.inc ' to be INCLUDEd in main file
    'by Paul Dixon
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    'A PB/CC function to see if and where 2 straight lines intersect.
    '  The 2 lines are specified by (x1,y1)-(x2,y2)  and  (x3,y3)-(x4,y4)
    'Function Return Values:
    ' +1  the lines are parallel. In this case the xc and yc are not valid.
    '  0  the lines don't intersect. xc and yc are the co-ordinates of the point where the extrapolated lines would intersect.
    ' -1  the lines intersect. xc and yc are the co-ordinates of the intersect point.
    '
    'Example invocation of the function:
    '  IF intersect(a,b , c,d , e,f , g,h) = -1 THEN PRINT "The lines intersect at " xc, yc
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    
    
    'DECLARE FUNCTION intersect(BYVAL x1 AS DOUBLE, BYVAL y1 AS DOUBLE, BYVAL x2 AS DOUBLE, BYVAL y2 AS DOUBLE, _
    '                           BYVAL x3 AS DOUBLE, BYVAL y3 AS DOUBLE, BYVAL x4 AS DOUBLE, BYVAL y4 AS DOUBLE) AS LONG
    
    GLOBAL xc, yc AS DOUBLE
    
    FUNCTION intersect(BYVAL x1 AS DOUBLE, _
                       BYVAL y1 AS DOUBLE, _
                       BYVAL x2 AS DOUBLE, _
                       BYVAL y2 AS DOUBLE, _
                       BYVAL x3 AS DOUBLE, _
                       BYVAL y3 AS DOUBLE, _
                       BYVAL x4 AS DOUBLE, _
                       BYVAL y4 AS DOUBLE) AS LONG
    REM First LINE slope AND intercept
    !fld x1
    !fld x2
    !fsubp st(1),st(0)    ;x1-x2
    
    !ftst
    !fstsw ax
    !test ax,&h4000
    !jnz infS1            ;slope1=infinite
    
    'slope1<>infinite.
    !call eq1             ;get slope and intercept 1
    
    REM Second LINE slope AND intercept
    !fld x3
    !fld x4
    !fsubp st(1),st(0)    ;x3-x4
    
    !ftst
    !fstsw ax
    !test ax,&h4000
    !jnz infs2          ;slope2=infinite
    
    'slope1<>inf and slope2<>inf
    !call eq2             ;get slope and intercept 2
    
    'now get cross point
    !fsubr st(0),st(2)    ;slope1 - slope2
    
    !ftst
    !fstsw ax
    !test ax,&h4000
    !jnz parallel           ;slope1=slope2 so lines do not intercept
    
    'lines intercept, now work out where
    !fxch
    !fsub st(0),st(3)     ;int2 - int1
    !fdivrp st(1),st(0)   ;xcross
    
    !fst xc
    !fmulp st(1),st(0)
    !faddp st(1),st(0)    ;ycross
    !fst yc
    
    !jmp InSeg            ;see if they cross in the defined segments of the lines
    
    infS1:
    'slope1=infinite
    'FPstack=x1-x2
    !fstp st(0)         ;discard stack
    
    REM Second LINE slope AND intercept
    !fld x3
    !fld x4
    !fsubp st(1),st(0)    ;x3-x4
    
    !ftst
    !fstsw ax
    !test ax,&h4000
    !jnz infS12            ;slope1=slope2=infinite
    
    'slope2<>infinite
    'slope1=inf and slope2<>inf
    !call eq2            ;get slope and intercept 2
    
    'now get cross point
    !fld x1
    !fst xc
    !fmulp st(1),st(0)
    !faddp st(1),st(0)      ;slope2*x1 + int2 = yint
    !fst yc
    
    !jmp InSeg              ;see if they cross in the defined segments of the lines
    
    
    infS2:
    'slope2=infinite, slope1 not infinite
    'FPstack= x3-x4,s1,i1
    !fstp st(0)         ;discard stack
    
    'now get cross point
    !fld x3
    !fst xc
    !fmulp st(1),st(0)
    !faddp st(1),st(0)      ;slope1*x3 + int1 = yint
    !fst yc
    
    !jmp InSeg              ;see if they cross in the defined segments of the lines
    
    
    parallel:
    !fstp st(0)         ;clean up FP stack
    !fstp st(0)
    !fstp st(0)
    infS12:
    !fstp st(0)
    !mov function,1     ;the lines do not cross (they're parallel)
    !jmp xit
    
    
    eq1:
    'assume x1-x2 is on stack
    !fld y1
    !fld y2
    !fsubp st(1),st(0)    ;y1-y2
    
    !fdiv st(0),st(1)     ;slope1
    
    !fld x1
    !fld y2
    !fmulp st(1),st(0)    ;x1*y2
    
    !fld y1
    !fld x2
    !fmulp st(1),st(0)    ;x2*y1
    
    !fsubp st(1),st(0)    ;x1*y2 - x2*y1
    !fdivrp st(2),st(0)   ;intercept1
    'FPstack = s1,i1 + FPstack
    !retn
    
    eq2:
    'assume x3-x4 is on stack
    !fld y3
    !fld y4
    !fsubp st(1),st(0)    ;y3-y4
    
    !fdiv st(0),st(1)     ;slope2
    
    !fld x3
    !fld y4
    !fmulp st(1),st(0)    ;x3*y4
    
    !fld y3
    !fld x4
    !fmulp st(1),st(0)    ;x3*y4
    
    !fsubp st(1),st(0)    ;x3*y4 - x4*y3
    !fdivrp st(2),st(0)   ;intercept2
    'FPstack= s2,i2 + FPstack
    !retn
    
    'rem is the cross within the defined line segments?
    InSeg:
    'yc is on the stack
    !fld y1
    !fcomp st(1)
    !fstsw ax
    !mov bx,ax
    
    !fld y2
    !fcompp     ; st(1)
    !fstsw ax
    
    !sahf
    !jz skip3a
    
    !xor bx,ax
    !and bx,&b0100010100000000
    !jz xit              ;they don't cross in the defined segments
    
    skip3a:
    !fld yc
    !fld y3
    !fcomp st(1)
    !fstsw ax
    !mov bx,ax
    
    !fld y4
    !fcompp     ; st(1)
    !fstsw ax
    
    !sahf
    !jz skip5a
    
    !xor bx,ax
    !and bx,&b0100010100000000
    !jz xit             ;they don't cross in the defined segments
    
    skip5a:
    !fld xc
    !fld x1
    !fcomp st(1)
    !fstsw ax
    !mov bx,ax
    
    !fld x2
    !fcompp     ; st(1)
    !fstsw ax
    
    !sahf
    !jz skip3
    
    !xor bx,ax
    !and bx,&b0100010100000000
    !jz xit             ;they don't cross in the defined segments
    
    skip3:
    !fld xc
    !fld x3
    !fcomp st(1)
    !fstsw ax
    !mov bx,ax
    
    !fld x4
    !fcompp     ; st(1)
    !fstsw ax
    
    !sahf
    !jz skip5
    
    !xor bx,ax
    !and bx,&b0100010100000000
    !jz xit             ;they don't cross in the defined segments
    
    skip5:
    !mov function,-1   ;they do cross in the defined segments
    
    xit:
       'FUNCTION =  +1  the lines are parallel (do not intersect at all)
       'FUNCTION =   0  the lines do not intersect in the segments specified
       'FUNCTION =  -1  the lines DO intersect in the segments specified, and:
       '                 xc = X co-ord of intersection, yc = Y co-ord of intersection
    END FUNCTION
    Attached Files
Working...
X