Language: QBasic.
Objective: This is a set of subroutines to generate simple scientific graphics using the QuickBasic interpreter. It is very useful when you needs graphical output directly from your own programs.
Note: This program requires that the file TABFORM.VGA is in the same directory of the BASIC program. So, you need to create this file using the same procedure as described for the copy of the BASIC programs. The file TABFORM.VGA is listed below, copy-and-paste its contents in a word processor (EDITOR [DOS] or WORD recommended!) and then save it with this name and in "text" format!
***** Begin of the TABFORM.VGA File *****
P1,0BL2D1R4U2L4D1 P1,0L4R8L4U2D4 P1,0BD2L2R4H3G3R1 P1,0BU2L2R4G3H3R1 P1,0 P1,0BR3U1BU2U3 P1,0BR1BU5U1BR3D1 P1,0BR2U6BR3D6U4R2L7BD2R7 P1,0BR4U6D1R2L4G1F1R4F1G1L4 P1,0BR1BU6D1R1U1BD6BR4U1L1D1BL4E6 P1,0BR6H5E1R2F1G4F1R2E2 P1,0BR3BU6D2 P1,0BR4H2U2E2 P1,0BR1E2U2H2 P1,0BU3R6L3U2D4U2H2F4H2E2G4 P1,0BU3R6L3U2D4 P1,0BR2E1U1L1 P1,0BU3R5 P1,0BR2U1R1D1 P1,0E6 P1,0R3E1U4H1L3G1D4E4 P1,0BR1R4L2U6G1 P1,0R5L5E5H1L3G1 P1,0BU1F1R3E1U1H2E2L5 P1,0BR4U6G4R5 P1,0BU1F1R3E1U2H1L4U2R5 P1,0BR1R3E1U1BD1G1L3BL1BU1U1BE1R3BL3BL1BE1E2 P1,0BR2U2E4L6 P1,0BR1R3E1U1H1L3BG1D1U1E1H1U1E1R3F1D1 P1,0BR1E4BU1H1L3G1D1F1R2BR1 P1,0BR2BU1U1R1D1L1BU3U1R1D1 P1,0BR2E1U1L1BU2U1R1D1 P1,0BU3F3H3E3 P1,0BU2R5BU2L5 P1,0BR5BU3H3F3G3 P1,0BR3U1BU2E2H1L3G1 P1,0BU1U1E1R1D3L1R3E1U4H1L3G1 P1,0U5BU1BR1R3BR1BD1D5BL5BU3R5 P1,0U6R4BR1BD1D1BD1D2BD1BL1L4U3R4 P1,0BU1U4BU1BR1R3F1BD4G1L3 P1,0U6R3F1F1D2G1G1L3 P1,0U6R5BD3BL4R3BD3BL4R5 P1,0U6R5BD3BL4R3 P1,0BU1U4BU1BR1R3F1BD2L2BR2D3L4 P1,0U6D3R5U3D6 P1,0BR2R2L1U6L1R2 P1,0BU1U1BF2L1R3BR1BU1U5BL1R2 P1,0U6D3R2E3G3F3 P1,0U6D6R5 P1,0U6F3D1U1E3D6 P1,0U6BD1R1BD1R1BD1R1BD1R1BD1R1BD1R1U6 P1,0BU1U4E1R3F1D4G1L3 P1,0U6R4F1D1G1L3 P1,0BU1U4BE1R3BF1D2G3L1BR2BU3F3 P1,0U6R4BF1D1BG1L3R1F3 P1,0BU1F1R3E1U1H1L3H1U1E1R3F1 P1,0BR2U6L3R6 P1,0BU1U5D5F1R3E1U5 P1,0BU3U3D3F3E3U3 P1,0U6D6E3U1D1F3U6 P1,0E6G3H3F6 P1,0BR3U3H3F3E3 P1,0R5L5E5U1L5 P1,0BR1R2L2U6R2 P1,0BU6F6 P1,0BR2R2U6L2 P1,0BR3U6F3H3G3 P1,0R6 P1,0BU6BR3D1G1 P1,0BR1H1E1R4D2L4R4U3H1L3 P1,0BR1R3E1U2H1L2G2D1U5 P1,0BR1R3E1G1L3H1U2E1R3 P1,0BR1R4U6D4H2L2G1D2 P1,0BR1R3L3H1U2E1R3F1D1L5 P1,0BR2U3L1R2L1U2E1R1F1 P1,0BR1R3E1U3L4G1F1R4 P1,0U6D4E2R2F1D3 P1,0BR1R2L1U4BU2L1BR1BD2L1 P1,0BU1F1R2E1U3BU2L1 P1,0BR1U6D4R2E2G2F2 P1,0BR2R2L1U6L1 P1,0U4R1R1F1D3U3E1R1F1D3 P1,0U4D2E2R2F1D3 P1,0BR1R3E1U2H1L3G1D2 P1,0U4R5F1G1L5 P1,0BR5U4L5G1F1R5 P1,0BR1U4D2E2R2 P1,0R4E1H1L3H1E1R4 P1,0BR2R1E1G1BL1BU1U4D1L1R2 P1,0BU1U3D3F1R2E3U1D4 P1,0BU3U1D1F3E3U1 P1,0BU1U3D3F1R1E1U1D1F1R1E1U3 P1,0E2R1E2G2L1H2F2R1F2 P1,0R2E3U1D1G1L2H2 P1,0R5L5BU1R1BR1BU1R1BU1BR1R1BU1L5 P1,0BR3R1L1H1U1H1L1R1E1U1E1R1 P1,0BR3U2BU2U2 P1,0BR2R1E1U1E1R1L1H1U1H1L1***** End of the TABFORM.VGA File *****
***** Begin of Program Listing *****
REM
REM *** SCIENTIFIC GRAPHICAL ROUTINES PACKAGE
REM ***
REM *** Antonio Augusto Gorni ---- December 29, 1994
REM ***
REM
REM *** Basic Definitions to be Made at the Main Program.
REM
DECLARE SUB INITGRAPH ()
DECLARE SUB INITAXIS (X(), Y(), N)
DECLARE SUB CARTESIAN (X, Y, PX, PY)
DECLARE SUB NOTEXP (EXPO, VAR, POV)
DECLARE SUB LABEL (A$, PX, PY)
DECLARE SUB AXIS ()
DECLARE SUB PLOTPOINT (X(), Y(), N, SM)
DECLARE SUB PLOTLINE (X(), Y(), N)
DECLARE SUB GRID ()
DECLARE SUB HARDCOPY ()
DECLARE SUB SHOGRAPH ()
COMMON SHARED X0, X1, Y0, Y1, NX, NY, XA$, YA$, EX, EY, XRESOL, YRESOL
COMMON SHARED GRAPHICS(), LETRA$(), XMARGMIN, YMARGMIN, XMARGMAX, YMARGMAX
DIM LETRA$(125), GRAPHICS(9940)
REM
REM *** Demo Program.
REM
FOR I = 1 TO 50
X(I) = I
Y(I) = I * I
NEXT
CALL INITGRAPH
CALL INITAXIS(X(), Y(), 50)
PRINT X0, X1, Y0, Y1
CALL AXIS
CALL PLOTPOINT(X(), Y(), 50, 1)
CALL GRID
END
REM
REM *** Subroutine AXIS
REM ***
REM *** Plots the Cartesian Axis Using Information Generated
REM *** by the Previous Execution of the Subroutine INITAXIS.
REM
SUB AXIS
SCREEN 11: X$ = XA$: Y$ = YA$
XMARGMIN = XRESOL / 12.549: XMARGMAX = XRESOL / 1.002
YMARGMIN = YRESOL / 16.667: YMARGMAX = YRESOL / 1.13
LINE (XMARGMIN, YMARGMIN)-(XMARGMAX, YMARGMIN)
LINE (XMARGMAX, YMARGMIN)-(XMARGMAX, YMARGMAX)
LINE (XMARGMIN, YMARGMAX)-(XMARGMAX, YMARGMAX)
LINE (XMARGMIN, YMARGMAX)-(XMARGMIN, YMARGMIN)
SX = (X1 - X0) / NX: SY = (Y1 - Y0) / NY
FOR I = X0 TO X1 STEP SX
CARTESIAN I, 0!, PX, PY
LINE (PX, YMARGMIN)-(PX, YRESOL / 10.526)
LINE (PX, YMARGMAX)-(PX, YRESOL / 1.176)
NEXT
FOR I = Y0 TO Y1 STEP SY
CARTESIAN 0!, I, PX, PY
LINE (XMARGMIN, PY)-(XRESOL / 9.552, PY)
LINE (XMARGMAX, PY)-(XRESOL / 1.029, PY)
NEXT
VAR = X0
NOTEXP EX, VAR, PIV
VAR = X1
NOTEXP EX, VAR, POV: IF ABS(PIV) < ABS(POV) THEN PIV = POV
FOR K = X0 TO X1 STEP SX
CARTESIAN K, 0!, PX, PY
IF PX < XRESOL / 1.061 THEN
VAR = K
NOTEXP EX, VAR, POV
IF POV <> PIV THEN VAR = VAR * 10 ^ (3 * (POV - PIV))
IF ABS(VAR) < .001 THEN VAR = 0
IF PIV <> 0 THEN VAR = INT(VAR + .5)
P$ = LEFT$(STR$(VAR), 5): Y = YRESOL / 1.07
X = PX - 6 * LEN(P$)
LABEL P$, X, Y
END IF
NEXT
EX = PIV
VAR = Y0
NOTEXP EY, VAR, PIV
VAR = Y1
NOTEXP EY, VAR, POV: IF ABS(PIV) > ABS(POV) THEN PIV = POV
FOR K = Y0 TO Y1 STEP SY
CARTESIAN 0, K, PX, PY
IF PY >= YRESOL / 10 THEN
Y = PY + 2
VAR = K
NOTEXP EY, VAR, POV
IF POV <> PIV THEN VAR = VAR * 10 ^ (3 * (POV - PIV))
IF ABS(VAR) < .001 THEN VAR = 0
IF PIV <> 0 THEN VAR = INT(VAR + .5)
P$ = LEFT$(STR$(VAR), 5): X = XMARGMIN - XRESOL / 64 * LEN(P$)
LABEL P$, X, Y
END IF
NEXT
EY = PIV
IF X0 * X1 <= 0 THEN
CARTESIAN 0!, Y, PX, PY
LINE (PX, YMARGMIN)-(PX, YMARGMAX)
END IF
IF Y0 * Y1 < 0 THEN
CARTESIAN X, 0!, PX, PY
LINE (XMARGMIN, PY)-(XMARGMAX, YMARGMAX)
END IF
IF EX <> 0 THEN
IF EX > 0 THEN OFS = 1 ELSE OFS = 0
EX$ = "(x10^" + RIGHT$(STR$(3 * EX), LEN(STR$(3 * EX)) - OFS) + ")"
X$ = X$ + " " + EX$
END IF
IF EY <> 0 THEN
IF EY > 0 THEN OFS = 1 ELSE OFS = 0
EY$ = "(x10^" + RIGHT$(STR$(3 * EY), LEN(STR$(3 * EY)) - OFS) + ")"
Y$ = Y$ + " " + EY$
END IF
X = XMARGMIN + INT(XRESOL / 1.21 - XRESOL / 64 * LEN(X$)) / 2
Y = YRESOL / 1.01
LABEL X$, X, Y
X = XMARGMIN: Y = YRESOL / 25
LABEL Y$, X, Y
END SUB
REM
REM *** Subroutine CARTESIAN
REM ***
REM *** Input Parameters:
REM *** X -> Abcissa of the Point to Be Ploted;
REM *** Y -> Ordinated of the Point to Be Ploted.
REM ***
REM *** Output Parameters:
REM *** PX -> Screen Matrix Abcissa Corresponding to X;
REM *** PY -> Screen Matrix Ordinate Corresponding to Y.
REM
REM *** Converts the coordinates of the points to be ploted in the
REM *** corresponding values in the screen matrix.
REM
SUB CARTESIAN (X, Y, PX, PY)
PX = XMARGMIN + XRESOL / 1.088 * (X - X0) / (X1 - X0)
PY = YMARGMIN + YRESOL / 1.212 * (Y1 - Y) / (Y1 - Y0)
END SUB
REM
REM *** Subroutine GRID
REM
REM *** Checkers the Plotted Graphic.
REM
SUB GRID
SCREEN 11: PUT (0, 0), GRAPHICS, PSET
PU = XRESOL / 1.09 / NX: PA = YRESOL / 1.212 / NY
FOR X = XMARGMIN TO XMARGMAX - 10 STEP PU
FOR Y = YMARGMIN TO YMARGMAX STEP PA / 5
PSET (X, Y)
NEXT
NEXT
FOR Y = YMARGMIN TO YMARGMAX STEP PA
FOR X = XMARGMIN TO XMARGMAX STEP PU / 5
PSET (X, Y)
NEXT
NEXT
GET (0, 0)-(XRESOL - 1, YRESOL - 1), GRAPHICS
A$ = ""
WHILE A$ = ""
A$ = INKEY$
WEND
END SUB
REM
REM *** Subroutine HARDCOPY
REM
REM *** Prints the graphic in a EPSON compatible printer.
REM
SUB HARDCOPY
STATIC FLAGPRINTER
LOCATE 11: PRINT "Prepare Printer;"
PRINT : INPUT "Press to Continue! ", R$
SCREEN 11: PUT (0, 0), GRAPHICS, PSET
IF FLAGPRINTER = 0 THEN FLAGPRINTER = 1
OPEN "LPT1:" FOR RANDOM AS #3: WIDTH #3, 255
PRINT #3, CHR$(24); : PRINT #3, CHR$(27); "A"; CHR$(8);
DEF SEG = &HB800
FOR A = 0 TO 79:
PRINT #3, CHR$(27); "K"; CHR$(144); CHR$(1);
B = A + &H1EF0
FOR C = 1 TO 100:
D = PEEK(B): EPRT = PEEK(B + &H2000):
PRINT #3, CHR$(EPRT); CHR$(EPRT); CHR$(D); CHR$(D);
B = B - 80:
NEXT C
PRINT #3, CHR$(13); CHR$(10);
NEXT
PRINT #3, CHR$(13); CHR$(24); CHR$(27); CHR$(50);
LPRINT CHR$(12)
END SUB
REM
REM *** Subroutine INITAXIS
REM
REM *** Input Parameters:
REM *** X() -> Array containing the data abcissa values;
REM *** Y() -> Array containing the data ordinate values;
REM *** N -> Number of Points.
REM
REM *** Defines the positioning of the cartesian axis. It must be executed
REM *** before the plotting of the graphic.
REM
SUB INITAXIS (X(), Y(), N)
X0 = X(1): X1 = X(1): Y0 = Y(1): Y1 = Y(1)
FOR I = 2 TO N
IF X0 > X(I) THEN X0 = X(I)
IF X1 < X(I) THEN X1 = X(I)
IF Y0 > Y(I) THEN Y0 = Y(I)
IF Y1 < Y(I) THEN Y1 = Y(I)
NEXT I
VIEW PRINT 1 TO 24: CLS
BF$ = "DEFINITION OF THE AXIS AND GRAPHICAL PARAMETERS"
PRINT TAB((80 - LEN(BF$)) / 2 + 1);
COLOR 0, 7: PRINT BF$: COLOR 7, 0: VIEW PRINT 4 TO 24
LOCATE 7
PRINT "Current Minimum X: "; X0; : INPUT " - New: ", S$
IF S$ <> "" THEN X0 = VAL(S$)
LOCATE 9
PRINT "Current Maximum X: "; X1; : INPUT " - New: ", S$
IF S$ <> "" THEN X1 = VAL(S$)
LOCATE 11
PRINT "Current Minimum Y: "; Y0; : INPUT " - New: ", S$
IF S$ <> "" THEN Y0 = VAL(S$)
LOCATE 13
PRINT "Current Maximum Y: "; Y1; : INPUT " - New: ", S$
IF S$ <> "" THEN Y1 = VAL(S$)
LOCATE 16
PRINT "Current Number of Ticks in the X-Axis: "; NX
INPUT "New: ", S$: IF S$ <> "" THEN NX = VAL(S$)
LOCATE 19
PRINT "Current Number of Ticks in the Y-Axis: "; NY
INPUT "New: ", S$: IF S$ <> "" THEN NY = VAL(S$)
CLS : LOCATE 7
PRINT "Current X-Axis Label: "; XA1$
LINE INPUT "New: ", S$: IF S$ <> "" THEN XA$ = S$
LOCATE 10
PRINT "Current Y-Axis Label: "; YA1$
LINE INPUT "New: ", S$: IF S$ <> "" THEN YA$ = S$
END SUB
REM
REM *** Subroutine INITGRAPH
REM
REM *** Initializes parameters to graphic plotting. It must be
REM *** executed before any other graphical routine.
REM
SUB INITGRAPH
NX = 5: NY = 5: XRESOL = 640: YRESOL = 480
OPEN "TABFORM.VGA" FOR INPUT AS #1
FOR I = 26 TO 125: LINE INPUT #1, LETRA$(I): NEXT
CLOSE #1
END SUB
REM
REM *** Subroutine LABEL
REM
REM *** Input Parameters:
REM *** P$ -> Message to be Written in the Graphic;
REM *** X -> Message's Initial Point Abcissa;
REM *** Y -> Message's Initial Point Ordinate.
REM
REM *** Writes a message in the graphic, starting at the defined point.
REM
SUB LABEL (P$, X, Y)
FOR I = 1 TO LEN(P$)
PA$ = MID$(P$, I, 1)
IF PA$ <> " " THEN
AP = ASC(PA$)
PSET (X + (I - 1) * 10, Y), 0: DRAW LETRA$(AP)
END IF
NEXT
END SUB
REM
REM *** Subroutine NOTEXP
REM
REM *** Input Parameters:
REM *** . EXPO -> Initial Exponent of Scientific Notation Used in the Axis' Values
REM *** . VAR -> Axis Label
REM *** . POV -> Current Exponent of Scientific Notation Used in the Axis' Values
REM
REM *** Internal subroutine, normally not used by the user,
REM *** which determines the exponente of scientific notation
REM *** used in the axis' values.
REM
SUB NOTEXP (EXPO, VAR, POV)
POV = 0
SI = 1: IF VAR < 0 THEN SI = -1
VAR = ABS(VAR)
IF VAR < 10 ^ -(EXPO + 3) THEN
VAR = 0
ELSE
WHILE VAR > 999 OR VAR < 1
IF VAR > 999 THEN VAR = VAR / 1000: POV = POV + 1
IF VAR < 1 THEN VAR = VAR * 1000: POV = POV - 1
WEND
END IF
VAR$ = STR$(SI * VAR)
VAR$ = LEFT$(VAR$, 5)
VAR = VAL(VAR$)
END SUB
REM
REM *** Subroutine PLOTLINE
REM
REM *** Input Parameters:
REM *** X() -> Array containing the data abcissa values;
REM *** Y() -> Array containing the data ordinate values;
REM *** N -> Number of Points.
REM
REM *** Plots a line corresponding to the N points in the X()
REM *** and Y() arrays.
REM
SUB PLOTLINE (X(), Y(), N)
PTOINIC = 0
FOR I = 1 TO N
CARTESIAN X(I), Y(I), PX, PY
IF PY < YMARGMIN OR PY > YMARGMAX OR PX < XMARGMIN OR PX > XMARGMAX THEN
PTOINIC = 0
ELSE
IF PTOINIC = 0 THEN
PTOINIC = 1: PX1 = PX: PY1 = PY
ELSE
IF I <> 1 THEN LINE (PX1, PY1)-(PX, PY)
PX1 = PX: PY1 = PY
END IF
END IF
NEXT
GET (0, 0)-(XRESOL - 1, YRESOL - 1), GRAPHICS
A$ = ""
WHILE A$ = ""
A$ = INKEY$
WEND
END SUB
REM
REM *** Subroutine PLOTPOINT
REM
REM
REM *** Input Parameters:
REM *** X() -> Array containing the data abcissa values;
REM *** Y() -> Array containing the data ordinate values;
REM *** N -> Number of Poins;
REM *** SM -> Point Type to be Ploted:
REM *** = 1 -> Circle;
REM *** = 2 -> Square;
REM *** = 3 -> Cross;
REM *** = 4 -> Up Triangle;
REM *** = 5 -> Down Triangle.
REM
REM *** Plots the set of N points according to the coordinates stored
REM *** in the X() and Y() arrays, using the point type defined in SM.
REM
SUB PLOTPOINT (X(), Y(), N, SM)
FOR I = 1 TO N
CARTESIAN X(I), Y(I), PX, PY
IF PY >= YMARGMIN AND PY <= YMARGMAX THEN
IF PX >= XMARGMIN AND PX <= XMARGMAX THEN
IF SM = 1 THEN CIRCLE (PX, PY), 2.25 ELSE PSET (PX, PY), 0
DRAW LETRA$(SM + 26)
END IF
END IF
NEXT
GET (0, 0)-(XRESOL - 1, YRESOL - 1), GRAPHICS
A$ = ""
WHILE A$ = ""
A$ = INKEY$
WEND
END SUB
REM
REM *** Subroutine SHOWGRAPH
REM
REM *** Shows the Graphic in the Screen.
REM
SUB SHOWGRAPH
SCREEN 11: PUT (0, 0), GRAPHICS, PSET
A$ = ""
WHILE A$ = ""
A$ = INKEY$
WEND
END SUB
***** End of Program Listing ******
Return to the Software Menu.
 |
Last Update: 26 June 1996 | |
| © Antonio Augusto Gorni |