Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
This is a 2D graphics library. The routines in this library are mainly (but not entirely) based on algorithms found in the book Computer Graphics (Teach Yourself) by John Landsdown (Amazingly a newer version (1997) than mine (1987) is available at Amazon UK).
There are 2 common types of graphics used with computers - tile graphics and coordinate graphics. This library deals entirely with the latter. The library is accompanied by a demo. The library consists of a BI file, a BM file and a DAT data file. The demo consists of a BAS file and it's own dedicated DAT data file.
This library uses the following conventions. The coordinate pairs are stored in a 2 dimensional array of the form CoordinateArray#(0 TO N, QX% TO QY%). CoordinateArray#(0,QX%) and CoordinateArray#(0, QY%) are used to hold the coordinates of the centre of the graphics object. The following three types are used extensively throughout this library. The type Box2D is used both for storing the coordinates of an imaginary box surrounding each graphics object and also for the storage of the coordinates for graphics windows. AView2D is used to store the device coordinates for viewports. Type Vision combines both a graphics window and a viewport as well as additional information needed for the mapping of the world coordinates (stored in the arrays) to device coordinates (so you can display them).
If the above is all Ancient Greek to you don't panic, Just compile and run the demo to get a flavour of what's here.
Before I post the library in the next post, here is the original BI file (DO NOT USE- Just read) as documentation of the public routines in the library -
Code: (Select All) REM ******************************************************
REM * Filespec : g2.bm g2.bi g2.dat *
REM * : g2demo.bas g2demo.dat *
REM * Date : September 15 1998 *
REM * Time : 12:25 *
REM * Revision : 1.00B *
REM * Update : *
REM ******************************************************
REM * Released to the Public Domain *
REM ******************************************************
'$DYNAMIC
TYPE Box2D
Left AS DOUBLE
Right AS DOUBLE
Top AS DOUBLE
Bottom AS DOUBLE
END TYPE
TYPE AView2D
Left AS INTEGER
Right AS INTEGER
Top AS INTEGER
Bottom AS INTEGER
END TYPE
TYPE Vision
MyWindow AS Box2D
MyView AS AView2D
XMove AS DOUBLE
YMove AS DOUBLE
XBound AS DOUBLE
YBound AS DOUBLE
XFactor AS DOUBLE
YFactor AS DOUBLE
END TYPE
CONST FALSE% = 0
CONST TRUE% = NOT FALSE%
CONST QX% = 1, QY% = 2
CONST PI# = 3.141592653589793#
CONST PIDividedBy2# = 1.57079632679489661923 'PI / 2
CONST PITimes2# = 6.28318530717959 'PI * 2
CONST PITimes3# = 9.42477796076938 'PI * 3
CONST XScale% = 1, YScale% = 2, Scale% = 3
CONST OneSeventeenth# = .05882352941176471#
REM ******************************************************************
REM * The following routines are for the general management of the *
REM * arrays used to hold the coordinates that we are working with. *
REM * All of the following routines return TRUE% if they are *
REM * successful and FALSE% if an error condition was detected. The *
REM * output arrays are automatically resized to exactly the size *
REM * necessary to hold the output data. *
REM ******************************************************************
DECLARE FUNCTION CopyShape2D%(InShape#(), OutShape#())
REM ******************************************************************
REM * Copies InShape#() to OutShape#(). *
REM ******************************************************************
DECLARE FUNCTION AppendShape2D%(This#(), OntoThis#())
REM ******************************************************************
REM * Appends the contents of This#() onto the end of OntoThis#(). *
REM ******************************************************************
DECLARE FUNCTION MakePolygon%(This#(), OntoThis#())
REM ******************************************************************
REM * Identical to the preceding routine with additional action of *
REM * copying the first coordinate pair of OntoThis#() to its end *
REM * after appending This#(). *
REM ******************************************************************
DECLARE FUNCTION InsertShape2D%(This#(), IntoThis#(), AfterThisPoint%)
REM ******************************************************************
REM * Inserts the contents of This#() into IntoThis#() after the *
REM * coordinate pair specified by AfterThis%. *
REM ******************************************************************
DECLARE FUNCTION DeletePoint2D%(This#(), PointNumber%)
REM ******************************************************************
REM * Deletes the coordinate pair specified by PointNumber%, From *
REM * This#(). *
REM ******************************************************************
DECLARE FUNCTION OuterLimits2D%(This#(), MyBounds AS Box2D)
REM ******************************************************************
REM * This routine determines the values for an imaginary box *
REM * surrounding the graphics object held in This#(). These values *
REM * are placed in MyBounds. The exact centre of the object is *
REM * also determined by this routine and the coordinate pair of *
REM * this centre are placed in This#(0, QX%) and This#(0, QY%). *
REM ******************************************************************
REM ******************************************************************
REM * The following routines manipulate the coordinate pairs held in *
REM * the arrays in the manner specified in the individual *
REM * descriptions. Once all calculations are complete the new *
REM * exact centre and boundary values are determined by an *
REM * automatic call to OuterLimits2D%. All of the following *
REM * routines return TRUE% to indicate successful completion or *
REM * FALSE% if an error condition was detected. *
REM ******************************************************************
DECLARE FUNCTION Translate2D%(This#(), MyBounds AS Box2D, ByX#, ByY#)
REM ******************************************************************
REM * Relative movement. Moves the whole object by the amounts *
REM * specified in ByX# and ByY#. *
REM ******************************************************************
DECLARE FUNCTION MoveTo2D%(This#(), MyBounds AS Box2D, ToX#, ToY#)
REM ******************************************************************
REM * Absolute movement. Moves the whole object so that the centre *
REM * of the object is positioned at ToX#, ToY#. *
REM ******************************************************************
DECLARE FUNCTION InflateX2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Make the object wider by the amount specified in By#, without *
REM * disturbing the position of it's centre. *
REM ******************************************************************
DECLARE FUNCTION InflateY2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Make the object taller by the amount specified in By#, without *
REM * disturbing the position of it's centre. *
REM ******************************************************************
DECLARE FUNCTION Inflate2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Make the object larger in both dimensions by the amount *
REM * specified in By#, without disturbing the position of it's *
REM * centre. *
REM ******************************************************************
DECLARE FUNCTION ScaleX2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Make the object wider by the amount specified in By#. *
REM ******************************************************************
DECLARE FUNCTION ScaleY2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Make the object taller by the amount specified in By#. *
REM ******************************************************************
DECLARE FUNCTION ScaleXY2D%(This#(), MyBounds AS Box2D, ByX#, ByY#)
REM ******************************************************************
REM * Make the object taller (ByY#) and wider (ByX~) by the amount *
REM * specified. *
REM ******************************************************************
DECLARE FUNCTION Scale2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Make the object larger by the amount specified in By#. *
REM ******************************************************************
DECLARE FUNCTION ShearX2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Shearing in the X plane distorts the figure in a manner that *
REM * relates the amount specified in By# and Y coordinate for each *
REM * point. *
REM ******************************************************************
DECLARE FUNCTION ShearY2D%(This#(), MyBounds AS Box2D, By#)
REM ******************************************************************
REM * Shearing in the Y plane distorts the figure in a manner that *
REM * relates the amount specified in By# and X coordinate for each *
REM * point. *
REM ******************************************************************
DECLARE FUNCTION Shear2D%(This#(), MyBounds AS Box2D, ByX#, ByY#)
REM ******************************************************************
REM * This merely combines shearing in both planes into a single *
REM * procedure. *
REM ******************************************************************
DECLARE FUNCTION Rotation2D%(This#(), MyBounds AS Box2D, Angle#)
REM ******************************************************************
REM * Rotates the figure about the origin (that is the point at 0,0) *
REM * by Angle#. The direction of the rotation is controlled by the *
REM * sign of Angle#. A positive Angle# gives rotation in an *
REM * anti-clockwise direction and a negative one gives a clockwise *
REM * rotation. *
REM ******************************************************************
DECLARE FUNCTION Spin2D%(This#(), MyBounds AS Box2D, Angle#)
REM ******************************************************************
REM * Identical to Rotation2D except that the rotation is about the *
REM * centre of the figure being rotated. *
REM ******************************************************************
DECLARE FUNCTION Orbit2D%(This#(), MyBounds AS Box2D, OrbitX#, OrbitY#, Angle#)
REM ******************************************************************
REM * Identical to Rotation2D except that the rotation is about *
REM * OrbitX#, OrbitY#. *
REM ******************************************************************
REM ******************************************************************
REM * The next 3 routines are for the management of the data types *
REM * used to control which part(s) of the graphical objects we are *
REM * dealing with are visible and where they will be displayed. *
REM * While it is true that QB already has such mechanisms built-in, *
REM * you can only have one graphical window and one view-port at a *
REM * time with these. The graphical system presented here allows *
REM * for multiple such windows and viewports at once. *
REM ******************************************************************
DECLARE FUNCTION SetNewWindow2D%(ThisWindow AS Box2D, Left#, Right#, Top#, Bottom#)
REM ******************************************************************
REM * Stores the values held in Left#, Right#, Top# and Bottom# in *
REM * ThisWindow. *
REM ******************************************************************
DECLARE FUNCTION SetNewViewPort%(ViewPort AS AView2D, Left%, Right%, Top%, Bottom%)
REM ******************************************************************
REM * Stores the values held in Left%, Right%, Top% and Bottom% in *
REM * ViewPort. *
REM ******************************************************************
DECLARE SUB SetNewVision(Vew AS Vision, ThisWindow AS Box2D, ViewPort AS AView2D)
REM ******************************************************************
REM * Copies the contents of ThisWindow and ViewPort to Vew and then *
REM * makes certain calculations, storing the results in Vew. This *
REM * way all of the information necessary for mapping the world *
REM * coordinates (i.e. those stored in the coordinate arrays) to *
REM * the device coordinates (i.e. those of the monitor's screen). *
REM * *
REM * NOTE - if you do not want your graphics to have uncontrolled *
REM * distortion it is essential that the aspect ratio *
REM * (i.e. (Right - Left) / (Top - Bottom)) of ThisWindow and *
REM * ViewPort are identical. *
REM ******************************************************************
DECLARE SUB ClipLine2D(X1Old#, Y1Old#, X2Old#, Y2Old#, X1New#, Y1New#, X2New#, Y2New#, Vew AS Vision, Visible%)
REM ******************************************************************
REM * If a line is within the Box2D held in Vew, it will be trimmed *
REM * to fit if necessary. Visible% flags the obvious. *
REM ******************************************************************
DECLARE FUNCTION ClipDots2D%(Shape2D#(), MyBounds AS Box2D, Vew AS Vision, Dots#())
REM ******************************************************************
REM * Those dots in Shape2D# that are within the Box2D held in Vew *
REM * are returned in dots. *
REM ******************************************************************
REM ******************************************************************
REM * In the context of the following routines a polygon is simply a *
REM * list of coordinates that will be drawn as lines. The way that *
REM * these lines are drawn is as follows. The first line to be *
REM * drawn uses the first pair of coordinates to produce the line. *
REM * The next and subsequent lines use the last coordinates from *
REM * the previous line as their first coordinate and the next *
REM * coordinate as their last coordinate. If a closed figure is *
REM * desired, it is necessary for the last pair of coordinates to *
REM * be identical to the first pair. *
REM * *
REM * A shape, on the other hand is more complex and therefore uses *
REM * an INTEGER array to hold a list of points to be connected in *
REM * the order in which they are to be connected. The format of *
REM * the data held in this array is as follows:- *
REM * *
REM * The first 2 coordinate pairs (i.e. A#(1, QX%), A#(1,QY%) and *
REM * A#(2,QX%), A#(2,QY%)) ALWAYS specify the start and end points *
REM * of the first line of the figure. After that, the last point *
REM * of the preceding pair of points is the start point for the *
REM * next line and the next item specifies the end point of that *
REM * line unless the next A#(N, QX%) is -1. If it is -1 it means *
REM * drop the data already read and treat the next 2 coordinate *
REM * pairs as the start and end points of the next line. As an *
REM * example of this, the snippet of code below is the actual *
REM * connection list for the StarOfDavid which is defined later. *
REM * *
REM * Connections%(0) = 1 *
REM * Connections%(1) = 3 *
REM * Connections%(2) = 5 *
REM * Connections%(3) = 7 *
REM * Connections%(4) = -1 *
REM * Connections%(5) = 2 *
REM * Connections%(6) = 4 *
REM * Connections%(7) = 6 *
REM * Connections%(8) = 2 *
REM * *
REM ******************************************************************
DECLARE FUNCTION DisplayDotsDirect%(Dots#(), MyBounds AS Box2D, ScreenMode%, Colour%)
REM ******************************************************************
REM * Tries to display the points held in Dots on the current *
REM * graphics screen without any clipping or mapping. *
REM ******************************************************************
DECLARE FUNCTION DisplayPolygonDirect%(Polygon#(), MyBounds AS Box2D, ScreenMode%, Colour%)
REM ******************************************************************
REM * Tries to display the lines described in Polygon on the current *
REM * graphics screen without any clipping or mapping. *
REM ******************************************************************
DECLARE FUNCTION DisplayShapeDirect%(Shape2D#(), MyBounds AS Box2D, ConnectionList%(), ScreenMode%, Colour%)
REM ******************************************************************
REM * Tries to display the lines described in Shape2D and List, on *
REM * the current graphics screen without any clipping or mapping. *
REM ******************************************************************
DECLARE FUNCTION DisplayDots%(Dots#(), MyBounds AS Box2D, Colour%, Vew AS Vision)
REM ******************************************************************
REM * Those points held in Dots that are within the Box2D that is *
REM * part of Vew will be clipped, mapped and displayed by this *
REM * routine. *
REM ******************************************************************
DECLARE SUB DisplayLine(X1#, Y1#, X2#, Y2#, Colour%, Vew AS Vision)
REM ******************************************************************
REM * Any portion of the line described by point (X1,Y1) to point *
REM * (X2,Y2), that is within the Box2D that is part of Vew it will *
REM * be clipped, mapped and displayed by this routine. *
REM ******************************************************************
DECLARE FUNCTION DisplayPolygon%(Polygon#(), Colour%, Vew AS Vision)
REM ******************************************************************
REM * Those lines described in Polygon that are within the Box2D *
REM * that is part of Vew will be clipped, mapped and displayed by *
REM * this routine. *
REM ******************************************************************
DECLARE FUNCTION DisplayShape2D%(Shape2D#(), Colour%, ConnectionList%(), Vew AS Vision)
REM ******************************************************************
REM * Those lines described in Shape2D and List that are within the *
REM * Box2D that is part of Vew will be clipped, mapped and *
REM * displayed by this routine. *
REM ******************************************************************
REM ******************************************************************
REM * The graphical objects dealt with in this part of the library *
REM * are of 2 kinds, pre-calculated straight line objects (mostly *
REM * polygons) and curved objects that mostly have to be calculated *
REM * "on the fly" (the exception being circles which are *
REM * pre-calculated). In the context of this library, all curved *
REM * objects are simulated by a number of (comparatively) short *
REM * straight lines. This is done to enable the use of the simple *
REM * transformation routines already described. *
REM * *
REM * For those who don't know the names of regular polygons and the *
REM * number of sides each posses, I enclose the following list. *
REM * *
REM * Sides Name *
REM * *
REM * 3 Triangle *
REM * 4 Square *
REM * 5 Pentagon *
REM * 6 Hexagon *
REM * 7 Heptagon *
REM * 8 Octagon *
REM * 9 Nonagon *
REM * 10 Decagon *
REM * 11 Undecagon *
REM * 12 Dodecagon *
REM * *
REM ******************************************************************
REM ******************************************************************
REM * The following routines all resize and load the array with the *
REM * coordinates for the appropriate shape. All the shapes that *
REM * have the prefix Unit have dimensions that are in the range *
REM * from -1 to +1 and are centred at 0,0. The data for these *
REM * shapes is held in the file SHAPES2D.DAT. *
REM ******************************************************************
DECLARE SUB UnitTriangle(ATriangle#())
DECLARE SUB UnitSquare(ASquare#())
DECLARE SUB UnitPentagon(APentagon#())
DECLARE SUB UnitHexagon(AHexagon#())
DECLARE SUB UnitHeptagon(AHeptagon#())
DECLARE SUB UnitOctagon(AnOctagon#())
DECLARE SUB UnitNonagon(ANonagon#())
DECLARE SUB UnitDecagon(ADecagon#())
DECLARE SUB UnitUndecagon(AnUndecagon#())
DECLARE SUB UnitDodecagon(ADodecagon#())
DECLARE SUB UnitCircle(ThisCircle#())
DECLARE SUB UnitArrow(AnArrow#())
DECLARE SUB UnitParralellogram(AParralellogram#())
DECLARE SUB UnitDiamond(ADiamond#())
REM ******************************************************************
REM * The next set of routines also load the output variable with *
REM * the coordinates of the given shape. The way they work is to *
REM * first get a copy of the appropriate Unit shape, expand them in *
REM * such a way as to produce a figure with sides that are SideSize *
REM * long and then to move the whole figure so that it is centred *
REM * at CenterX, CenterY. *
REM ******************************************************************
DECLARE SUB Triangle(SideSize#, CenterX#, CenterY#, ATriangle#(), MyBounds AS Box2D)
DECLARE SUB Square(SideSize#, CenterX#, CenterY#, ASquare#(), MyBounds AS Box2D)
DECLARE SUB Pentagon(SideSize#, CenterX#, CenterY#, APentagon#(), MyBounds AS Box2D)
DECLARE SUB Hexagon(SideSize#, CenterX#, CenterY#, AHexagon#(), MyBounds AS Box2D)
DECLARE SUB Heptagon(SideSize#, CenterX#, CenterY#, AHeptagon#(), MyBounds AS Box2D)
DECLARE SUB Octagon(SideSize#, CenterX#, CenterY#, AnOctagon#(), MyBounds AS Box2D)
DECLARE SUB Nonagon(SideSize#, CenterX#, CenterY#, ANonagon#(), MyBounds AS Box2D)
DECLARE SUB Decagon(SideSize#, CenterX#, CenterY#, ADecagon#(), MyBounds AS Box2D)
DECLARE SUB Undecagon(SideSize#, CenterX#, CenterY#, AnUndecagon#(), MyBounds AS Box2D)
DECLARE SUB Dodecagon(SideSize#, CenterX#, CenterY#, ADodecagon#(), MyBounds AS Box2D)
DECLARE SUB Arrow(LongSideSize#, CenterX#, CenterY#, AnArrow#(), MyBounds AS Box2D)
DECLARE SUB Diamond(Height#, CenterX#, CenterY#, ADiamond#(), MyBounds AS Box2D)
REM ******************************************************************
REM * The next 2 shapes are slightly more complicated than those *
REM * that have preceded them. They are based around points that *
REM * have already been calculated, but these points are connected *
REM * in a different order to the simple polygons that proceeded *
REM * them and therefore use an INTEGER array to hold a list of *
REM * points to be connected in the order in which they are to be *
REM * connected. In other words these are shapes as described *
REM * earlier. *
REM ******************************************************************
DECLARE SUB Pentagram(Span#, CenterX#, CenterY#, ThisPentagram#(), MyBounds AS Box2D, Connections%())
DECLARE SUB StarOfDavid(Span#, CenterX#, CenterY#, ThisStar#(), MyBounds AS Box2D, Connections%())
REM ******************************************************************
REM * This final set of routines is concerned with the generation of *
REM * curved shapes. Most of the routines in this section actually *
REM * involve calculation as distinct from the preceding routines *
REM * which did not. NOTE - all angles used in this section are *
REM * in degrees. *
REM ******************************************************************
DECLARE FUNCTION CircleInformation%(X1#, Y1#, X2#, Y2#, X3#, Y3#, CenterX#, CenterY#, Radius#)
REM ******************************************************************
REM * Given the three points described by the coordinate pairs *
REM * (X1,Y1), (X2,Y2) and (X3,Y3) this routine calculates the *
REM * centre (CenterX,CenterY) and Radius of a circle. The rules *
REM * for the usage of this routine are that the three points lie on *
REM * the circumference of the circle and are encountered, in order, *
REM * by travelling along the upper hemisphere of the circle in a *
REM * clockwise direction. Further it is an error if all three *
REM * points lie upon a straight line (known as collinearity) and *
REM * FALSE will be returned if this occurs. *
REM ******************************************************************
DECLARE SUB TwinCircleTangent(CenterX1#, CenterY1#, Radius1#, CenterX2#, CenterY2#, Radius2#, Point1X#, Point1Y#, Point2X#, Point2Y#)
REM ******************************************************************
REM * This routine follows a specialised need namely to connect 2 *
REM * arcs with a straight line that flows smoothly into the arcs. *
REM * The way this is done is to take the centres and radii of two *
REM * circles and to calculate the points where an appropriate line *
REM * would be tangential to both. The coordinates of Point1 *
REM * correspond with the details of circle 1 and Point2 with circle *
REM * 2. As for any given pair of circles there are 4 possible *
REM * tangential lines that could connect them a mechanism is needed *
REM * to enable distinction of which line should be calculated. The *
REM * mechanism used is directionality of rotation of the circles *
REM * expressed as the sign of the individual radius's. By this I *
REM * mean that if a radius is negative the corresponding circle is *
REM * assumed to be drawn in a clockwise direction and a positive *
REM * radius, anti-clockwise. Now if you consider the line to be *
REM * drawn as a continuation of the 2 circles it becomes a simple *
REM * matter to determine the signs of the radii to be passed to *
REM * this routine. *
REM ******************************************************************
DECLARE SUB ACircle(Radius#, CenterX#, CenterY#, ThisCircle#(), MyBounds AS Box2D)
REM ******************************************************************
REM * Loads ThisCircle#() with the coordinates of a 72 sided figure *
REM * which simulates a circle of Radius at CenterX, CenterY. *
REM ******************************************************************
DECLARE SUB Ellipse(XRadius#, YRadius#, CenterX#, CenterY#, AnEllipse#(), MyBounds AS Box2D)
REM ******************************************************************
REM * Loads Ellipse#() with the coordinates of a 72 sided figure *
REM * which simulates an ellipse of XRadius, YRadius at CenterX, *
REM * CenterY. The way this works is that a UnitCircle is expanded *
REM * by differing X and Y amounts. *
REM ******************************************************************
DECLARE SUB CalculateAngle(CenterX#, CenterY#, PointX#, PointY#, Angle#)
REM ******************************************************************
REM * Calculates the angle that a line (running from CenterX, *
REM * CenterY to PointX,PointY) makes in relation to the horizontal *
REM * axis. Positive angles indicate that the line is above the *
REM * horizontal axis and negative below. *
REM ******************************************************************
DECLARE FUNCTION GetAngle#(StartAngle#, EndAngle#)
REM ******************************************************************
REM * Calculates the length of an arc, in degrees, of an arc running *
REM * in an anti-clockwise direction from StartAngle to EndAngle. *
REM ******************************************************************
DECLARE FUNCTION ArcInformation%(X1#, Y1#, X2#, Y2#, X3#, Y3#, CenterX#, CenterY#, Radius#, StartAngle#, Degrees#)
REM ******************************************************************
REM * Given 3 points on the circumference of an arc, this routine *
REM * calculates all the information needed to create an arc. Point *
REM * (X1,Y1) is the starting point for the arc, point (X2,Y2) the *
REM * mid-point and point (X3,Y3) the end point of the arc. The *
REM * rules for the usage of this routine are the same as for *
REM * CircleInformation. *
REM ******************************************************************
DECLARE SUB CreateArc(CenterX#, CenterY#, Radius#, StartAngle#, Degrees#, Arc#(), MyBounds AS Box2D)
REM ******************************************************************
REM * Loads Arc#() with the coordinates of an arc described by the *
REM * arguments CenterX#, CenterY#, Radius#, StartAngle# and *
REM * Degrees#. The argument Degrees holds the length of the arc in *
REM * degrees. *
REM ******************************************************************
DECLARE SUB CreateParametricCubicCurve(X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, CubicCurve#(), MyBounds AS Box2D)
REM ******************************************************************
REM * As not all curved shapes are based on conic sections this *
REM * routine and the next offer 2 ways of describing those other *
REM * shapes, based on control points which are external to the *
REM * desired curved shape. In this routine point (X1,Y1) is the *
REM * start point, point (X4,Y4) is the end point. Points (X2,Y2) *
REM * and (X3,Y3) in conjunction with the points already mentioned *
REM * are used to determine the final shape of the curve. This *
REM * routine is based on the algorithm devised by Harry Timmer of *
REM * the Douglas Aircraft Company. This routine (in common with *
REM * many others) uses four blending functions to describe the *
REM * curve parametrically. The characteristic that sets this *
REM * algorithm apart from the others is that if an imaginary line *
REM * is drawn from X2#,Y2# to X3#,Y3# and the curve is then *
REM * calculated and drawn it will be noted that the apex of the *
REM * curve either touches or crosses this line at its centre. *
REM ******************************************************************
DECLARE FUNCTION CreateComplexCurve%(ControlPoints#(), Curve#(), MyBounds AS Box2D)
REM ******************************************************************
REM * This is an extension to the preceding routine. The array *
REM * ControlPoints#() contains a series of control points, the *
REM * number of which must be divisible by 2 and greater than or *
REM * equal to 4 (ideally greater than 4 e.g. at least 6). *
REM ******************************************************************
REM ******************************************************************
REM * The final three routines are here to enable programs to *
REM * interact with the routines presented here. *
REM ******************************************************************
DECLARE FUNCTION DeviceToWorldCoordinates%(InX%, InY%, Vew AS Vision, OutX#, OutY#)
REM ******************************************************************
REM * If a point on the screen (InX%,InY%) is within the viewport in *
REM * Vew the coordinates will be converted to the corresponding *
REM * point in world coordinates and TRUE% returned. Otherwise *
REM * FALSE% is returned. *
REM ******************************************************************
DECLARE FUNCTION InBox%(TX#, TY#, Bounds AS Box2D)
REM ******************************************************************
REM * If the point TX#,TY# is within Bounds TRUE% is returned, *
REM * otherwise FALSE%. *
REM ******************************************************************
DECLARE FUNCTION ClosestPoint%(TX#, TY#, Shape#())
REM ******************************************************************
REM * Returns the number of the coordinate pair in shape#() which is *
REM * closest to TX#, TY#. *
REM ******************************************************************
Library in next post.
TR
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
Now the library.
G2.BI
Code: (Select All) REM ******************************************************
REM * Filespec : g2.bas g2.bi g2.dat *
REM * Date : September 15 1998 *
REM * Time : 12:25 *
REM * Revision : 1.00B *
REM * Update : *
REM ******************************************************
REM * Released to the Public Domain *
REM ******************************************************
'$DYNAMIC
REM ******************************************************************
REM * This is a 2D graphics library. There are 2 common types of *
REM * graphics used with computers - tile graphics and coordinate *
REM * graphics. This library deals entirely with the latter. If *
REM * you do not know what coordinate graphics are, compile the *
REM * library and then run the demo to get some idea. *
REM * *
REM * This library uses the following conventions. The coordinate *
REM * pairs are stored in a 2 dimensional array of the form *
REM * CoordinateArray#(0 TO N, QX% TO QY%). CoordinateArray#(0,QX%) *
REM * and CoordinateArray#(0, QY%) are used to hold the coordinates *
REM * of the centre of the graphics object. The following three *
REM * types are used extensively throughout this library. The type *
REM * Box2D is used both for storing the coordinates of an imaginary *
REM * box surrounding each graphics object and also for the storage *
REM * of the coordinates for graphics windows. AView2D is used to *
REM * store the device coordinates for viewports. Type Vision *
REM * combines both a graphics window and a viewport as well as *
REM * additional information needed for the mapping of the world *
REM * coordinates (stored in the arrays) to device coordinates *
REM * (so you can display them). *
REM ******************************************************************
TYPE Box2D
Left AS DOUBLE
Right AS DOUBLE
Top AS DOUBLE
Bottom AS DOUBLE
END TYPE
TYPE AView2D
Left AS INTEGER
Right AS INTEGER
Top AS INTEGER
Bottom AS INTEGER
END TYPE
TYPE Vision
MyWindow AS Box2D
MyView AS AView2D
XMove AS DOUBLE
YMove AS DOUBLE
XBound AS DOUBLE
YBound AS DOUBLE
XFactor AS DOUBLE
YFactor AS DOUBLE
END TYPE
CONST FALSE% = 0
CONST TRUE% = NOT FALSE%
CONST QX% = 1, QY% = 2
CONST PI# = 3.141592653589793#
CONST PIDividedBy2# = 1.57079632679489661923 'PI / 2
CONST PITimes2# = 6.28318530717959 'PI * 2
CONST PITimes3# = 9.42477796076938 'PI * 3
CONST XScale% = 1, YScale% = 2, Scale% = 3
CONST OneSeventeenth# = .05882352941176471#
G2.BM (1856 lines)
Code: (Select All) REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION HeightWidthRatio#(ScreenMode%, MaxY%)
SELECT CASE ScreenMode%
CASE 0
HeightWidthRatio# = 0
MaxY% = 0
CASE 1
HeightWidthRatio# = 1.2
MaxY% = 199
CASE 2
HeightWidthRatio# = 2.4
MaxY% = 199
CASE 3
HeightWidthRatio# = 1.551724137931034
MaxY% = 347
CASE 4
HeightWidthRatio# = 1.2
MaxY% = 399
CASE 5
HeightWidthRatio# = 0#
MaxY% = 0
CASE 6
HeightWidthRatio# = 0#
MaxY% = 0
CASE 7
HeightWidthRatio# = 1.2
MaxY% = 199
CASE 8
HeightWidthRatio# = 2.4
MaxY% = 199
CASE 9
HeightWidthRatio# = 1.371428571428571
MaxY% = 349
CASE 10
HeightWidthRatio# = 1.371428571428571
MaxY% = 349
CASE 11
HeightWidthRatio# = 1#
MaxY% = 479
CASE 12
HeightWidthRatio# = 1#
MaxY% = 479
CASE 13
HeightWidthRatio# = 1.2
MaxY% = 199
END SELECT
END FUNCTION
REM ******************************************************************
REM * The following routines are for the general management of the *
REM * arrays used to hold the coordinates that we are working with. *
REM * All of the following routines return TRUE% if they are *
REM * successful and FALSE% if an error condition was detected. The *
REM * output arrays are automatically resized to exactly the size *
REM * necessary to hold the output data. *
REM ******************************************************************
REM ******************************************************************
REM * Copies InShape#() to OutShape#(). *
REM ******************************************************************
FUNCTION CopyShape2D%(InShape#(), OutShape#())
MyLast% = UBOUND(InShape#)
IF MyLast% < 1 THEN
CopyShape2D% = FALSE%
EXIT FUNCTION
END IF
REDIM OutShape#(0 TO MyLast%, QX% TO QY%)
FOR Index% = 0 TO MyLast%
OutShape#(Index%, QX%) = InShape#(Index%, QX%)
OutShape#(Index%, QY%) = InShape#(Index%, QY%)
NEXT Index%
CopyShape2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Appends the contents of This#() onto the end of OntoThis#(). *
REM ******************************************************************
FUNCTION AppendShape2D%(This#(), OntoThis#())
REDIM Temp#(0 TO 1, QX% TO QY%)
IF NOT CopyShape2D%(OntoThis#(), Temp#()) THEN
AppendShape2D% = FALSE%
EXIT FUNCTION
END IF
Last1% = UBOUND(OntoThis#)
Last2% = UBOUND(This#)
IF Last2% < 1 THEN
AppendShape2D% = FALSE%
EXIT FUNCTION
END IF
NewLast% = Last1% + Last2%
REDIM OntoThis#(0 TO NewLast%, QX% TO QY%)
FOR Index% = 0 TO Last1%
OntoThis#(Index%, QX%) = Temp#(Index%, QX%)
OntoThis#(Index%, QY%) = Temp#(Index%, QY%)
NEXT Index%
FOR Index% = 1 TO Last2%
Here% = Last1% + Index%
OntoThis#(Here%, QX%) = This#(Index%, QX%)
OntoThis#(Here%, QY%) = This#(Index%, QY%)
NEXT Index%
AppendShape2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Identical to the preceding routine with additional action of *
REM * copying the first coordinate pair of OntoThis#() to its end *
REM * after appending This#(). *
REM ******************************************************************
FUNCTION MakePolygon%(This#(), OntoThis#())
REDIM Temp#(0 TO 1, QX% TO QY%)
IF NOT CopyShape2D%(OntoThis#(), Temp#()) THEN
MakePolygon% = FALSE%
EXIT FUNCTION
END IF
Last1% = UBOUND(OntoThis#)
Last2% = UBOUND(This#)
IF Last2% < 1 THEN
MakePolygon% = FALSE%
EXIT FUNCTION
END IF
NewLast% = Last1% + Last2% + 1
REDIM OntoThis#(0 TO NewLast%, QX% TO QY%)
FOR Index% = 0 TO Last1%
OntoThis#(Index%, QX%) = Temp#(Index%, QX%)
OntoThis#(Index%, QY%) = Temp#(Index%, QY%)
NEXT Index%
FOR Index% = 1 TO Last2%
Here% = Last1% + Index%
OntoThis#(Here%, QX%) = This#(Index%, QX%)
OntoThis#(Here%, QY%) = This#(Index%, QY%)
NEXT Index%
OntoThis#(NewLast%, QX%) = OntoThis#(1, QX%)
OntoThis#(NewLast%, QY%) = OntoThis#(1, QY%)
MakePolygon% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Inserts the contents of This#() into IntoThis#() after the *
REM * coordinate pair specified by AfterThis%. *
REM ******************************************************************
FUNCTION InsertShape2D%(This#(), IntoThis#(), AfterThisPoint%)
REDIM Temp#(0 TO 1, QX% TO QY%)
IF NOT CopyShape2D%(IntoThis#(), Temp#()) THEN
InsertShape2D% = FALSE%
EXIT FUNCTION
END IF
Last1% = UBOUND(IntoThis#)
Last2% = UBOUND(This#)
IF Last2% < 1 OR Last1% < 2 THEN
InsertShape2D% = FALSE%
EXIT FUNCTION
END IF
NewLast% = Last1% + Last2%
REDIM IntoThis#(0 TO NewLast%, QX% TO QY%)
FOR Index% = 0 TO AfterThisPoint%
IntoThis#(Index%, QX%) = Temp#(Index%, QX%)
IntoThis#(Index%, QY%) = Temp#(Index%, QY%)
NEXT Index%
FOR Index% = 1 TO Last2%
Here% = AfterThisPoint% + Index%
IntoThis#(Here%, QX%) = This#(Index%, QX%)
IntoThis#(Here%, QY%) = This#(Index%, QY%)
NEXT Index%
Increment% = 1
FOR Index% = (AfterThisPoint% + 1) TO Last1%
Here% = AfterThisPoint% + Last2% + Increment%
Increment% = Increment% + 1
IntoThis#(Here%, QX%) = Temp#(Index%, QX%)
IntoThis#(Here%, QY%) = Temp#(Index%, QY%)
NEXT Index%
InsertShape2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Deletes the coordinate pair specified by PointNumber%, From *
REM * This#(). *
REM ******************************************************************
FUNCTION DeletePoint2D%(This#(), PointNumber%)
Last% = UBOUND(This#)
IF Last% < 3 THEN
DeletePoint2D% = FALSE%
EXIT FUNCTION
END IF
REDIM Temp#(0 TO 1, QX% TO QY%)
IF NOT CopyShape2D%(This#(), Temp#()) THEN
DeletePoint2D% = FALSE%
EXIT FUNCTION
END IF
REDIM This#(0 TO Last% - 1, QX% TO QY%)
FOR Index% = 0 TO PointNumber% - 1
This#(Index%, QX%) = Temp#(Index%, QX%)
This#(Index%, QY%) = Temp#(Index%, QY%)
NEXT Index%
FOR Index% = PointNumber% + 1 TO Last%
This#(Index% - 1, QX%) = Temp#(Index%, QX%)
This#(Index% - 1, QY%) = Temp#(Index%, QY%)
NEXT Index%
DeletePoint2D% = TRUE%
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION MAX#(A#, B#)
IF B# > A# THEN
MAX# = B#
ELSE
MAX# = A#
END IF
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION MIN#(A#, B#)
IF A# > B# THEN
MIN# = B#
ELSE
MIN# = A#
END IF
END FUNCTION
REM ******************************************************************
REM * This routine determines the values for an imaginary box *
REM * surrounding the graphics object held in This#(). These values *
REM * are placed in MyBounds. The exact centre of the object is *
REM * also determined by this routine and the coordinate pair of *
REM * this centre are placed in This#(0, QX%) and This#(0, QY%). *
REM ******************************************************************
FUNCTION OuterLimits2D%(This#(), MyBounds AS Box2D)
Last% = UBOUND(This#)
IF Last% < 1 THEN
OuterLimits2D% = FALSE%
EXIT FUNCTION
END IF
MyBounds.Left = This#(1, QX%)
MyBounds.Right = This#(1, QX%)
MyBounds.Top = This#(1, QY%)
MyBounds.Bottom = This#(1, QY%)
FOR Index% = 2 TO Last%
TestX# = This#(Index%, QX%)
TestY# = This#(Index%, QY%)
MyBounds.Left = MIN#(MyBounds.Left, TestX#)
MyBounds.Right = MAX#(MyBounds.Right, TestX#)
MyBounds.Top = MIN#(MyBounds.Top, TestY#)
MyBounds.Bottom = MAX#(MyBounds.Bottom, TestY#)
NEXT Index%
This#(0, QX%) = (MyBounds.Left + MyBounds.Right) / 2#
This#(0, QY%) = (MyBounds.Top + MyBounds.Bottom) / 2#
OuterLimits2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * The following routines manipulate the coordinate pairs held in *
REM * the arrays in the manner specified in the individual *
REM * descriptions. Once all calculations are complete the new *
REM * exact centre and boundary values are determined by an *
REM * automatic call to OuterLimits2D%. All of the following *
REM * routines return TRUE% to indicate successful completion or *
REM * FALSE% if an error condition was detected. *
REM ******************************************************************
REM ******************************************************************
REM * Relative movement. Moves the whole object by the amounts *
REM * specified in ByX# and ByY#. *
REM ******************************************************************
FUNCTION Translate2D%(This#(), MyBounds AS Box2D, ByX#, ByY#)
Last% = UBOUND(This#)
IF Last% < 1 THEN
Translate2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 0 TO Last%
This#(Index%, QX%) = This#(Index%, QX%) + ByX#
This#(Index%, QY%) = This#(Index%, QY%) + ByY#
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
Translate2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Absolute movement. Moves the whole object so that the centre *
REM * of the object is positioned at ToX#, ToY#. *
REM ******************************************************************
FUNCTION MoveTo2D%(This#(), MyBounds AS Box2D, ToX#, ToY#)
IF UBOUND(This#) < 1 THEN
MoveTo2D% = FALSE%
EXIT FUNCTION
END IF
NewX# = ToX# - This#(0, QX%)
NewY# = ToY# - This#(0, QY%)
MoveTo2D% = Translate2D%(This#(), MyBounds, NewX#, NewY#)
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION Inflation2D%(This#(), MyBounds AS Box2D, By#, InflationType%)
Last% = UBOUND(This#)
IF Last% < 1 OR By# = 0# THEN
Inflation2D% = FALSE%
EXIT FUNCTION
END IF
SELECT CASE InflationType%
CASE XScale%
XC# = This#(0, QX%)
FOR Index% = 1 TO Last%
This#(Index%, QX%) = ((This#(Index%, QX%) - XC#) * By#) + XC#
NEXT Index%
CASE YScale%
YC# = This#(0, QY%)
FOR Index% = 1 TO Last%
This#(Index%, QY%) = ((This#(Index%, QY%) - YC#) * By#) + YC#
NEXT Index%
CASE Scale%
XC# = This#(0, QX%)
YC# = This#(0, QY%)
FOR Index% = 1 TO Last%
This#(Index%, QX%) = ((This#(Index%, QX%) - XC#) * By#) + XC#
This#(Index%, QY%) = ((This#(Index%, QY%) - YC#) * By#) + YC#
NEXT Index%
END SELECT
dummy% = OuterLimits2D%(This#(), MyBounds)
Inflation2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Make the object wider by the amount specified in By#, without *
REM * disturbing the position of it's centre. *
REM ******************************************************************
FUNCTION InflateX2D%(This#(), MyBounds AS Box2D, By#)
InflateX2D% = Inflation2D%(This#(), MyBounds, By#, XScale%)
END FUNCTION
REM ******************************************************************
REM * Make the object taller by the amount specified in By#, without *
REM * disturbing the position of it's centre. *
REM ******************************************************************
FUNCTION InflateY2D%(This#(), MyBounds AS Box2D, By#)
InflateY2D% = Inflation2D%(This#(), MyBounds, By#, YScale%)
END FUNCTION
REM ******************************************************************
REM * Make the object larger in both dimensions by the amount *
REM * specified in By#, without disturbing the position of it's *
REM * centre. *
REM ******************************************************************
FUNCTION Inflate2D%(This#(), MyBounds AS Box2D, By#)
Inflate2D% = Inflation2D%(This#(), MyBounds, By#, Scale%)
END FUNCTION
REM ******************************************************************
REM * Make the object wider by the amount specified in By#. *
REM ******************************************************************
FUNCTION ScaleX2D%(This#(), MyBounds AS Box2D, By#)
Last% = UBOUND(This#)
IF Last% < 1 OR By# = 0# THEN
ScaleX2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 1 TO Last%
This#(Index%, QX%) = This#(Index%, QX%) * By#
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
ScaleX2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Make the object taller by the amount specified in By#. *
REM ******************************************************************
FUNCTION ScaleY2D%(This#(), MyBounds AS Box2D, By#)
Last% = UBOUND(This#)
IF Last% < 1 OR By# = 0# THEN
ScaleY2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 1 TO Last%
This#(Index%, QY%) = This#(Index%, QY%) * By#
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
ScaleY2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Make the object taller (ByY#) and wider (ByX~) by the amount *
REM * specified. *
REM ******************************************************************
FUNCTION ScaleXY2D%(This#(), MyBounds AS Box2D, ByX#, ByY#)
Last% = UBOUND(This#)
IF Last% < 1 OR ByX# = 0# OR ByY# = 0# THEN
ScaleXY2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 1 TO Last%
This#(Index%, QX%) = This#(Index%, QX%) * ByX#
This#(Index%, QY%) = This#(Index%, QY%) * ByY#
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
ScaleXY2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Make the object larger by the amount specified in By#. *
REM ******************************************************************
FUNCTION Scale2D%(This#(), MyBounds AS Box2D, By#)
Last% = UBOUND(This#)
IF Last% < 1 OR By# = 0# THEN
Scale2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 1 TO Last%
This#(Index%, QX%) = This#(Index%, QX%) * By#
This#(Index%, QY%) = This#(Index%, QY%) * By#
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
Scale2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Shearing in the X plane distorts the figure in a manner that *
REM * relates the amount specified in By# and Y coordinate for each *
REM * point. *
REM ******************************************************************
FUNCTION ShearX2D%(This#(), MyBounds AS Box2D, By#)
Last% = UBOUND(This#)
IF Last% < 2 OR By# = 0# THEN
ShearX2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 1 TO Last%
This#(Index%, QX%) = This#(Index%, QX%) + (This#(Index%, QY%) * By#)
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
ShearX2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Shearing in the Y plane distorts the figure in a manner that *
REM * relates the amount specified in By# and X coordinate for each *
REM * point. *
REM ******************************************************************
FUNCTION ShearY2D%(This#(), MyBounds AS Box2D, By#)
Last% = UBOUND(This#)
IF Last% < 2 OR By# = 0# THEN
ShearY2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 1 TO Last%
This#(Index%, QY%) = This#(Index%, QY%) + (This#(Index%, QX%) * By#)
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
ShearY2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * This merely combines shearing in both planes into a single *
REM * procedure. *
REM ******************************************************************
FUNCTION Shear2D%(This#(), MyBounds AS Box2D, ByX#, ByY#)
Last% = UBOUND(This#)
IF Last% < 2 OR ByX# = 0# OR ByY# = 0# THEN
Shear2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 1 TO Last%
OldX# = This#(Index%, QX%)
OldY# = This#(Index%, QY%)
This#(Index%, QX%) = OldX# + (OldY# * ByX#)
This#(Index%, QY%) = OldY# + (OldX# * ByY#)
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
Shear2D% = TRUE%
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION NormaliseDegrees#(Degrees#)
Degs# = Degrees#
DO WHILE Degs# > 180
Degs# = Degs# - 360
LOOP
DO WHILE Degs# < -180
Degs# = Degs# + 360
LOOP
NormaliseDegrees# = Degs#
END FUNCTION
REM ******************************************************************
REM * Rotates the figure about the origin (that is the point at 0,0) *
REM * by Angle#. The direction of the rotation is controlled by the *
REM * sign of Angle#. A positive Angle# gives rotation in an *
REM * anti-clockwise direction and a negative one gives a clockwise *
REM * rotation. *
REM ******************************************************************
FUNCTION Rotation2D%(This#(), MyBounds AS Box2D, Angle#)
Last% = UBOUND(This#)
IF Last% < 1 THEN
Rotation2D% = FALSE%
EXIT FUNCTION
END IF
C# = COS(NormaliseDegrees#(Angle#) * (PI# / 180#))
S# = SIN(NormaliseDegrees#(Angle#) * (PI# / 180#))
FOR Index% = 1 TO Last%
OldX# = This#(Index%, QX%)
OldY# = This#(Index%, QY%)
This#(Index%, QX%) = OldX# * C# - OldY# * S#
This#(Index%, QY%) = OldX# * S# + OldY# * C#
NEXT Index%
dummy% = OuterLimits2D%(This#(), MyBounds)
Rotation2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Identical to Rotation2D except that the rotation is about the *
REM * centre of the figure being rotated. *
REM ******************************************************************
FUNCTION Spin2D%(This#(), MyBounds AS Box2D, Angle#)
IF UBOUND(This#) < 1 THEN
Spin2D% = FALSE%
EXIT FUNCTION
END IF
OldX# = This#(0, QX%)
OldY# = This#(0, QY%)
Spin2D%= Orbit2D%(This#(), MyBounds, OldX#, OldY#, Angle#)
END FUNCTION
REM ******************************************************************
REM * Identical to Rotation2D except that the rotation is about *
REM * OrbitX#, OrbitY#. *
REM ******************************************************************
FUNCTION Orbit2D%(This#(), MyBounds AS Box2D, OrbitX#, OrbitY#, Angle#)
IF UBOUND(This#) < 1 THEN
Orbit2D% = FALSE%
EXIT FUNCTION
END IF
IF Translate2D%(This#(), MyBounds, -OrbitX#, -OrbitY#) THEN
IF Rotation2D%(This#(), MyBounds, Angle#) THEN
IF Translate2D%(This#(), MyBounds, OrbitX#, OrbitY#) THEN
dummy% = OuterLimits2D%(This#(), MyBounds)
Orbit2D% = TRUE%
ELSE
Orbit2D% = FALSE%
END IF
ELSE
Orbit2D% = FALSE%
END IF
ELSE
Orbit2D% = FALSE%
END IF
END FUNCTION
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB TestAndSwap(A#, B#, IsColinear%)
IF A# = B# THEN
IsColinear% = TRUE%
EXIT SUB
ELSE
IsColiear% = FALSE%
END IF
IF A# < B# THEN
SWAP A#, B#
END IF
END SUB
REM ******************************************************************
REM * The next 3 routines are for the management of the data types *
REM * used to control which part(s) of the graphical objects we are *
REM * dealing with are visible and where they will be displayed. *
REM * While it is true that QB already has such mechanisms built-in, *
REM * you can only have one graphical window and one view-port at a *
REM * time with these. The graphical system presented here allows *
REM * for multiple such windows and viewports at once. *
REM ******************************************************************
REM ******************************************************************
REM * Stores the values held in Left#, Right#, Top# and Bottom# in *
REM * ThisWindow. *
REM ******************************************************************
FUNCTION SetNewWindow2D%(ThisWindow AS Box2D, Left#, Right#, Top#, Bottom#)
TestAndSwap Right#, Left#, InLine%
IF InLine% THEN
SetNewWindow2D% = FALSE%
EXIT FUNCTION
END IF
TestAndSwap Top#, Bottom#, InLine%
IF InLine% THEN
SetNewWindow2D% = FALSE%
EXIT FUNCTION
END IF
ThisWindow.Left = Left#
ThisWindow.Right = Right#
ThisWindow.Top = Top#
ThisWindow.Bottom = Bottom#
SetNewWindow2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Stores the values held in Left%, Right%, Top% and Bottom% in *
REM * ViewPort. *
REM ******************************************************************
FUNCTION SetNewViewPort%(ViewPort AS AView2D, Left%, Right%, Top%, Bottom%)
IF ((Left% = Right%) OR (Top% = Bottom%)) THEN
SetNewViewPort% = FALSE%
EXIT FUNCTION
END IF
IF Right% < Left% THEN
SWAP Left%, Right%
END IF
IF Bottom% < Top% THEN
SWAP Top%, Bottom%
END IF
ViewPort.Left = Left%
ViewPort.Right = Right%
ViewPort.Top = Top%
ViewPort.Bottom = Bottom%
SetNewViewPort% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Copies the contents of ThisWindow and ViewPort to Vew and then *
REM * makes certain calculations, storing the results in Vew. This *
REM * way all of the information necessary for mapping the world *
REM * coordinates (i.e. those stored in the coordinate arrays) to *
REM * the device coordinates (i.e. those of the monitor's screen). *
REM * *
REM * NOTE - if you do not want your graphics to have uncontrolled *
REM * distortion it is essential that the aspect ratio *
REM * (i.e. (Right - Left) / (Top - Bottom)) of ThisWindow and *
REM * ViewPort are identical. *
REM ******************************************************************
SUB SetNewVision(Vew AS Vision, ThisWindow AS Box2D, ViewPort AS AView2D)
Vew.MyWindow.Left = ThisWindow.Left
Vew.MyWindow.Right = ThisWindow.Right
Vew.MyWindow.Top = ThisWindow.Top
Vew.MyWindow.Bottom = ThisWindow.Bottom
Vew.MyView.Left = ViewPort.Left
Vew.MyView.Right = ViewPort.Right
Vew.MyView.Top = ViewPort.Top
Vew.MyView.Bottom = ViewPort.Bottom
Vew.XMove = (ThisWindow.Right + ThisWindow.Left) * 0.5
Vew.YMove = (ThisWindow.Top + ThisWindow.Bottom) * 0.5
Vew.XBound = ThisWindow.Right - Vew.XMove
Vew.YBound = ThisWindow.Top - Vew.YMove
Vew.XFactor = CDBL(ViewPort.Right - ViewPort.Left) / (ThisWindow.Right - ThisWindow.Left)
Vew.YFactor = CDBL(ViewPort.Bottom - ViewPort.Top) / (ThisWindow.Top - ThisWindow.Bottom)
END SUB
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION NotInWindow%(This#(), MyBounds AS Box2D, Vew AS Vision)
IF MyBounds.Left > Vew.MyWindow.Right THEN
NotInWindow% = TRUE%
EXIT FUNCTION
END IF
IF MyBounds.Right < Vew.MyWindow.Left THEN
NotInWindow% = TRUE%
EXIT FUNCTION
END IF
IF MyBounds.Bottom > Vew.MyWindow.Top THEN
NotInWindow% = TRUE%
EXIT FUNCTION
END IF
IF MyBounds.Top < Vew.MyWindow.Bottom THEN
NotInWindow% = TRUE%
EXIT FUNCTION
END IF
NotInWindow% = FALSE%
END FUNCTION
REM ******************************************************
REM * Private SUB - Do not call directly *
REM ******************************************************
SUB ClipCodes2D(Xw#, Yw#, Vew AS Vision, XCode#, YCode#)
XNew# = Xw# - Vew.XMove
YNew# = Yw# - Vew.YMove
IF ABS(XNew#) > Vew.XBound THEN
XCode# = CDBL(SGN(XNew#))
ELSE
XCode# = 0#
END IF
IF ABS(YNew#) > Vew.YBound THEN
YCode# = CDBL(SGN(YNew#))
ELSE
YCode# = 0#
END IF
END SUB
REM ******************************************************************
REM * If a line is within the Box2D held in Vew, it will be trimmed *
REM * to fit if necessary. Visible% flags the obvious. *
REM ******************************************************************
SUB ClipLine2D(X1Old#, Y1Old#, X2Old#, Y2Old#, X1New#, Y1New#, X2New#, Y2New#, Vew AS Vision, Visible%)
ClipCodes2D X1Old#, Y1Old#, Vew, X1Code#, Y1Code#
ClipCodes2D X2Old#, Y2Old#, Vew, X2Code#, Y2Code#
IF (X1Code# * X2Code#) = 1# OR (Y1Code# * Y2Code#) = 1# THEN
Visible% = FALSE%
X1New# = X1Old#
Y1New# = Y1Old#
X2New# = X2Old#
Y2New# = Y2Old#
EXIT SUB
END IF
X1New# = X1Old# - Vew.XMove
Y1New# = Y1Old# - Vew.YMove
X2New# = X2Old# - Vew.XMove
Y2New# = Y2Old# - Vew.YMove
IF X1Code# <> 0# THEN
Temp# = Vew.XBound * X1Code#
Ratio# = (Temp# - X1New#) / (X2New# - X1New#)
Y1New# = Y1New# + (Y2New# - Y1New#) * Ratio#
X1New# = Temp#
ClipCodes2D X1New# + Vew.XMove, Y1New# + Vew.YMove, Vew, X1Code#, Y1Code#
END IF
IF Y1Code# <> 0# THEN
Temp# = Vew.YBound * Y1Code#
Ratio# = (Temp# - Y1New#) / (Y2New# - Y1New#)
X1New# = X1New# + (X2New# - X1New#) * Ratio#
Y1New# = Temp#
END IF
IF X2Code# <> 0# THEN
Temp# = Vew.XBound * X2Code#
Ratio# = (Temp# - X2New#) / (X2New# - X1New#)
Y2New# = Y2New# + (Y2New# - Y1New#) * Ratio#
X2New# = Temp#
ClipCodes2D X2New# + Vew.XMove, Y2New# + Vew.YMove, Vew, X2Code#, Y2Code#
END IF
IF Y2Code# <> 0# THEN
Temp# = Vew.YBound * Y2Code#
Ratio# = (Temp# - Y2New#) / (Y2New# - Y1New#)
X2New# = X2New# + (X2New# - X1New#) * Ratio#
Y2New# = Temp#
END IF
Visible% = TRUE%
X1New# = X1New# + Vew.XMove
Y1New# = Y1New# + Vew.YMove
X2New# = X2New# + Vew.XMove
Y2New# = Y2New# + Vew.YMove
END SUB
REM ******************************************************************
REM * Those dots in Shape2D# that are within the Box2D held in Vew *
REM * are returned in dots. *
REM ******************************************************************
FUNCTION ClipDots2D%(Shape2D#(), MyBounds AS Box2D, Vew AS Vision, Dots#())
IF NotInWindow%(Shape2D#(), MyBounds, Vew) THEN
ClipDots2D% = FALSE%
EXIT FUNCTION
END IF
Last% = UBOUND(Shape2D#)
REDIM Temp#(0 TO Last%, QX% TO QY%)
Count% = 1
FOR Index% = 1 TO UBOUND(Shape2D#)
TestX# = Shape2D#(Index%, QX%)
TestY# = Shape2D#(Index%, QY%)
IF (TestX# >= Vew.MyWindow.Left) AND (TestX# <= Vew.MyWindow.Right) THEN
IF (TestY# >= Vew.MyWindow.Bottom) AND (TestY# <= Vew.MyWindow.Top) THEN
Temp#(Count%, QX%) = TestX#
Temp#(Count%, QY%) = TestY#
Count% = Count% + 1
END IF
END IF
NEXT Index%
IF Count% = 1 THEN
ClipDots2D% = FALSE%
ELSE
REDIM Dots#(0 TO Count% - 1, QX% TO QY%)
FOR Index% = 1 TO Count% - 1
Dots#(Index%, QX%) = Temp#(Index%, QX%)
Dots#(Index%, QY%) = Temp#(Index%, QY%)
NEXT Index%
ClipDots2D% = TRUE%
END IF
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION Map2D2%(Shape2D#(), Vew AS Vision, ConnectionList%(), DisplayShape%())
Last% = UBOUND(Shape2D#)
ListLast% = UBOUND(ConnectionList%)
IF (((Last% < 1) OR (ConnectionList%(0) < 0)) OR (ListLast% < 1)) THEN
Map2D2% = FALSE%
EXIT FUNCTION
END IF
Here% = ConnectionList%(0)
IF Here% > Last% THEN
Map2D2% = FALSE%
EXIT FUNCTION
END IF
Count% = 1
REDIM Temp%(1 TO 1000, QX% TO QY%)
OldX1# = Shape2D#(Here%, QX%)
OldY1# = Shape2D#(Here%, QY%)
FOR Index% = 1 TO ListLast%
Here% = ConnectionList%(Index%)
IF Here% < 0 THEN
Temp%(Count%, QX%) = -1
Temp%(Count%, QY%) = -1
Count% = Count% + 1
Index% = Index% + 1
IF Index% < ListLast% THEN
Here% = ConnectionList%(Index%)
IF Here% < 0 OR Here% > Last% THEN
Map2D2% = FALSE%
EXIT FUNCTION
END IF
OldX1# = Shape2D#(Here%, QX%)
OldY1# = Shape2D#(Here%, QY%)
END IF
ELSE
IF Here% > Last% THEN
Map2D2% = FALSE%
EXIT FUNCTION
END IF
OldX2# = Shape2D#(Here%, QX%)
OldY2# = Shape2D#(Here%, QY%)
ClipLine2D OldX1#, OldY1#, OldX2#, OldY2#, NewX1#, NewY1#, NewX2#, NewY2#, Vew, IsVisible%
IF IsVisible% THEN
NewX1# = (NewX1# - Vew.MyWindow.Left) * Vew.XFactor
NewY1# = (NewY1# - Vew.MyWindow.Bottom) * Vew.YFactor
GX% = INT(NewX1#) + Vew.MyView.Left
GY% = Vew.MyView.Bottom - INT(NewY1#)
Temp%(Count%, QX%) = GX%
Temp%(Count%, QY%) = GY%
Count% = Count% + 1
NewX2# = (NewX2# - Vew.MyWindow.Left) * Vew.XFactor
NewY2# = (NewY2# - Vew.MyWindow.Bottom) * Vew.YFactor
GX% = INT(NewX2#) + Vew.MyView.Left
GY% = Vew.MyView.Bottom - INT(NewY2#)
Temp%(Count%, QX%) = GX%
Temp%(Count%, QY%) = GY%
Count% = Count% + 1
ELSE
Temp%(Count%, QX%) = -1
Temp%(Count%, QY%) = -1
Count% = Count% + 1
END IF
OldX1# = OldX2#
OldY1# = OldY2#
END IF
NEXT Index%
Count% = Count% - 1
REDIM DisplayShape%(1 TO Count%, QX% TO QY%)
FOR Index% = 1 TO Count%
DisplayShape%(Index%, QX%) = Temp%(Index%, QX%)
DisplayShape%(Index%, QY%) = Temp%(Index%, QY%)
NEXT Index%
Map2D2% = TRUE%
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION Map2D3%(Shape2D#(), MyBounds AS Box2D, Vew AS Vision, Dots%())
REDIM Temp#(0 To 1, QX% TO QY%)
IF NOT ClipDots2D%(Shape2D#(), MyBounds, Vew, Temp#()) THEN
Map2D3% = FALSE%
EXIT FUNCTION
END IF
Last% = UBOUND(Temp#)
REDIM Dots%(1 TO Last%, QX% TO QY%)
FOR Index% = 1 TO Last%
FX# = Temp#(Index%, QX%)
FY# = Temp#(Index%, QY%)
FX# = (FX# - Vew.MyWindow.Left) * Vew.XFactor
FY# = (FY# - Vew.MyWindow.Bottom) * Vew.YFactor
Dots%(Index%, QX%) = INT(FX#) + Vew.MyView.Left
Dots%(Index%, QY%) = Vew.MyView.Bottom - INT(FY#)
NEXT Index%
Map2D3% = TRUE%
END FUNCTION
REM ******************************************************************
REM * In the context of the following routines a polygon is simply a *
REM * list of coordinates that will be drawn as lines. The way that *
REM * these lines are drawn is as follows. The first line to be *
REM * drawn uses the first pair of coordinates to produce the line. *
REM * The next and subsequent lines use the last coordinates from *
REM * the previous line as their first coordinate and the next *
REM * coordinate as their last coordinate. If a closed figure is *
REM * desired, it is necessary for the last pair of coordinates to *
REM * be identical to the first pair. *
REM * *
REM * A shape, on the other hand is more complex and therefore uses *
REM * an INTEGER array to hold a list of points to be connected in *
REM * the order in which they are to be connected. The format of *
REM * the data held in this array is as follows:- *
REM * *
REM * The first 2 coordinate pairs (i.e. A#(1, QX%), A#(1,QY%) and *
REM * A#(2,QX%), A#(2,QY%)) ALWAYS specify the start and end points *
REM * of the first line of the figure. After that, the last point *
REM * of the preceding pair of points is the start point for the *
REM * next line and the next item specifies the end point of that *
REM * line unless the next A#(N, QX%) is -1. If it is -1 it means *
REM * drop the data already read and treat the next 2 coordinate *
REM * pairs as the start and end points of the next line. As an *
REM * example of this, the snippet of code below is the actual *
REM * connection list for the StarOfDavid which is defined later. *
REM * *
REM * Connections%(0) = 1 *
REM * Connections%(1) = 3 *
REM * Connections%(2) = 5 *
REM * Connections%(3) = 7 *
REM * Connections%(4) = -1 *
REM * Connections%(5) = 2 *
REM * Connections%(6) = 4 *
REM * Connections%(7) = 6 *
REM * Connections%(8) = 2 *
REM * *
REM ******************************************************************
REM ******************************************************************
REM * Tries to display the points held in Dots on the current *
REM * graphics screen without any clipping or mapping. *
REM ******************************************************************
FUNCTION DisplayDotsDirect%(Dots#(), MyBounds AS Box2D, ScreenMode%, Colour%)
REDIM TempShape#(0 TO 1, QX% TO QY%)
IF NOT CopyShape2D%(Dots#(), TempShape#()) THEN
DisplayDotsDirect% = FALSE%
EXIT FUNCTION
END IF
Last% = UBOUND(TempShape#)
By# = HeightWidthRatio#(ScreenMode%, LastY%)
dummy% = InflateX2D%(TempShape#(), MyBounds, By#)
FOR Index% = 1 TO Last%
X1% = INT(TempShape#(Index%, QX%))
Y1% = LastY% - INT(TempShape#(Index%, QY%))
PSET(X1%, Y1%), Colour%
NEXT Index%
DisplayDotsDirect% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Tries to display the lines described in Polygon on the current *
REM * graphics screen without any clipping or mapping. *
REM ******************************************************************
FUNCTION DisplayPolygonDirect%(Polygon#(), MyBounds AS Box2D, ScreenMode%, Colour%)
REDIM TempShape#(0 TO 1, QX% TO QY%)
IF NOT CopyShape2D%(Polygon#(), TempShape#()) THEN
DisplayPolygonDirect% = FALSE%
EXIT FUNCTION
END IF
Last% = UBOUND(TempShape#)
By# = HeightWidthRatio#(ScreenMode%, LastY%)
dummy% = InflateX2D%(TempShape#(), MyBounds, By#)
X1% = INT(TempShape#(1, QX%))
Y1% = LastY% - INT(TempShape#(1, QY%))
FOR Index% = 2 TO Last%
X2% = INT(TempShape#(Index%, QX%))
Y2% = LastY% - INT(TempShape#(Index%, QY%))
LINE(X1%, Y1%)-(X2%, Y2%), Colour%
X1% = X2%
Y1% = Y2%
NEXT Index%
DisplayPolygonDirect% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Tries to display the lines described in Shape2D and List, on *
REM * the current graphics screen without any clipping or mapping. *
REM ******************************************************************
FUNCTION DisplayShapeDirect%(Shape2D#(), MyBounds AS Box2D, ConnectionList%(), ScreenMode%, Colour%)
DIM TempShape#(0 TO 1, QX% TO QY%)
IF NOT CopyShape2D%(Shape2D#(), TempShape#()) THEN
DisplayShapeDirect% = FALSE%
EXIT FUNCTION
END IF
ListLast% = UBOUND(ConnectionList%)
IF ListLast% < 1 THEN
DisplayShapeDirect% = FALSE%
EXIT FUNCTION
END IF
L0% = ConnectionList%(0)
By# = HeightWidthRatio#(ScreenMode%, LastY%)
dummy% = InflateX2D%(TempShape#(), MyBounds, By#)
X1% = INT(TempShape#(L0%, QX%))
Y1% = LastY% - INT(TempShape#(L0%, QY%))
FOR Index% = 1 TO ListLast%
IF ConnectionList%(Index%) < 0 THEN
DO WHILE ConnectionList%(Index%) < 0
Index% = Index% + 1
IF Index% >= ListLast% THEN
DisplayShapeDirect% = FALSE%
EXIT FUNCTION
END IF
LOOP
X1% = INT(TempShape#(ConnectionList%(Index%), QX%))
Y1% = LastY% - INT(TempShape#(ConnectionList%(Index%), QY%))
ELSE
X2% = INT(TempShape#(ConnectionList%(Index%), QX%))
Y2% = LastY% - INT(TempShape#(ConnectionList%(Index%), QY%))
LINE(X1%, Y1%)-(X2%, Y2%), Colour%
X1% = X2%
Y1% = Y2%
END IF
NEXT Index%
DisplayShapeDirect% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Those points held in Dots that are within the Box2D that is *
REM * part of Vew will be clipped, mapped and displayed by this *
REM * routine. *
REM ******************************************************************
FUNCTION DisplayDots%(Dots#(), MyBounds AS Box2D, Colour%, Vew AS Vision)
DIM MyDots%(0 To 1, QX% TO QY%)
IF NOT Map2D3%(Dots#(), MyBounds, Vew, MyDots%()) THEN
DisplayDots% = FALSE%
EXIT FUNCTION
END IF
Last% = UBOUND(MyDots%)
FOR Index% = 1 TO Last%
PSET(MyDots%(Index%, QX%), MyDots%(Index%, QY%)), Colour%
NEXT Index%
DisplayDots% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Any portion of the line described by point (X1,Y1) to point *
REM * (X2,Y2), that is within the Box2D that is part of Vew it will *
REM * be clipped, mapped and displayed by this routine. *
REM ******************************************************************
SUB DisplayLine(X1#, Y1#, X2#, Y2#, Colour%, Vew AS Vision)
ClipLine2D X1#, Y1#, X2#, Y2#, NewX1#, NewY1#, NewX2#, NewY2#, Vew, Visible%
IF Visible% THEN
NewX1# = (NewX1# - Vew.MyWindow.Left) * Vew.XFactor
NewY1# = (NewY1# - Vew.MyWindow.Bottom) * Vew.YFactor
NewX2# = (NewX2# - Vew.MyWindow.Left) * Vew.XFactor
NewY2# = (NewY2# - Vew.MyWindow.Bottom) * Vew.YFactor
GX% = INT(NewX1#) + Vew.MyView.Left
GY% = Vew.MyView.Bottom - INT(NewY1#)
HX% = INT(NewX2#) + Vew.MyView.Left
HY% = Vew.MyView.Bottom - INT(NewY2#)
LINE(GX%, GY%)-(HX%, HY%), Colour%
END IF
END SUB
REM ******************************************************************
REM * Those lines described in Polygon that are within the Box2D *
REM * that is part of Vew will be clipped, mapped and displayed by *
REM * this routine. *
REM ******************************************************************
FUNCTION DisplayPolygon%(Polygon#(), Colour%, Vew AS Vision)
Last% = UBOUND(Polygon#)
IF Last% < 2 THEN
DisplayPolygon% = FALSE%
EXIT FUNCTION
END IF
Count% = 1
X1# = Polygon#(1, QX%)
Y1# = Polygon#(1, QY%)
FOR Index% = 2 TO Last%
X2# = Polygon#(Index%, QX%)
Y2# = Polygon#(Index%, QY%)
ClipLine2D X1#, Y1#, X2#, Y2#, NewX1#, NewY1#, NewX2#, NewY2#, Vew, Visible%
IF Visible% THEN
NewX1# = (NewX1# - Vew.MyWindow.Left) * Vew.XFactor
NewY1# = (NewY1# - Vew.MyWindow.Bottom) * Vew.YFactor
NewX2# = (NewX2# - Vew.MyWindow.Left) * Vew.XFactor
NewY2# = (NewY2# - Vew.MyWindow.Bottom) * Vew.YFactor
GX% = INT(NewX1#) + Vew.MyView.Left
GY% = Vew.MyView.Bottom - INT(NewY1#)
HX% = INT(NewX2#) + Vew.MyView.Left
HY% = Vew.MyView.Bottom - INT(NewY2#)
LINE(GX%, GY%)-(HX%, HY%), Colour%
Count% = Count% + 1
END IF
X1# = X2#
Y1# = Y2#
NEXT Index%
DisplayPolygon% = (Count% > 1)
END FUNCTION
REM ******************************************************************
REM * Those lines described in Shape2D and List that are within the *
REM * Box2D that is part of Vew will be clipped, mapped and *
REM * displayed by this routine. *
REM ******************************************************************
FUNCTION DisplayShape2D%(Shape2D#(), Colour%, ConnectionList%(), Vew AS Vision)
DIM MyPoints%(0 TO 1, QX% TO QY%)
IF NOT Map2D2%(Shape2D#(), Vew, ConnectionList%(), MyPoints%()) THEN
DisplayShape2D% = FALSE%
EXIT FUNCTION
END IF
Last% = UBOUND(MyPoints%)
IF Last% < 2 THEN
DisplayShape2D% = FALSE%
EXIT FUNCTION
END IF
X1% = MyPoints%(1, QX%)
Y1% = MyPoints%(1, QY%)
FOR Index% = 2 TO Last%
X2% = MyPoints%(Index%, QX%)
Y2% = MyPoints%(Index%, QY%)
IF X2% = -1 THEN
Index% = Index% + 1
IF Index% >= Last% THEN
EXIT FOR
END IF
X1% = MyPoints%(Index%, QX%)
Y1% = MyPoints%(Index%, QY%)
ELSE
X2% = MyPoints%(Index%, QX%)
Y2% = MyPoints%(Index%, QY%)
LINE(X1%, Y1%)-(X2%, Y2%), Colour%
X1% = X2%
Y1% = Y2%
END IF
NEXT Index%
DisplayShape2D% = TRUE%
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION Colinear%(X1#, Y1#, X2#, Y2#, X3#, Y3#)
IF X1# = X3# OR Y1# = Y3# THEN
Colinear% = TRUE%
EXIT FUNCTION
END IF
TX# = (X2# - X1#) / (X3# - X1#)
TY# = (Y2# - Y1#) / (Y3# - Y1#)
IF ((TX# <> TY#) OR ((TX# < 0#) OR (TX# > 1#))) THEN
Colinear% = FALSE%
ELSE
Colinear% = TRUE%
END IF
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION SideFactor%(SideSize#, Sides%, Factor#)
IF Sides% < 3 THEN
SideFactor% = FALSE%
EXIT FUNCTION
END IF
Angle# = 180# / CDBL(Sides%)
Factor# = ((SideSize# * 0.5) / SIN(NormaliseDegrees#(Angle#) * (PI# / 180#)))
SideFactor% = TRUE%
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION LoadShape2D%(ShapeName$, ShapeArray#())
OPEN "SHAPES2D.DAT" FOR INPUT AS 1
Last% = UBOUND(ShapeArray#)
DO
LINE INPUT #1, A$
IF A$ = ShapeName$ THEN
EXIT DO
END IF
LOOP UNTIL EOF(1)
IF EOF(1) THEN
CLOSE #1
LoadShape2D% = FALSE%
EXIT FUNCTION
END IF
FOR Index% = 0 TO Last%
INPUT #1, A#
INPUT #1, B#
ShapeArray#(Index%, QX%) = A#
ShapeArray#(Index%, QY%) = B#
NEXT Index%
CLOSE #1
LoadShape2D% = TRUE%
END FUNCTION
REM ******************************************************************
REM * The graphical objects dealt with in this part of the library *
REM * are of 2 kinds, pre-calculated straight line objects (mostly *
REM * polygons) and curved objects that mostly have to be calculated *
REM * "on the fly" (the exception being circles which are *
REM * pre-calculated). In the context of this library, all curved *
REM * objects are simulated by a number of (comparatively) short *
REM * straight lines. This is done to enable the use of the simple *
REM * transformation routines already described. *
REM * *
REM * For those who don't know the names of regular polygons and the *
REM * number of sides each posses, I enclose the following list. *
REM * *
REM * Sides Name *
REM * *
REM * 3 Triangle *
REM * 4 Square *
REM * 5 Pentagon *
REM * 6 Hexagon *
REM * 7 Heptagon *
REM * 8 Octagon *
REM * 9 Nonagon *
REM * 10 Decagon *
REM * 11 Undecagon *
REM * 12 Dodecagon *
REM * *
REM ******************************************************************
SUB UnitTriangle(ATriangle#())
REDIM ATriangle#(0 TO 4, QX% TO QY%)
dummy% = LoadShape2D%("Triangle", ATriangle#())
END SUB
SUB UnitSquare(ASquare#())
REDIM ASquare#(0 TO 5, QX% TO QY%)
dummy% = LoadShape2D%("Square", ASquare#())
END SUB
SUB UnitPentagon(APentagon#())
REDIM APentagon#(0 To 6, QX% TO QY%)
dummy% = LoadShape2D%("Pentagon", APentagon#())
END SUB
SUB UnitHexagon(AHexagon#())
REDIM AHexagon#(0 TO 7, QX% TO QY%)
dummy% = LoadShape2D%("Hexagon", AHexagon#())
END SUB
SUB UnitHeptagon(AHeptagon#())
REDIM AHeptagon#(0 TO 8, QX% TO QY%)
dummy% = LoadShape2D%("Heptagon", AHeptagon#())
END SUB
SUB UnitOctagon(AnOctagon#())
REDIM AnOctagon#(0 TO 9, QX% TO QY%)
dummy% = LoadShape2D%("Octagon", AnOctagon#())
END SUB
SUB UnitNonagon(ANonagon#())
REDIM ANonagon#(0 TO 10, QX% TO QY%)
dummy% = LoadShape2D%("Nonagon", ANonagon#())
END SUB
SUB UnitDecagon(ADecagon#())
REDIM ADecagon#(0 TO 11, QX% TO QY%)
dummy% = LoadShape2D%("Decagon", ADecagon#())
END SUB
SUB UnitUndecagon(AnUndecagon#())
REDIM AnUndecagon#(0 TO 12, QX% TO QY%)
dummy% = LoadShape2D%("Undecagon", AnUndecagon#())
END SUB
SUB UnitDodecagon(ADodecagon#())
REDIM ADodecagon#(0 TO 13, QX% TO QY%)
dummy% = LoadShape2D%("Dodecagon", ADodecagon#())
END SUB
SUB UnitCircle(ThisCircle#())
REDIM ThisCircle#(0 TO 73, QX% TO QY%)
dummy% = LoadShape2D%("Circle", ThisCircle#())
END SUB
SUB UnitArrow(AnArrow#())
REDIM AnArrow#(0 TO 5, QX% TO QY%)
dummy% = LoadShape2D%("Arrow", AnArrow#())
END SUB
SUB UnitParralellogram(AParralellogram#())
REDIM AParralellogram#(0 TO 5, QX% TO QY%)
dummy% = LoadShape2D%("Parralellogram", AParralellogram#())
END SUB
SUB UnitDiamond(ADiamond#())
REDIM ADiamond#(0 TO 5, QX% TO QY%)
dummy% = LoadShape2D%("Diamond", ADiamond#())
END SUB
REM ******************************************************************
REM * The next set of routines also load the output variable with *
REM * the coordinates of the given shape. The way they work is to *
REM * first get a copy of the appropriate Unit shape, expand them in *
REM * such a way as to produce a figure with sides that are SideSize *
REM * long and then to move the whole figure so that it is centred *
REM * at CenterX, CenterY. *
REM ******************************************************************
SUB Triangle(SideSize#, CenterX#, CenterY#, ATriangle#(), MyBounds AS Box2D)
UnitTriangle ATriangle#()
dummy% = SideFactor%(SideSize#, 3, Factor#)
dummy% = Scale2D%(ATriangle#(), MyBounds, Factor#)
dummy% = MoveTo2D%(ATriangle#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ATriangle#(), MyBounds)
END SUB
SUB Square(SideSize#, CenterX#, CenterY#, ASquare#(), MyBounds AS Box2D)
UnitSquare ASquare#()
dummy% = SideFactor%(SideSize#, 4, Factor#)
dummy% = Scale2D%(ASquare#(), MyBounds, Factor#)
dummy% = MoveTo2D%(ASquare#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ASquare#(), MyBounds)
END SUB
SUB Pentagon(SideSize#, CenterX#, CenterY#, APentagon#(), MyBounds AS Box2D)
UnitPentagon APentagon#()
dummy% = SideFactor%(SideSize#, 5, Factor#)
dummy% = Scale2D%(APentagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(APentagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(APentagon#(), MyBounds)
END SUB
SUB Hexagon(SideSize#, CenterX#, CenterY#, AHexagon#(), MyBounds AS Box2D)
UnitHexagon AHexagon#()
dummy% = SideFactor%(SideSize#, 6, Factor#)
dummy% = Scale2D%(AHexagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(AHexagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(AHexagon#(), MyBounds)
END SUB
SUB Heptagon(SideSize#, CenterX#, CenterY#, AHeptagon#(), MyBounds AS Box2D)
UnitHeptagon AHeptagon#()
dummy% = SideFactor%(SideSize#, 7, Factor#)
dummy% = Scale2D%(AHeptagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(AHeptagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(AHeptagon#(), MyBounds)
END SUB
SUB Octagon(SideSize#, CenterX#, CenterY#, AnOctagon#(), MyBounds AS Box2D)
UnitOctagon AnOctagon#()
dummy% = SideFactor%(SideSize#, 8, Factor#)
dummy% = Scale2D%(AnOctagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(AnOctagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(AnOctagon#(), MyBounds)
END SUB
SUB Nonagon(SideSize#, CenterX#, CenterY#, ANonagon#(), MyBounds AS Box2D)
UnitNonagon ANonagon#()
dummy% = SideFactor%(SideSize#, 9, Factor#)
dummy% = Scale2D%(ANonagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(ANonagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ANonagon#(), MyBounds)
END SUB
SUB Decagon(SideSize#, CenterX#, CenterY#, ADecagon#(), MyBounds AS Box2D)
UnitDecagon ADecagon#()
dummy% = SideFactor%(SideSize#, 10, Factor#)
dummy% = Scale2D%(ADecagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(ADecagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ADecagon#(), MyBounds)
END SUB
SUB Undecagon(SideSize#, CenterX#, CenterY#, AnUndecagon#(), MyBounds AS Box2D)
UnitUndecagon AnUndecagon#()
dummy% = SideFactor%(SideSize#, 11, Factor#)
dummy% = Scale2D%(AnUndecagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(AnUndecagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(AnUndecagon#(), MyBounds)
END SUB
SUB Dodecagon(SideSize#, CenterX#, CenterY#, ADodecagon#(), MyBounds AS Box2D)
UnitDodecagon ADodecagon#()
dummy% = SideFactor%(SideSize#, 12, Factor#)
dummy% = Scale2D%(ADodecagon#(), MyBounds, Factor#)
dummy% = MoveTo2D%(ADodecagon#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ADodecagon#(), MyBounds)
END SUB
SUB Arrow(LongSideSize#, CenterX#, CenterY#, AnArrow#(), MyBounds AS Box2D)
UnitArrow AnArrow#()
dummy% = SideFactor%(LongSideSize#, 3, Factor#)
dummy% = Scale2D%(AnArrow#(), MyBounds, Factor#)
dummy% = MoveTo2D%(AnArrow#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(AnArrow#(), MyBounds)
END SUB
SUB Diamond(Height#, CenterX#, CenterY#, ADiamond#(), MyBounds AS Box2D)
UnitDiamond ADiamond#()
dummy% = Scale2D%(ADiamond#(), MyBounds, (Height# / 2#))
dummy% = MoveTo2D%(ADiamond#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ADiamond#(), MyBounds)
END SUB
REM ******************************************************************
REM * The next 2 shapes are slightly more complicated than those *
REM * that have preceded them. They are based around points that *
REM * have already been calculated, but these points are connected *
REM * in a different order to the simple polygons that proceeded *
REM * them and therefore use an INTEGER array to hold a list of *
REM * points to be connected in the order in which they are to be *
REM * connected. In other words these are shapes as described *
REM * earlier. *
REM ******************************************************************
SUB Pentagram(Span#, CenterX#, CenterY#, ThisPentagram#(), MyBounds AS Box2D, Connections%())
REDIM Connections%(0 To 5)
UnitPentagon ThisPentagram#()
dummy% = SideFactor%(Span#, 5, Factor#)
dummy% = Scale2D%(ThisPentagram#(), MyBounds, Factor#)
dummy% = MoveTo2D%(ThisPentagram#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ThisPentagram#(), MyBounds)
Connections%(0) = 1
Connections%(1) = 3
Connections%(2) = 5
Connections%(3) = 2
Connections%(4) = 4
Connections%(5) = 6
END SUB
SUB StarOfDavid(Span#, CenterX#, CenterY#, ThisStar#(), MyBounds AS Box2D, Connections%())
REDIM Connections%(0 To 8)
UnitHexagon ThisStar#()
dummy% = Rotation2D%(ThisStar#(), MyBounds, 90#)
dummy% = SideFactor%(Span#, 6, Factor#)
dummy% = Scale2D%(ThisStar#(), MyBounds, Factor#)
dummy% = MoveTo2D%(ThisStar#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ThisStar#(), MyBounds)
Connections%(0) = 1
Connections%(1) = 3
Connections%(2) = 5
Connections%(3) = 7
Connections%(4) = -1
Connections%(5) = 2
Connections%(6) = 4
Connections%(7) = 6
Connections%(8) = 2
END SUB
REM ******************************************************************
REM * This final set of routines is concerned with the generation of *
REM * curved shapes. Most of the routines in this section actually *
REM * involve calculation as distinct from the preceding routines *
REM * which did not. NOTE - all angles used in this section are *
REM * in degrees. *
REM ******************************************************************
REM ******************************************************************
REM * Given the three points described by the coordinate pairs *
REM * (X1,Y1), (X2,Y2) and (X3,Y3) this routine calculates the *
REM * centre (CenterX,CenterY) and Radius of a circle. The rules *
REM * for the usage of this routine are that the three points lie on *
REM * the circumference of the circle and are encountered, in order, *
REM * by travelling along the upper hemisphere of the circle in a *
REM * clockwise direction. Further it is an error if all three *
REM * points lie upon a straight line (known as collinearity) and *
REM * FALSE will be returned if this occurs. *
REM ******************************************************************
FUNCTION CircleInformation%(X1#, Y1#, X2#, Y2#, X3#, Y3#, CenterX#, CenterY#, Radius#)
IF Colinear%(X1#, Y1#, X2#, Y2#, X3#, Y3#) THEN
CircleInformation% = FALSE%
EXIT FUNCTION
END IF
D1# = X2# - X1#
D2# = Y2# - Y1#
D3# = X3# - X1#
D4# = Y3# - Y1#
XSquared# = X1# * X1#
YSquared# = Y1# * Y1#
F1# = (XSquared# - X2# * X2# + YSquared# - Y2# * Y2#) * 0.5#
F2# = (XSquared# - X3# * X3# + YSquared# - Y3# * Y3#) * 0.5#
CenterY# = (D1# * F2# - D3# * F1#) / (D3# * D2# - D1# * D4#)
CenterX# = (F1# + D2# * CenterY#) / D1#
XSquared# = (X1# - CenterX#) * (X1# - CenterX#)
YSquared# = (Y1# - CenterY#) * (Y1# - CenterY#)
Radius# = SQR(XSquared# + YSquared#)
CircleInformation% = TRUE%
END FUNCTION
REM ******************************************************************
REM * This routine follows a specialised need namely to connect 2 *
REM * arcs with a straight line that flows smoothly into the arcs. *
REM * The way this is done is to take the centres and radii of two *
REM * circles and to calculate the points where an appropriate line *
REM * would be tangential to both. The coordinates of Point1 *
REM * correspond with the details of circle 1 and Point2 with circle *
REM * 2. As for any given pair of circles there are 4 possible *
REM * tangential lines that could connect them a mechanism is needed *
REM * to enable distinction of which line should be calculated. The *
REM * mechanism used is directionality of rotation of the circles *
REM * expressed as the sign of the individual radius's. By this I *
REM * mean that if a radius is negative the corresponding circle is *
REM * assumed to be drawn in a clockwise direction and a positive *
REM * radius, anti-clockwise. Now if you consider the line to be *
REM * drawn as a continuation of the 2 circles it becomes a simple *
REM * matter to determine the signs of the radii to be passed to *
REM * this routine. *
REM ******************************************************************
SUB TwinCircleTangent(CenterX1#, CenterY1#, Radius1#, CenterX2#, CenterY2#, Radius2#, Point1X#, Point1Y#, Point2X#, Point2Y#)
XD# = CenterX2# - CenterX1#
YD# = CenterY2# - CenterY1#
JX# = -YD#
JY# = XD#
DLength# = SQR(XD# * XD# + YD# * YD#)
F# = (Radius1# - Radius2#) / DLength#
FSquared# = F# * F#
F0# = SQR(1# - FSquared#)
F1# = Radius1# / DLength#
F2# = Radius2# / DLength#
D1# = F# * XD# - F0# * JX#
D2# = F# * YD# - F0# * JY#
Point1X# = CenterX1# + F1# * D1#
Point1Y# = CenterY1# + F1# * D2#
Point2X# = CenterX2# + F2# * D1#
Point2Y# = CenterY2# + F2# * D2#
END SUB
REM ******************************************************************
REM * Loads ThisCircle#() with the coordinates of a 72 sided figure *
REM * which simulates a circle of Radius at CenterX, CenterY. *
REM ******************************************************************
SUB ACircle(Radius#, CenterX#, CenterY#, ThisCircle#(), MyBounds AS Box2D)
UnitCircle ThisCircle#()
dummy% = Scale2D%(ThisCircle#(), MyBounds, Radius#)
dummy% = MoveTo2D%(ThisCircle#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(ThisCircle#(), MyBounds)
END SUB
REM ******************************************************************
REM * Loads Ellipse#() with the coordinates of a 72 sided figure *
REM * which simulates an ellipse of XRadius, YRadius at CenterX, *
REM * CenterY. The way this works is that a UnitCircle is expanded *
REM * by differing X and Y amounts. *
REM ******************************************************************
SUB Ellipse(XRadius#, YRadius#, CenterX#, CenterY#, AnEllipse#(), MyBounds AS Box2D)
UnitCircle AnEllipse#()
dummy% = ScaleXY2D%(AnEllipse#(), MyBounds, XRadius#, YRadius#)
dummy% = Translate2D%(AnEllipse#(), MyBounds, CenterX#, CenterY#)
dummy% = OuterLimits2D%(AnEllipse#(), MyBounds)
END SUB
REM ******************************************************************
REM * Calculates the angle that a line (running from CenterX, *
REM * CenterY to PointX,PointY) makes in relation to the horizontal *
REM * axis. Positive angles indicate that the line is above the *
REM * horizontal axis and negative below. *
REM ******************************************************************
SUB CalculateAngle(CenterX#, CenterY#, PointX#, PointY#, Angle#)
IF CenterX# = PointX# THEN
IF CenterY# < PointY# THEN
Angle# = PIDividedBy2#
ELSE
Angle# = PITimes3# / 2#
END IF
ELSE
XD# = CenterX# - PointX#
YD# = CenterY# - PointY#
Angle# = ATN(YD# / XD#)
END IF
IF ((CenterX# < PointX#) AND (CenterY# > PointY#)) THEN
Angle# = Angle# + PITimes2#
ELSE
IF CenterX# > PointX# THEN
Angle# = Angle# + PI#
END IF
END IF
Angle# = Angle# * 180# / PI#
END SUB
REM ******************************************************************
REM * Calculates the length of an arc, in degrees, of an arc running *
REM * in an anti-clockwise direction from StartAngle to EndAngle. *
REM ******************************************************************
FUNCTION GetAngle#(StartAngle#, EndAngle#)
IF StartAngle# = EndAngle# THEN
GetAngle# = 360#
ELSEIF StartAngle# > EndAngle# THEN
GetAngle# = ((360# - StartAngle#) + EndAngle#)
ELSE
GetAngle# = (EndAngle# - StartAngle#)
END IF
END FUNCTION
REM ******************************************************************
REM * Given 3 points on the circumference of an arc, this routine *
REM * calculates all the information needed to create an arc. Point *
REM * (X1,Y1) is the starting point for the arc, point (X2,Y2) the *
REM * mid-point and point (X3,Y3) the end point of the arc. The *
REM * rules for the usage of this routine are the same as for *
REM * CircleInformation. *
REM ******************************************************************
FUNCTION ArcInformation%(X1#, Y1#, X2#, Y2#, X3#, Y3#, CenterX#, CenterY#, Radius#, StartAngle#, Degrees#)
IF NOT CircleInformation%(X1#, Y1#, X2#, Y2#, X3#, Y3#, CenterX#, CenterY#, Radius#) THEN
ArcInformation% = FALSE%
EXIT FUNCTION
END IF
D1# = X2# - X1#
D2# = Y2# - Y1#
D3# = X3# - X1#
D4# = Y3# - Y1#
D5# = X2# - X3#
D6# = Y2# - Y3#
J# = 10000#
A# = SQR(D5# * D5# + D6# * D6#)
B# = SQR(D1# * D1# + D2# * D2#)
C# = SQR(D3# * D3# + D4# * D4#)
US# = X1# - CenterX#
VS# = Y1# - CenterY#
UE# = X3# - CenterX#
VE# = Y3# - CenterY#
UM# = X2# - CenterX#
VM# = Y2# - CenterY#
T# = 2# * Radius# * Radius#
IF ((B# >= C#) OR (A# >= C#)) THEN
F3# = (T# - C# * C#) / T#
IF ABS(F3#) = 1# THEN
C0# = 0#
ELSE
C0# = (HalfPI# + (-ATN(F3# / SQR(-F3# * F3# + 1#))))
END IF
Q# = C0# - PITimes2#
CS# = COS(C0#)
SI# = SIN(C0#)
XD& = INT((US# * CS# - VS# * SI#) * J#)
YD& = INT((US# * SI# + VS# * CS#) * J#)
IF XD& = INT(UE# * J#) AND YD& = INT(VE# * J#) THEN
Degrees# = Q#
ELSE
Degrees# = -Q#
END IF
ELSE
F1# = (T# - B# * B#) / T#
IF ABS(F1#) = 1# THEN
B0# = 0#
ELSE
B0# = (HalfPI# + (-ATN(F1# / SQR(-F1# * F1# + 1#))))
END IF
F2# = (T# - A# * A#) / T#
IF ABS(F2#) = 1# THEN
A0# = 0#
ELSE
A0# = (HalfPI# + (-ATN(F2# / SQR(-F2# * F2# + 1#))))
END IF
Q# = A0# + B0#
CS# = COS(Q#)
SI# = SIN(Q#)
XD& = INT((US# * CS# - VS# * SI#) * J#)
YD& = INT((US# * SI# + VS# * CS#) * J#)
IF XD& = INT(UE# * J#) AND YD& = INT(VE# * J#) THEN
Degrees# = Q#
ELSE
Degrees# = -Q#
END IF
END IF
CalculateAngle CenterX#, CenterY#, X1#, X2#, StartAngle#
Degrees# = Degrees# * 180# / PI#
ArcInformation% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Loads Arc#() with the coordinates of an arc described by the *
REM * arguments CenterX#, CenterY#, Radius#, StartAngle# and *
REM * Degrees#. The argument Degrees holds the length of the arc in *
REM * degrees. *
REM ******************************************************************
SUB CreateArc(CenterX#, CenterY#, Radius#, StartAngle#, Degrees#, Arc#(), MyBounds AS Box2D)
IF Degrees# > 5# THEN
Points# = INT((Degrees# / 5#) + .5#)
ELSE
Points# = 1#
END IF
REDIM Arc#(0 TO CINT(Points#), QX% TO QY%)
DA# = Degrees# / Points#
EndAngle# = StartAngle# + Degrees#
N% = INT(ABS(Degrees# * 1.01#) / DA#)
C# = COS(NormaliseDegrees#(DA#) * (PI# / 180#))
S# = SIN(NormaliseDegrees#(DA#) * (PI# / 180#))
XDiff# = CenterX# + Radius# * COS(NormaliseDegrees#(StartAngle#) * (PI# / 180#))
YDiff# = CenterY# + Radius# * SIN(NormaliseDegrees#(StartAngle#) * (PI# / 180#))
Arc#(1, QX%) = XDiff#
Arc#(1, QY%) = YDiff#
XDiff# = XDiff# - CenterX#
YDiff# = YDiff# - CenterY#
FOR Index% = 2 TO (N% - 1)
NewX# = CenterX# + XDiff# * C# - YDiff# * S#
NewY# = CenterY# + XDiff# * S# + YDiff# * C#
Arc#(Index%, QX%) = NewX#
Arc#(Index%, QY%) = NewY#
XDiff# = NewX# - CenterX#
YDiff# = NewY# - CenterY#
NEXT Index%
NewX# = CenterX# + Radius# * COS(NormaliseDegrees#(EndAngle#) * (PI# / 180#))
NewY# = CenterY# + Radius# * SIN(NormaliseDegrees#(EndAngle#) * (PI# / 180#))
Arc#(N%, QX%) = NewX#
Arc#(N%, QY%) = NewY#
dummy% = OuterLimits2D%(Arc#(), MyBounds)
END SUB
REM ******************************************************************
REM * As not all curved shapes are based on conic sections this *
REM * routine and the next offer 2 ways of describing those other *
REM * shapes, based on control points which are external to the *
REM * desired curved shape. In this routine point (X1,Y1) is the *
REM * start point, point (X4,Y4) is the end point. Points (X2,Y2) *
REM * and (X3,Y3) in conjunction with the points already mentioned *
REM * are used to determine the final shape of the curve. This *
REM * routine is based on the algorithm devised by Harry Timmer of *
REM * the Douglas Aircraft Company. This routine (in common with *
REM * many others) uses four blending functions to describe the *
REM * curve parametrically. The characteristic that sets this *
REM * algorithm apart from the others is that if an imaginary line *
REM * is drawn from X2#,Y2# to X3#,Y3# and the curve is then *
REM * calculated and drawn it will be noted that the apex of the *
REM * curve either touches or crosses this line at its centre. *
REM ******************************************************************
SUB CreateParametricCubicCurve(X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, CubicCurve#(), MyBounds AS Box2D)
DIM F#(1 To 4), PA#(1 To 4, QX% TO QY%)
IF UBOUND(CubicCurve#) <> 18 THEN
REDIM CubicCurve#(0 TO 18, QX% TO QY%)
END IF
PA#(1, QX%) = X1#
PA#(1, QY%) = Y1#
PA#(2, QX%) = X2#
PA#(2, QY%) = Y2#
PA#(3, QX%) = X3#
PA#(3, QY%) = Y3#
PA#(4, QX%) = X4#
PA#(4, QY%) = Y4#
FOR Count% = 1 TO 18
T# = OneSeventeenth# * (CDBL(Count%) - 1#)
TSquared# = T# * T#
T1# = 1# - T#
T2# = T1# * T1#
F#(1) = (1# - 2# * T#) * T2#
F#(2) = 4# * T# * T2#
F#(3) = 4# * TSquared# * T1#
F#(4) = (2# * T# - 1#) * TSquared#
A1# = 0#
A2# = A1#
FOR K% = 1 TO 4
A1# = A1# + F#(K%) * PA#(K%, QX%)
A2# = A2# + F#(K%) * PA#(K%, QY%)
NEXT K%
CubicCurve#(Count%, QX%) = A1#
CubicCurve#(Count%, QY%) = A2#
NEXT Count%
dummy% = OuterLimits2D%(CubicCurve#(), MyBounds)
END SUB
REM ******************************************************************
REM * This is an extension to the preceding routine. The array *
REM * ControlPoints#() contains a series of control points, the *
REM * number of which must be divisible by 2 and greater than or *
REM * equal to 4 (ideally greater than 4 e.g. at least 6). *
REM ******************************************************************
FUNCTION CreateComplexCurve%(ControlPoints#(), Curve#(), MyBounds AS Box2D)
Points% = UBOUND(ControlPoints#)
IF ((Points% < 4) OR ((Points% AND 1) <> 0)) THEN
CreateComplexCurve% = FALSE%
EXIT FUNCTION
END IF
REDIM Curve#(0 TO 1, QX% TO QY%)
X1# = ControlPoints#(1, QX%)
Y1# = ControlPoints#(1, QY%)
X2# = ControlPoints#(2, QX%)
Y2# = ControlPoints#(2, QY%)
X3# = ControlPoints#(3, QX%)
Y3# = ControlPoints#(3, QY%)
X4# = ControlPoints#(4, QX%)
Y4# = ControlPoints#(4, QY%)
IF Points% = 4 THEN
CreateParametricCubicCurve X1#, Y1#, X2#, Y2#, X3#, Y3#, X4#, Y4#, Curve#(), MyBounds
CreateComplexCurve% = TRUE%
EXIT FUNCTION
END IF
REDIM TempShape#(0 To 1, QX% TO QY%)
X34# = X3# + ((X4# - X3#) / 2#)
Y34# = Y3# + ((Y4# - Y3#) / 2#)
CreateParametricCubicCurve X1#, Y1#, X2#, Y2#, X3#, Y3#, X34#, Y34#, Curve#(), MyBounds
FOR Index% = 5 TO Points% STEP 2
X1# = X34#
Y1# = Y34#
X2# = X4#
Y2# = Y4#
X3# = ControlPoints#(Index%, QX%)
Y3# = ControlPoints#(Index%, Qy%)
X4# = ControlPoints#(Index% + 1, QX%)
Y4# = ControlPoints#(Index% + 1, Qy%)
X34# = X3# + ((X4# - X3#) / 2#)
Y34# = Y3# + ((Y4# - Y3#) / 2#)
CreateParametricCubicCurve X1#, Y1#, X2#, Y2#, X3#, Y3#, X34#, Y34#, TempShape#(), MyBounds
dummy% = AppendShape2D%(TempShape#(), Curve#())
NEXT Index%
dummy% = OuterLimits2D%(Curve#(), MyBounds)
CreateComplexCurve% = TRUE%
END FUNCTION
REM ******************************************************
REM * Private FUNCTION - Do not call directly *
REM ******************************************************
FUNCTION NotInViewPort%(ScreenX%, ScreenY%, Vew AS Vision)
IF ScreenX% < 0 OR ScreenY% < 0 THEN
NotInViewPort% = TRUE%
EXIT FUNCTION
END IF
IF ScreenX% < Vew.MyView.Left OR ScreenX% > Vew.MyView.Right THEN
NotInViewPort% = TRUE%
EXIT FUNCTION
END IF
IF ScreenY% < Vew.MyView.Top OR ScreenY% > Vew.MyView.Bottom THEN
NotInViewPort% = TRUE%
EXIT FUNCTION
END IF
NotInViewPort% = FALSE%
END FUNCTION
REM ******************************************************************
REM * The final three routines are here to enable programs to *
REM * interact with the routines presented here. *
REM ******************************************************************
REM ******************************************************************
REM * If a point on the screen (InX%,InY%) is within the viewport in *
REM * Vew the coordinates will be converted to the corresponding *
REM * point in world coordinates and TRUE% returned. Otherwise *
REM * FALSE% is returned. *
REM ******************************************************************
FUNCTION DeviceToWorldCoordinates%(InX%, InY%, Vew AS Vision, OutX#, OutY#)
IF NotInViewPort%(InX%, InY%, Vew) THEN
DeviceToWorldCoordinates% = FALSE%
EXIT FUNCTION
END IF
ReverseX# = 1# / Vew.XFactor
ReverseY# = 1# / Vew.YFactor
OutX# = CDBL(InX% - Vew.MyView.Left) * ReverseX# + Vew.MyWindow.Left
OutY# = CDBL(Vew.MyView.Bottom - InY%) * ReverseY# + Vew.MyWindow.Bottom
DeviceToWorldCoordinates% = TRUE%
END FUNCTION
REM ******************************************************************
REM * If the point TX#,TY# is within Bounds TRUE% is returned, *
REM * otherwise FALSE%. *
REM ******************************************************************
FUNCTION InBox%(TX#, TY#, Bounds AS Box2D)
IF TX# < Bounds.Left OR TX# > Bounds.Right THEN
InBox% = FALSE%
EXIT FUNCTION
END IF
IF TY# < Bounds.Bottom OR TY# > Bounds.Top THEN
InBox% = FALSE%
EXIT FUNCTION
END IF
InBox% = TRUE%
END FUNCTION
REM ******************************************************************
REM * Returns the number of the coordinate pair in shape#() which is *
REM * closest to TX#, TY#. *
REM ******************************************************************
FUNCTION ClosestPoint%(TX#, TY#, Shape#())
Last% = UBOUND(Shape#)
Shortest# = 1.797693134862315D308
FOR Index% = 0 TO Last%
TestX# = TX# - Shape#(Index%, QX%)
TestY# = TY# - Shape#(Index%, QY%)
Length# = SQR(TestX# * TestX# + TestY# * TestY#)
IF Length# < Shortest# THEN
Shortest# = Length#
ThePoint% = Index%
END IF
NEXT Index%
ClosestPoint% = ThePoint%
END FUNCTION
SHAPES2D.DAT (Pre-calculated coordinates for unit polygons)
Code: (Select All) Triangle
0 0
0 1
.86602540378444 -.5
-.866025403784438 -.5
0 1
Square
0 0
.707106781186548 .707106781186548
-.707106781186548 .707106781186548
-.707106781186548 -.707106781186548
.707106781186548 -.707106781186548
.707106781186548 .707106781186548
Pentagon
0 0
0 1
.951056516295154 .309016994374947
.587785252292474 -.809016994374948
-.587785252292472 -.809016994374948
-.951056516295153 .309016994374947
0 1
Hexagon
0 0
1 0
.5 .866025403784439
-.5 .866025403784439
-1 0
-.5 -.866025403784437
.5 -.866025403784438
1 0
Heptagon
0 0
0 1
.78183148246803 .623489801858733
.974927912181824 -.222520933956315
.433883739117559 -.90096886790242
-.433883739117558 -.90096886790242
-.974927912181823 -.222520933956315
-.78183148246803 .623489801858733
0 1
Octagon
0 0
.923879532511287 .38268343236509
.38268343236509 .923879532511287
-.382683432365089 .923879532511287
-.923879532511286 .38268343236509
-.923879532511286 -.382683432365089
-.382683432365089 -.923879532511286
.38268343236509 -.923879532511286
.923879532511286 -.382683432365089
.923879532511287 .38268343236509
Nonagon
0 0
0 1
.64278760968654 .766044443118978
.984807753012208 .17364817766693
.866025403784439 -.5
.342020143325669 -.939692620785909
-.342020143325668 -.939692620785909
-.866025403784438 -.5
-.984807753012207 .17364817766693
-.642787609686539 .766044443118977
0 1
Decagon
0 0
1 0
.809016994374948 .587785252292474
.309016994374948 .951056516295154
-.309016994374948 .951056516295154
-.809016994374948 .587785252292474
-1 0
-.809016994374948 -.587785252292474
-.309016994374948 -.951056516295154
.309016994374948 -.951056516295154
.809016994374948 -.587785252292474
1 0
Undecagon
0 0
0 1
.540640817455598 .841253532831181
.909631995354519 .415415013001886
.989821441880933 -.142314838273286
.755749574354259 -.654860733945286
.28173255684143 -.959492973614498
-.281732556841429 -.959492973614498
-.755749574354258 -.654860733945286
-.989821441880932 -.142314838273286
-.909631995354518 .415415013001886
-.540640817455597 .84125353283118
0 1
Dodecagon
0 0
.965925826289069 .258819045102521
.707106781186548 .707106781186548
.258819045102521 .965925826289069
-.25881904510251 .965925826289069
-.707106781186548 .707106781186548
-.965925826289069 .258819045102521
-.965925826289069 -.25881904510251
-.707106781186548 -.707106781186548
-.258819045102521 -.965925826289069
.258819045102521 -.965925826289069
.707106781186548 -.707106781186548
.965925826289069 -.258819045102521
.965925826289069 .258819045102521
Circle
0 0
0 -1
.087155742747658 -.996194698091745
.173648177666931 -.984807753012207
.258819045102521 -.965925826289068
.342020143325669 -.939692620785908
.4226182617407 -.906307787036649
.5 -.866025403784438
.573576436351046 -.819152044288991
.64278760968654 -.766044443118977
.707106781186548 -.707106781186546
.766044443118978 -.642787609686538
.819152044288992 -.573576436351045
.866025403784438 -.5
.90630778703665 -.422618261740698
.939692620785908 -.342020143325668
.965925826289068 -.25881904510252
.984807753012207 -.173648177666929
.996194698091744 -.087155742747657
1 0
.996194698091744 .087155742747658
.984807753012207 .173648177666931
.965925826289067 .258819045102521
.939692620785907 .342020143325669
.906307787036648 .422618261740699
.866025403784437 .5
.81915204428899 .573576436351045
.766044443118976 .642787609686538
.707106781186546 .707106781186546
.642787609686538 .766044443118976
.573576436351045 .81915204428899
.5 .866025403784437
.422618261740698 .906307787036648
.342020143325668 .939692620785906
.25881904510252 .965925826289066
.17364817766693 .984807753012205
.087155742747658 .996194698091743
0 1
-.087155742747657 .996194698091742
-.173648177666929 .984807753012205
-.258819045102519 .965925826289065
-.342020143325667 .939692620785905
-.422618261740697 .9063077870366471
-.5 .866025403784436
-.5735764363510431 .819152044288989
-.642787609686536 .766044443118975
-.707106781186544 .707106781186545
-.766044443118974 .642787609686537
-.819152044288988 .573576436351044
-.866025403784434 .5
-.9063077870366451 .422618261740698
-.939692620785903 .342020143325667
-.965925826289063 .25881904510252
-.984807753012202 .17364817766693
-.99619469809174 .087155742747658
-1 0
-.996194698091739 -.087155742747657
-.984807753012202 -.173648177666929
-.965925826289062 -.258819045102519
-.939692620785902 -.342020143325666
-.9063077870366441 -.422618261740697
-.866025403784433 -.5
-.819152044288986 -.5735764363510421
-.766044443118972 -.642787609686535
-.707106781186542 -.707106781186542
-.642787609686534 -.766044443118973
-.5735764363510421 -.819152044288986
-.5 -.866025403784432
-.422618261740696 -.9063077870366431
-.342020143325666 -.939692620785901
-.258819045102518 -.965925826289061
-.173648177666928 -.9848077530122
-.087155742747656 -.996194698091738
0 -1
Arrow
0 0
0 1
.86602540378444 -.5
0 0
-.866025403784438 -.5
0 1
Parralellogram
0 0
1 .707106781186548
-.414213562373096 .707106781186548
-1 -.707106781186548
.414213562373096 -.707106781186548
1 .707106781186548
Diamond
0 0
0 -1
-.5 0
0 1
.5 0
0 -1
Note the DAT file must be in the same folder as the compiled program.
TR
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
Finally the demo.
G2DEMO.BAS
Code: (Select All) '$INCLUDE: 'G2.BI'
Const StartPosX = 0
Const StartPosY = 0
Const XMax = 639
Const YMax = 479
Dim A#(0 To 5, QX% To QY%), B#(0 To 1, QX% To QY%), C#(0 To 1, QX% To QY%)
Dim D#(0 To 1, QX% To QY%), E#(0 To 1, QX% To QY%), F#(0 To 1, QX% To QY%)
Dim G#(0 To 1, QX% To QY%), H#(0 To 1, QX% To QY%), I#(0 To 1, QX% To QY%)
Dim J#(0 To 1, QX% To QY%), K#(0 To 1, QX% To QY%), L#(0 To 1, QX% To QY%)
Dim M#(0 To 1, QX% To QY%), N#(0 To 1, QX% To QY%), O#(0 To 1, QX% To QY%)
Dim P#(0 To 1, QX% To QY%), Q#(0 To 1, QX% To QY%), R#(0 To 1, QX% To QY%)
Dim S#(0 To 1, QX% To QY%), T#(0 To 1, QX% To QY%), U#(0 To 1, QX% To QY%)
Dim V#(0 To 1, QX% To QY%), W#(0 To 1, QX% To QY%), X#(0 To 1, QX% To QY%)
Dim Y#(0 To 1, QX% To QY%), Z#(0 To 1, QX% To QY%)
Dim SList1%(0 To 1), SList2%(0 To 1)
Dim Win1 As Box2D, Win2 As Box2D, Win3 As Box2D, Win4 As Box2D
Dim BoundsA As Box2D, BoundsB As Box2D, BoundsC As Box2D
Dim BoundsD As Box2D, BoundsE As Box2D, BoundsF As Box2D
Dim BoundsG As Box2D, BoundsH As Box2D, BoundsI As Box2D
Dim BoundsJ As Box2D, BoundsK As Box2D, BoundsL As Box2D
Dim BoundsM As Box2D, BoundsN As Box2D, BoundsO As Box2D
Dim BoundsP As Box2D, BoundsQ As Box2D, BoundsR As Box2D
Dim BoundsS As Box2D, BoundsT As Box2D, BoundsU As Box2D
Dim BoundsV As Box2D, BoundsW As Box2D, BoundsX As Box2D
Dim BoundsY As Box2D, BoundsZ As Box2D
Dim V1 As AView2D, V2 As AView2D, V3 As AView2D, V4 As AView2D
Dim See1 As Vision, See2 As Vision, See3 As Vision, See4 As Vision
Color 9, 7, 12
Cls
Locate 13, 16
Print "Please wait - preparing 16 pre-defined shapes."
_Delay 2.0
Triangle 90, 50, 420, A#(), BoundsA
Square 80, 150, 420, B#(), BoundsB
Pentagon 55, 250, 420, C#(), BoundsC
Hexagon 45, 350, 420, D#(), BoundsD
Heptagon 40, 450, 420, E#(), BoundsE
Octagon 35, 550, 420, F#(), BoundsF
Nonagon 30, 50, 240, G#(), BoundsG
Decagon 30, 150, 240, H#(), BoundsH
Undecagon 25, 250, 240, I#(), BoundsI
Dodecagon 25, 350, 240, J#(), BoundsJ
Arrow 90, 450, 240, K#(), BoundsK
Diamond 90, 550, 240, L#(), BoundsL
Pentagram 55, 50, 80, M#(), BoundsM, SList1%()
StarOfDavid 45, 215, 80, N#(), BoundsN, SList2%()
ACircle 47, 385, 80, O#(), BoundsO
Ellipse 47, 25, 550, 80, P#(), BoundsP
Arrow 100, 320, 240, W#(), BoundsW
dummy% = CopyShape2D%(W#(), X#())
dummy% = OuterLimits2D%(X#(), BoundsX)
dummy% = SetNewWindow2D%(Win1, StartPosX, XMax, StartPosY, YMax)
dummy% = SetNewViewPort%(V1, StartPosX, XMax, StartPosY, YMax)
SetNewVision See1, Win1, V1
dummy% = SetNewWindow2D%(Win2, StartPosX, 132, 30, 129)
dummy% = SetNewViewPort%(V2, StartPosX, 320, StartPosY, 240)
SetNewVision See2, Win2, V2
dummy% = SetNewWindow2D%(Win3, 20, 80, 50, 110)
dummy% = SetNewViewPort%(V3, 320, XMax, 240, YMax)
SetNewVision See3, Win3, V3
dummy% = SetNewWindow2D%(Win4, 0, 263, 0, 188)
dummy% = SetNewViewPort%(V4, 160, 479, 120, 359)
SetNewVision See4, Win4, V4
Screen 12
BoundingBox
dummy% = DisplayPolygon%(A#(), 11, See1)
dummy% = DisplayPolygon%(B#(), 11, See1)
dummy% = DisplayPolygon%(C#(), 11, See1)
dummy% = DisplayPolygon%(D#(), 11, See1)
dummy% = DisplayPolygon%(E#(), 11, See1)
dummy% = DisplayPolygon%(F#(), 11, See1)
dummy% = DisplayPolygon%(G#(), 11, See1)
dummy% = DisplayPolygon%(H#(), 11, See1)
dummy% = DisplayPolygon%(I#(), 11, See1)
dummy% = DisplayPolygon%(J#(), 11, See1)
dummy% = DisplayPolygon%(K#(), 11, See1)
dummy% = DisplayPolygon%(L#(), 11, See1)
dummy% = DisplayShape2D%(M#(), 11, SList1%(), See1)
dummy% = DisplayShape2D%(N#(), 11, SList2%(), See1)
dummy% = DisplayPolygon%(O#(), 11, See1)
dummy% = DisplayPolygon%(P#(), 11, See1)
Beep
Z$ = Input$(1)
CreateArc 320, 240, 220, 15, 210, Q#(), BoundsQ
BoundingBox
dummy% = DisplayPolygon%(Q#(), 11, See1)
BEEP
Z$ = Input$(1)
BoundingBox
TwinCircleTangent 160, 250, 150, 470, 250, 100, PX1#, PY1#, PX2#, PY2#
TwinCircleTangent 160, 250, -150, 470, 250, -100, PX3#, PY3#, PX4#, PY4#
CalculateAngle 160, 250, PX3#, PY3#, SA1#
CalculateAngle 160, 250, PX1#, PY1#, EA1#
CalculateAngle 470, 250, PX2#, PY2#, SA2#
CalculateAngle 470, 250, PX4#, PY4#, EA2#
Angle1# = GetAngle#(SA1#, EA1#)
Angle2# = GetAngle#(SA2#, EA2#)
CreateArc 160, 250, 150, SA1#, Angle1#, R#(), BoundsR
CreateArc 470, 250, 100, SA2#, Angle2#, S#(), BoundsS
dummy% = MakePolygon%(S#(), R#())
dummy% = OuterLimits2D%(R#(), BoundsR)
dummy% = MoveTo2D%(R#(), BoundsR, 320, 240)
dummy% = DisplayPolygon%(R#(), 10, See1)
Beep
Z$ = Input$(1)
BoundingBox
CreateParametricCubicCurve 10, 10, 100, 200, 400, 400, 600, 50, T#(), BoundsT
DisplayLine 10, 10, 100, 200, 12, See1
DisplayLine 100, 200, 400, 400, 12, See1
DisplayLine 400, 400, 600, 50, 12, See1
Beep
Z$ = Input$(1)
dummy% = DisplayPolygon%(T#(), 14, See1)
Beep
Z$ = Input$(1)
Screen 0
Color 9, 7, 12
Cls
Locate 13, 19
Print "Please wait - Calculating a complex curve."
ReDim U#(0 To 44, QX% To QY%)
Open "G2DEMO.DAT" For Input As 1
For Index% = 1 To 44
Input #1, U#(Index%, QX%)
Input #1, U#(Index%, QY%)
Next Index%
Close (1)
dummy% = OuterLimits2D%(U#(), BoundsU)
dummy% = CreateComplexCurve%(U#(), V#(), BoundsV)
Screen 12
BoundingBox
dummy% = DisplayPolygon%(U#(), 11, See1)
Beep
Z$ = Input$(1)
dummy% = DisplayPolygon%(V#(), 14, See1)
Last% = UBound(V#)
DisplayLine V#(1, QX%), V#(1, QY%), V#(Last%, QX%), V#(Last%, QY%), 14, See1
Beep
Z$ = Input$(1)
BoundingBox
dummy% = DisplayPolygon%(V#(), 14, See1)
DisplayLine V#(1, QX%), V#(1, QY%), V#(Last%, QX%), V#(Last%, QY%), 14, See1
Beep
Z$ = Input$(1)
BoundingBox
dummy% = DisplayPolygon%(W#(), 14, See1)
Beep
Z$ = Input$(1)
For Index% = 1 To 14
dummy% = Translate2D%(W#(), BoundsW, 20, 20)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
Next Index%
Beep
Z$ = Input$(1)
BoundingBox
dummy% = MoveTo2D%(W#(), BoundsW, 320, 240)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
dummy% = MoveTo2D%(W#(), BoundsW, 60, 400)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
dummy% = MoveTo2D%(W#(), BoundsW, 60, 60)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
dummy% = MoveTo2D%(W#(), BoundsW, 580, 60)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
dummy% = MoveTo2D%(W#(), BoundsW, 580, 400)
dummy% = DisplayPolygon%(W#(), 14, See1)
Beep
Z$ = Input$(1)
dummy% = MoveTo2D%(W#(), BoundsW, 320, 240)
dummy% = DisplayPolygon%(W#(), 10, See1)
_Delay 0.5
dummy% = InflateX2D%(W#(), BoundsW, 2)
dummy% = DisplayPolygon%(W#(), 11, See1)
_Delay 0.5
dummy% = InflateY2D%(W#(), BoundsW, 2)
dummy% = DisplayPolygon%(W#(), 12, See1)
_Delay 0.5
dummy% = InflateY2D%(W#(), BoundsW, 2)
dummy% = DisplayPolygon%(W#(), 11, See1)
_Delay 0.5
dummy% = InflateX2D%(W#(), BoundsW, 2)
dummy% = DisplayPolygon%(W#(), 12, See1)
_Delay 0.5
dummy% = Inflate2D%(W#(), BoundsW, .25)
dummy% = DisplayPolygon%(W#(), 14, See1)
Beep
Z$ = Input$(1)
BoundingBox
dummy% = MoveTo2D%(W#(), BoundsW, 60, 60)
dummy% = DisplayPolygon%(W#(), 13, See1)
_Delay 0.5
dummy% = ScaleX2D%(W#(), BoundsW, 2)
dummy% = DisplayPolygon%(W#(), 10, See1)
_Delay 0.5
dummy% = ScaleY2D%(W#(), BoundsW, 2)
dummy% = DisplayPolygon%(W#(), 11, See1)
_Delay 0.5
dummy% = ScaleXY2D%(W#(), BoundsW, 2, 2)
dummy% = DisplayPolygon%(W#(), 12, See1)
_Delay 0.5
dummy% = Scale2D%(W#(), BoundsW, .25)
dummy% = DisplayPolygon%(W#(), 14, See1)
Beep
Z$ = Input$(1)
dummy% = Inflate2D%(X#(), BoundsX, 2)
dummy% = MoveTo2D%(X#(), BoundsX, 100, 100)
For Index% = 1 To 10
BoundingBox
dummy% = DisplayPolygon%(X#(), 12, See1)
dummy% = ShearX2D%(X#(), BoundsX, .1)
dummy% = DisplayPolygon(X#(), 10, See1)
dummy% = ShearY2D%(X#(), BoundsX, .1)
dummy% = DisplayPolygon(X#(), 11, See1)
_Delay 0.5
Next Index%
Beep
Z$ = Input$(1)
BoundingBox
dummy% = MoveTo2D%(W#(), BoundsW, 420, 0)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
For Index% = 1 To 18
dummy% = Rotation2D%(W#(), BoundsW, 5)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
Next Index%
Beep
Z$ = Input$(1)
BoundingBox
dummy% = Inflate2D%(P#(), BoundsP, 3)
dummy% = MoveTo2D%(P#(), BoundsP, 320, 240)
dummy% = DisplayPolygon%(P#(), 11, See1)
_Delay 0.5
For Index% = 1 To 6
dummy% = Spin2D%(P#(), BoundsW, 30)
dummy% = DisplayPolygon%(P#(), 11, See1)
_Delay 0.5
Next Index%
Beep
Z$ = Input$(1)
BoundingBox
dummy% = Spin2D%(W#(), BoundsW, -90)
dummy% = MoveTo2D%(W#(), BoundsW, 420, 240)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
For Index% = 1 To 11
dummy% = Orbit2D%(W#(), BoundsW, 320, 240, 30)
dummy% = DisplayPolygon%(W#(), 14, See1)
_Delay 0.5
Next Index%
Beep
Z$ = Input$(1)
Cls
Line (StartPosX, StartPosY)-(320, 240), 15, B
dummy% = DisplayShape2D%(M#(), 14, SList1%(), See2)
Beep
Z$ = Input$(1)
Cls
Line (320, 240)-(XMax, YMax), 15, B
dummy% = DisplayShape2D%(M#(), 14, SList1%(), See3)
Beep
Z$ = Input$(1)
Cls
Line (160, 120)-(479, 359), 15, B
dummy% = DisplayShape2D%(M#(), 14, SList1%(), See4)
dummy% = DisplayShape2D%(N#(), 10, SList2%(), See4)
Beep
Z$ = Input$(1)
Cls
End
Sub BoundingBox
Cls
Line (StartPosX, StartPosY)-(XMax, YMax), 15, B
End Sub
'$INCLUDE: 'G2.BM'
G2DEMO.DAT (pre-calculated coordinates)
Code: (Select All) 52.78181814000001 21.02857136000001
6.309090860000005 21.02857136000001
6.309090860000005 62.08571423000001
52.78181814000001 62.08571423000001
52.78181814000001 130.51428568
110.87272724 130.51428568
110.87272724 198.94285713
17.92727268000001 198.94285713
17.92727268000001 335.80000003
168.96363634 335.80000003
168.96363634 472.65714293
227.05454544 472.65714293
227.05454544 198.94285713
343.23636364 198.94285713
343.23636364 335.80000003
447.80000002 335.80000003
447.80000002 472.65714293
471.03636366 472.65714293
471.03636366 335.80000003
633.69090914 335.80000003
633.69090914 267.37142858
471.03636366 267.37142858
471.03636366 198.94285713
529.12727276 198.94285713
529.12727276 198.94285713
563.98181822 198.94285713
563.98181822 157.88571426
598.83636368 157.88571426
598.83636368 7.342857070000008
447.80000002 7.342857070000008
447.80000002 198.94285713
401.32727274 198.94285713
401.32727274 103.1428571
354.85454546 103.1428571
354.85454546 157.88571426
203.8181818 157.88571426
203.8181818 75.77142852
378.0909091 75.77142852
378.0909091 34.71428565000001
168.96363634 34.71428565000001
168.96363634 75.77142852
99.25454542 75.77142852
99.25454542 21.02857136000001
52.78181814000001 21.02857136000001
A few notes to follow later. For now compile the demo and run the resulting exe. One thing that is very important however - the DAT files must be in the same folder as the exe. It will execute but it won't work.
TR
Posts: 666
Threads: 144
Joined: Apr 2022
Reputation:
62
Wow, lot's of good coordinate vector drawing there.
Posts: 98
Threads: 24
Joined: Apr 2022
Reputation:
6
Here are the notes on the demo program I promised, in the form of an 11 page pdf document. At least now you should know what you are looking at  .
Notes on the Demo.pdf (Size: 327.75 KB / Downloads: 220)
TR
Posts: 744
Threads: 34
Joined: Apr 2022
Reputation:
49
Cool, man
Tread on those who tread on you
Posts: 503
Threads: 25
Joined: Nov 2022
Reputation:
45
Thanks for sharing this! Have not had a chance to play/look but wanted to say thanks. Adding screenshots of the demos would be helpful, so if I get to that I will add them unless someone else does first.
|
