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