Category : Science and Education
Archive   : EEPUB07.ZIP
Filename : PLOT.SUB
10 REM ALL CALLED VARIABLES ARE CALLED BY SINGLE PRECISION VALUE
20 IDIM=2010:DIM X(2010),Y(2010),NPP(50),LN(50),NS(50),LG$(50)
30 LG10 = LOG(10):KEY OFF:JF=0:LGQ$="N"
40 XDN=2:YDN=2:LX$="N":LY$="N":NHD=0:LGB=1
50 CLOSE #1: CLOSE #2: DIM HED$(2),YHED(2)
60 ISCRN = 2: REM --> 100 for AT&T, 2 for IBM PC
70 IHERC = 0: REM --> 0 for IBM graphics, 1 for Hercules graphics
80 PRINT:PRINT" CURVE PLOTTING SUBROUTINE":PRINT
90 CP$="N"
100 IF CP$ = "Y" OR CP$ = "y" GOTO 3610
110 CC$="N"
120 IF CC$ <> "Y" AND CC$ <> "y" GOTO 160
130 FILES:PRINT
140 INPUT"Command file name";CF$
150 OPEN "O",#2,CF$
160 REM ANNOTATION
170 GOSUB 2790
180 REM READ DATA FILES
190 GOSUB 3090
200 REM FIND XMAX,MIN, YMAX,MIN
210 GOSUB 3460
220 IF XMIN > 0 GOTO 240
230 GOTO 260
240 INPUT"Log scale on X axis (Y/N) ";LX$
250 IF LX$ <> "Y" AND LX$ <> "y" THEN LX$ = "N"
260 IF YMIN > 0 GOTO 280
270 GOTO 300
280 INPUT"Log scale on Y axis (Y/N) ";LY$
290 IF LY$ <> "Y" AND LY$ <> "y" THEN LY$ = "N"
300 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, LX$
310 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, LY$
320 IF LX$ <> "Y" AND LX$ <> "y" GOTO 400
330 IF XMAX <> XMIN THEN 350
340 XMAX=XMAX*2: XMIN=XMIN/2
350 MINN = XMIN: MAXX = XMAX: GOSUB 2710
360 XMIN = MINN: XMAX = MAXX:PRINT"XMIN, MAX =";XMIN;XMAX
370 LGX=LOG(XMAX/XMIN):DECX = DEC: PRINT"DECX = ";DECX
380 IF CC$="Y" OR CC$="Y" THEN PRINT #2,XMIN,XMAX,LGX,DECX
390 GOTO 510
400 INPUT"Want to specify XMIN, XMAX (Y/N) ";AN$
410 IF AN$ = "Y" OR AN$ = "y" THEN 460
420 IF XMAX <> XMIN THEN 500
430 IF XMAX <> 0 THEN 450
440 XMIN = -1: XMAX = 1: GOTO 500
450 XMIN=XMIN/2: XMAX=XMAX*2: GOTO 500
460 INPUT"XMIN, XMAX ";XMIN,XMAX
470 IF XMAX =< XMIN GOTO 460
480 INPUT"No. of tick marks on X axis ";XDN
490 IF XDN <= 0 THEN XDN = 1
500 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, XMIN,XMAX,XDN
510 IF LY$ <> "Y" AND LY$ <> "y" GOTO 590
520 IF YMAX <> YMIN THEN 540
530 YMAX=YMAX*2: YMIN=YMIN/2
540 MINN = YMIN: MAXX = YMAX: GOSUB 2710
550 YMIN = MINN: YMAX = MAXX:PRINT"YMIN, MAX =";YMIN;YMAX
560 LGY=LOG(YMAX/YMIN):DECY = DEC: PRINT"DECY = ";DECY
570 IF CC$="Y" OR CC$="Y" THEN PRINT #2,YMIN,YMAX,LGY,DECY
580 GOTO 700
590 INPUT"Want to specify YMIN, YMAX (Y/N) ";AN$
600 IF AN$ = "Y" OR AN$ = "y" THEN 650
610 IF YMAX <> YMIN THEN 690
620 IF YMAX <> 0 THEN 640
630 YMIN = -1: YMAX = 1: GOTO 690
640 YMIN=YMIN/2: YMAX=YMAX*2: GOTO 690
650 INPUT"YMIN, YMAX ";YMIN,YMAX
660 IF YMAX =< YMIN GOTO 650
670 INPUT"No. of tick marks on Y axis ";YDN
680 IF YDN <= 0 THEN YDN = 1
690 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, YMIN,YMAX,YDN
700 IF CC$ = "Y" OR CC$ = "y" THEN CLOSE #2
710 PRINT:BEEP
720 PRINT"Type 0 for screen plot"
730 PRINT" 1 for HP plotter"
740 INPUT IDEV
750 IF IDEV < 1 THEN IDEV = 0 ELSE IDEV = 1
760 XMXX=XMAX-XMIN: YMXX=YMAX-YMIN
770 CLS:PRINT"******** PLOT IS BEING GENERATED ***********"
780 ON (IDEV+1) GOTO 790,4290
790 REM Define sreen data
800 IF ISCRN <> 100 GOTO 840
810 XN=100:XX=600:YN=40:YX=350:XTIC=5:YTIC=5
820 XLB= 5: XLE=100: YLB=375: DXL=128
830 GOTO 900
840 IF IHERC = 1 GOTO 880
850 XN=100:XX=600:YN=20:YX=175:XTIC=3:YTIC=5
860 XLB= 5: XLE=100: YLB=188: DXL=128
870 GOTO 900
880 XN=115:XX=680:YN=35:YX=300:XTIC=5:YTIC=5
890 XLB= 5: XLE=110: YLB=330: DXL=143
900 REM - CONVERT TO SCREEN UNITS
910 XXXN=XX-XN: YNYX=YN-YX
920 II = 0
930 FOR J = 1 TO JF
940 IF LX$ = "Y" OR LX$ = "y" GOTO 1000
950 FOR I = 1 TO NPP(J)
960 II = II + 1
970 X(II) = XN + XXXN*(X(II)-XMIN)/XMXX
980 NEXT I
990 GOTO 1040
1000 FOR I = 1 TO NPP(J)
1010 II = II + 1
1020 X(II) = XN + XXXN*LOG(X(II)/XMIN)/LGX
1030 NEXT I
1040 NEXT J
1050 II = 0
1060 FOR J = 1 TO JF
1070 IF LY$ = "Y" OR LY$ = "y" GOTO 1130
1080 FOR I = 1 TO NPP(J)
1090 II = II + 1
1100 Y(II) = YX + YNYX*(Y(II)-YMIN)/YMXX
1110 NEXT I
1120 GOTO 1170
1130 FOR I = 1 TO NPP(J)
1140 II = II + 1
1150 Y(II) = YX + YNYX*LOG(Y(II)/YMIN)/LGY
1160 NEXT I
1170 NEXT J
1180 REM DRAW BOX
1190 SCREEN ISCRN: CLS
1200 IF LX$ = "Y" OR LX$ = "y" GOTO 1340
1210 REM LINEAR X AXIS
1220 DRAW"BM="+VARPTR$(XN)+",="+VARPTR$(YX):DX=(XX-XN)/XDN:XA=XN:YA=YX-XTIC
1230 FOR I=1 TO XDN: XA=XA+DX
1240 DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YX):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YX)
1250 NEXT I
1260 DRAW"BM="+VARPTR$(XN)+",="+VARPTR$(YN):XA=XN:YA=YN+XTIC
1270 FOR I=1 TO XDN: XA=XA+DX
1280 DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YN):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YN)
1290 NEXT I
1300 REM VERTICAL LINE AT X = 0
1310 IF XMIN > 0 OR XMAX < 0 GOTO 1450
1320 XB = XN + (XX-XN)*XMIN/(XMIN-XMAX)
1330 DRAW"BM="+VARPTR$(XB)+",="+VARPTR$(YN):DRAW"M="+VARPTR$(XB)+",="+VARPTR$(YX):GOTO 1450
1340 REM LOG X AXIS
1350 DRAW"BM="+VARPTR$(XN)+",="+VARPTR$(YX):DX=(XX-XN)/DECX:XA=XN:YA=YX-XTIC
1360 FOR I=1 TO DECX: FOR J = 2 TO 10
1370 XAA = XA + DX*LOG(J)/LG10
1380 DRAW"M="+VARPTR$(XAA)+",="+VARPTR$(YX):DRAW"M="+VARPTR$(XAA)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XAA)+",="+VARPTR$(YX)
1390 NEXT J: XA = XAA: NEXT I
1400 DRAW"BM="+VARPTR$(XN)+",="+VARPTR$(YN):XA=XN:YA=YN+XTIC
1410 FOR I=1 TO DECX: FOR J = 2 TO 10
1420 XAA = XA + DX*LOG(J)/LG10
1430 DRAW"M="+VARPTR$(XAA)+",="+VARPTR$(YN):DRAW"M="+VARPTR$(XAA)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XAA)+",="+VARPTR$(YN)
1440 NEXT J: XA = XAA: NEXT I
1450 IF LY$ = "Y" OR LY$ = "y" GOTO 1590
1460 REM LINEAR Y AXIS
1470 DRAW"BM="+VARPTR$(XN)+",="+VARPTR$(YN):DY=(YX-YN)/YDN:YA=YN:XA=XN+YTIC
1480 FOR I=1 TO YDN: YA = YA + DY
1490 DRAW"M="+VARPTR$(XN)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XN)+",="+VARPTR$(YA)
1500 NEXT I
1510 DRAW"BM="+VARPTR$(XX)+",="+VARPTR$(YN):YA=YN:XA=XX-YTIC
1520 FOR I=1 TO YDN: YA = YA + DY
1530 DRAW"M="+VARPTR$(XX)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YA):DRAW"M="+VARPTR$(XX)+",="+VARPTR$(YA)
1540 NEXT I
1550 REM HORIZONTAL LINE AT Y = 0
1560 IF YMIN > 0 OR YMAX < 0 GOTO 1650
1570 YB = YN + (YX-YN)*YMAX/(YMAX-YMIN)
1580 DRAW"BM="+VARPTR$(XN)+",="+VARPTR$(YB):DRAW"M="+VARPTR$(XX)+",="+VARPTR$(YB):GOTO 1700
1590 REM LOG Y AXIS
1600 DRAW"BM="+VARPTR$(XN)+",="+VARPTR$(YX):DY=(YX-YN)/DECY:YA=YX:XA=XN+YTIC
1610 FOR I=1 TO DECY: FOR J = 2 TO 10
1620 YAA = YA - DY*LOG(J)/LG10
1630 DRAW"M="+VARPTR$(XN)+",="+VARPTR$(YAA):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YAA):DRAW"M="+VARPTR$(XN)+",="+VARPTR$(YAA)
1640 NEXT J: YA = YAA: NEXT I
1650 DRAW"BM="+VARPTR$(XX)+",="+VARPTR$(YX):YA=YX:XA=XX-YTIC
1660 FOR I=1 TO DECY: FOR J = 2 TO 10
1670 YAA = YA - DY*LOG(J)/LG10
1680 DRAW"M="+VARPTR$(XX)+",="+VARPTR$(YAA):DRAW"M="+VARPTR$(XA)+",="+VARPTR$(YAA):DRAW"M="+VARPTR$(XX)+",="+VARPTR$(YAA)
1690 NEXT J: YA = YAA: NEXT I
1700 REM PLOT CURVES
1710 II = 0
1720 FOR J = 1 TO JF
1730 II = II + 1
1740 IF LN(J) = 2 THEN 1870
1750 DRAW"BM="+VARPTR$(X(II))+",="+VARPTR$(Y(II))
1760 IF LN(J) = 1 THEN 1780
1770 ON NS(J) GOSUB 4140,4170,4200,4230,4260
1780 FOR I = 2 TO NPP(J)
1790 II = II + 1
1800 IF LN(J) = 3 THEN 1830
1810 DRAW"M="+VARPTR$(X(II))+",="+VARPTR$(Y(II))
1820 GOTO 1850
1830 DRAW"BM="+VARPTR$(X(II))+",="+VARPTR$(Y(II))
1840 ON NS(J) GOSUB 4140,4170,4200,4230,4260
1850 NEXT I
1860 GOTO 2000
1870 REM LINE WITH SYMBOLS
1880 NPS=INT(NPP(J)/8):IF NPS=0 THEN NPS=1
1890 DRAW"BM="+VARPTR$(X(II))+",="+VARPTR$(Y(II))
1900 NPD = 0 : IF NPS > 1 THEN 1920
1910 ON NS(J) GOSUB 4140,4170,4200,4230,4260
1920 FOR I = 2 TO NPP(J)
1930 II = II + 1
1940 NPD = NPD + 1
1950 DRAW"M="+VARPTR$(X(II))+",="+VARPTR$(Y(II))
1960 IF NPD < NPS THEN 1990
1970 ON NS(J) GOSUB 4140,4170,4200,4230,4260
1980 NPD = 0
1990 NEXT I
2000 IF LGQ$<>"Y" AND LGQ$<>"y" THEN 2150
2010 REM WRITE LEGEND
2020 IF J > 5 THEN 2150
2030 LOCATE 25,LGB:PRINT LG$(J);:LGB=LGB+16
2040 ON LN(J) GOTO 2050,2050,2070
2050 DRAW"BM="+VARPTR$(XLB)+",="+VARPTR$(YLB):DRAW"M="+VARPTR$(XLE)+",="+VARPTR$(YLB)
2060 IF LN(J) = 1 THEN 2140
2070 DRAW"BM="+VARPTR$(XLB)+",="+VARPTR$(YLB)
2080 ON NS(J) GOSUB 4140,4170,4200,4230,4260
2090 XLM = (XLB + XLE)/2
2100 DRAW"BM="+VARPTR$(XLM)+",="+VARPTR$(YLB)
2110 ON NS(J) GOSUB 4140,4170,4200,4230,4260
2120 DRAW"BM="+VARPTR$(XLE)+",="+VARPTR$(YLB)
2130 ON NS(J) GOSUB 4140,4170,4200,4230,4260
2140 XLB=XLB+DXL: XLE=XLE+DXL
2150 NEXT J
2160 XB = 12: XE = 74: YB = 3: YE = 22
2170 IF LX$ = "Y" OR LX$ = "y" THEN 2290
2180 NPS=INT(XDN/4):IF NPS=0 THEN NPS=1
2190 SNUM=(XMAX-XMIN)/XDN: XWR=XMIN-SNUM:NPD=0
2200 FOR I = 1 TO XDN+1: NPD=NPD+1
2210 XWR=XWR+SNUM: IF I=XDN+1 THEN XWR=XMAX
2220 IF I = 1 THEN 2240
2230 IF NPD < NPS THEN 2270
2240 LOCATE YE+1,(XB+(XE-XB)*(I-1)/XDN)-3
2250 PRINT USING"##.##^^^^";XWR;
2260 NPD = 0
2270 NEXT I
2280 GOTO 2390
2290 XWR = XMIN/10: NPD=0
2300 NPS=INT(DECX/4):IF NPS=0 THEN NPS=1
2310 FOR I = 1 TO DECX+1:NPD=NPD+1
2320 XWR = XWR*10
2330 IF I = 1 THEN 2350
2340 IF NPD < NPS THEN 2380
2350 LOCATE YE+1,(XB+(XE-XB)*(I-1)/DECX)-3
2360 PRINT USING"##.##^^^^";XWR;
2370 NPD = 0
2380 NEXT I
2390 IF LY$ = "Y" OR LY$ = "y" THEN 2470
2400 SNUM=(YMAX-YMIN)/YDN: YWR = YMAX+SNUM
2410 FOR I = 1 TO YDN+1
2420 LOCATE (YB+(YE-YB)*(I-1)/YDN),4
2430 YWR=YWR-SNUM: IF I=YDN+1 THEN YWR=YMIN
2440 PRINT USING"##.##^^^^";YWR;
2450 NEXT I
2460 GOTO 2530
2470 YWR = YMAX*10
2480 FOR I = 1 TO DECY+1
2490 LOCATE (YB+(YE-YB)*(I-1)/DECY),4
2500 YWR = YWR/10
2510 PRINT USING"##.##^^^^";YWR;
2520 NEXT I
2530 IF AT$ <> "Y" AND AT$ <> "y" GOTO 2680
2540 IF NHD > 2 THEN NHD = NHD-2
2550 IF NHD = 0 THEN 2600
2560 FOR I = 1 TO NHD
2570 DIS = .5*(XE-XB-LEN(HED$(I)))
2580 LOCATE I,DIS+XB: PRINT HED$(I);
2590 NEXT I
2600 DIS = .5*(XE-XB-LEN(XT$))
2610 YXT=25:IF LGQ$="Y" OR LGQ$="y" THEN YXT=21
2620 LOCATE YXT,DIS+XB: PRINT XT$;
2630 LMAX = 24: LEY = LEN(YT$)
2640 IF LEY > LMAX THEN LEY = LMAX
2650 DIS=.5*(YE-YB-LEY)
2660 FOR I = 1 TO LEY: LOCATE YB+DIS+I-1,2
2670 X$=MID$(YT$,I,1): PRINT X$;: NEXT I
2680 AA$ = INKEY$: IF(AA$="") GOTO 2680
2690 CLS: SCREEN 0,0,0
2700 EXIT SUB
2710 REM MIN, MAX FOR LOG SCALE
2720 MINN = INT(LOG(MINN)/LG10)
2730 LGT = LOG(MAXX)/LG10
2740 IF LGT = INT(LGT) GOTO 2760
2750 LGT = INT(LGT) + 1
2760 DEC = LGT - MINN
2770 MAXX = 10^LGT: MINN = 10^MINN
2780 RETURN
2790 REM ANNOTATION AND OTHER QUESTIONS
2800 QB$="N"
2810 IF QB$ <> "Y" AND QB$ <> "y" THEN QB$ = "N"
2820 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, QB$
2830 IF QB$ = "N" THEN 2870
2840 INPUT "Box left bottom corner location X,Y (inch) ";BX, BY
2850 INPUT "Box width, height (inches) ";BWID, BHGT
2860 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, BX,BY,BWID,BHGT
2870 INPUT"Do you want annotation (Y/N) ";AT$
2880 IF AT$ <> "Y" AND AT$ <> "y" THEN AT$ = "N"
2890 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, AT$
2900 IF AT$ <> "Y" AND AT$ <> "y" THEN RETURN
2910 INPUT "Number of heading lines (0,1 or 2) ";NHD
2920 IF NHD =< 0 THEN NHD = 0
2930 IF NHD > 4 THEN 2910
2940 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, NHD
2950 NHD1 = NHD: IF NHD > 2 THEN NHD1 = NHD-2
2960 IF NHD = 0 THEN 3010
2970 FOR I = 1 TO NHD1
2980 PRINT "Heading, line #";I;:INPUT HED$(I)
2990 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, HED$(I)
3000 NEXT I
3010 INPUT"X Title ";XT$
3020 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, XT$
3030 INPUT"Y Title ";YT$
3040 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, YT$
3050 INPUT"Do you want a legend for each curve";LGQ$
3060 IF LGQ$ <> "Y" AND LGQ$ <> "y" THEN LGQ$ = "N"
3070 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, LGQ$
3080 RETURN
3090 I=1:REM READ ARRAY
3100 FOR LOOP=1 TO NCURVES
3110 II=1
3120 FOR LOOP2=1 TO NPOINTS
3130 X(I)=MATX(I):Y(I)=MATY(I)
3140 I=I+1:II=II+1
3150 NEXT LOOP2
3160 JF=JF+1
3170 NPP(JF)=II-1
3210 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, NPP(JF)
3220 PRINT"Curve #";JF;"line type ? 1 for line only"
3230 PRINT" 2 for line with symbols"
3240 PRINT" 3 for symbols only (scatter plot)"
3250 INPUT LN(JF)
3260 IF LN(JF) =< 0 THEN LN(JF) = 1
3270 IF LN(JF) > 3 THEN 3220
3280 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, LN(JF)
3290 IF LN(JF) = 1 THEN 3350
3300 PRINT"Which symbol ?"
3310 PRINT" 1 square; 2 plus(+); 3 cross(X); 4 triangle; 5 diamond"
3320 INPUT NS(JF)
3330 IF NS(JF) < 1 OR NS(JF) > 5 THEN 3300
3340 IF CC$ = "Y" OR CC$ = "y" THEN PRINT #2, NS(JF)
3350 PRINT
3360 IF LGQ$ <> "Y" AND LGQ$ <> "y" THEN 3380
3370 INPUT "Legend for this curve ";LG$(JF)
3380 CLS:NEXT LOOP
3450 RETURN
3460 REM FIND XMAX,MIN, YMAX,MIN
3470 PRINT"Finding maximum and minimum values"
3480 XMAX=-1E+20:YMAX=XMAX:XMIN=1E+20:YMIN=XMIN
3490 II = 0
3500 FOR J = 1 TO JF
3510 FOR I = 1 TO NPP(J)
3520 II = II + 1
3530 IF(X(II) > XMAX) THEN XMAX = X(II)
3540 IF(X(II) < XMIN) THEN XMIN = X(II)
3550 IF(Y(II) > YMAX) THEN YMAX = Y(II)
3560 IF(Y(II) < YMIN) THEN YMIN = Y(II)
3570 NEXT I : NEXT J
3580 PRINT"XMIN, XMAX ";XMIN;XMAX
3590 PRINT"YMIN, YMAX ";YMIN;YMAX
3600 RETURN
3610 REM READ COMMAND FILE
3620 FILES:PRINT:INPUT"COMMAND FILE NAME ";CF$
3630 OPEN "I", #2, CF$
3640 INPUT #2, QB$
3650 IF QB$ <> "Y" AND QB$ <> "y" THEN 3670
3660 INPUT #2, BX, BY, BWID, BHGT
3670 INPUT #2, AT$
3680 IF AT$ <> "Y" AND AT$ <> "y" GOTO 3770
3690 INPUT #2, NHD
3700 NHD1=NHD: IF NHD > 2 THEN NHD1=NHD-2
3710 IF NHD = 0 THEN 3740
3720 FOR I = 1 TO NHD1
3730 INPUT #2, HED$(I):PRINT HED$(I): NEXT I
3740 INPUT #2, XT$ :PRINT XT$
3750 INPUT #2, YT$:PRINT YT$
3760 INPUT #2, LGQ$
3770 II = 1
3780 JF = JF + 1
3790 INPUT #2, FIL$
3800 INPUT #2, NPP(JF)
3810 PRINT"Reading data file ";FIL$
3820 OPEN "I",#1,FIL$
3830 FOR I = 1 TO NPP(JF)
3840 INPUT # 1,X(II),Y(II)
3850 II = II + 1
3860 NEXT I
3870 PRINT NPP(JF);" .... lines read"
3880 INPUT #2, LN(JF)
3890 IF LN(JF) = 1 THEN 3910
3900 INPUT #2, NS(JF)
3910 CLOSE # 1
3920 IF LGQ$<>"Y" AND LGQ$<>"y" THEN 3940
3930 INPUT #2, LG$(JF): PRINT LG$(JF)
3940 INPUT #2, AN$
3950 IF AN$ = "Y" OR AN$ = "y" GOTO 3780
3960 INPUT #2, LX$
3970 INPUT #2, LY$
3980 IF LX$ <> "Y" AND LX$ <> "y" GOTO 4000
3990 INPUT #2, XMIN, XMAX, LGX, DECX: GOTO 4010
4000 INPUT #2, XMIN,XMAX,XDN
4010 IF LY$ <> "Y" AND LY$ <> "y" GOTO 4030
4020 INPUT #2, YMIN, YMAX, LGY, DECY: GOTO 710
4030 INPUT #2, YMIN,YMAX,YDN
4040 CLOSE #2: GOTO 710
4140 REM SQUARE SYSMBOL
4150 DRAW"BU3R3L6D6R6U6L3BD3"
4160 RETURN
4170 REM PLUS SYMBOL
4180 DRAW"U3D6U3R3L6R3"
4190 RETURN
4200 REM X SYMBOL
4210 DRAW"E3G6E3F3H6F3"
4220 RETURN
4230 REM TRIANGLE SYMBOL
4240 DRAW"BU3F6L12E6G6R12H6BD3"
4250 RETURN
4260 REM DIAMOND SYMBOL
4270 DRAW"BL4E4F4G4H4BR4"
4280 RETURN
4290 REM - HP PLOTTER
4300 REM CONVERT TO PLOTTER UNITS
4310 SZF = 1016
4320 IF QB$ = "Y" OR QB$ = "y" THEN 4380
4330 BWID = 7: BHGT = 5
4340 IXO=2000:IYO=1500:WID=BWID*SZF:HGT=BHGT*SZF
4350 IF NHD > 2 THEN IYO = 2200
4360 IF LGQ$="Y" OR LGQ$="y" THEN IXO = 1300
4370 GOTO 4390
4380 IXO=BX*SZF:IYO=BY*SZF:WID=BWID*SZF:HGT=BHGT*SZF
4390 IYM=IYO+HGT:IXM=IXO+WID
4400 IXOL=IXM+200: IYOL=IYO+500:DYOL=500:ELXL=IXOL+1500
4410 II = 0 : XTIC = 80: YTIC = 80
4420 FOR J = 1 TO JF
4430 IF LX$ = "Y" OR LX$ = "y" GOTO 4490
4440 FOR I = 1 TO NPP(J)
4450 II = II + 1
4460 X(II) = IXO + (X(II)-XMIN)*WID/XMXX
4470 NEXT I
4480 GOTO 4530
4490 FOR I = 1 TO NPP(J)
4500 II = II + 1
4510 X(II) = IXO + LOG(X(II)/XMIN)*WID/LGX
4520 NEXT I
4530 NEXT J
4540 II = 0
4550 FOR J = 1 TO JF
4560 IF LY$ = "Y" OR LY$ = "y" GOTO 4620
4570 FOR I = 1 TO NPP(J)
4580 II = II + 1
4590 Y(II) = IYO + (Y(II)-YMIN)*HGT/YMXX
4600 NEXT I
4610 GOTO 4660
4620 FOR I = 1 TO NPP(J)
4630 II = II + 1
4640 Y(II) = IYO + LOG(Y(II)/YMIN)*HGT/LGY
4650 NEXT I
4660 NEXT J
4670 REM INITIATE PLOTTER
4680 CLOSE #2
4690 OPEN "COM1:2400,N,8,1,RS,CS65535,DS65535,CD" AS #2
4700 CWS=.28:CHS=1.3*CWS: REM STDD. CHR. SIZE
4710 PRINT #2,CHR$(27);".(;DI;SL;SI";CWS,CHS";VS10;"
4720 BEEP: PRINT "Put in pen for grid: Press any key to continue"
4730 AA$ = INKEY$: IF AA$ = "" THEN 4730
4740 IF LX$ = "Y" OR LX$ = "y" GOTO 4920
4750 REM LINEAR X AXIS
4760 PRINT #2,"PU;PA";IXO,IYO";PD;PA"
4770 DX = WID/XDN
4780 XA = IXO: YA = IYO + XTIC
4790 FOR I = 1 TO XDN: XA = XA + DX
4800 PRINT #2,XA,IYO,XA,YA,XA,IYO
4810 NEXT I
4820 PRINT #2,";PU;PA";IXO,IYM";PD;PA"
4830 XA = IXO: YA = IYM-XTIC
4840 FOR I = 1 TO XDN: XA = XA + DX
4850 PRINT #2,XA,IYM,XA,YA,XA,IYM
4860 NEXT I: PRINT #2,";PU;"
4870 REM VERTICAL LINE AT X = 0
4880 IF XMIN >= 0 OR XMAX <= 0 GOTO 5050
4890 XB = IXO-WID*XMIN/XMXX
4900 PRINT #2,"PA";XB,IYO";PD;PA";XB,IYM";PU;"
4910 GOTO 5050
4920 REM LOG X AXIS
4930 PRINT #2,"PU;PA";IXO,IYO";PD;PA"
4940 DX = WID/DECX: XA=IXO: YA = IYO+XTIC
4950 FOR I = 1 TO DECX: FOR J = 2 TO 10
4960 XAA= XA+DX*LOG(J)/LG10
4970 PRINT #2,XAA,IYO,XAA,YA,XAA,IYO
4980 NEXT J: XA=XAA: NEXT I
4990 PRINT #2,";PU;PA";IXO,IYM";PD;PA"
5000 XA = IXO: YA = IYM-XTIC
5010 FOR I = 1 TO DECX: FOR J = 2 TO 10
5020 XAA=XA+DX*LOG(J)/LG10
5030 PRINT #2,XAA,IYM,XAA,YA,XAA,IYM
5040 NEXT J: XA = XAA: NEXT I
5050 IF LY$ = "Y" OR LY$ = "y" GOTO 5230
5060 REM LINEAR Y AXIS
5070 PRINT #2,";PU;PA";IXO,IYO";PD;PA"
5080 DY = HGT/YDN
5090 XA = IXO+YTIC: YA = IYO
5100 FOR I = 1 TO YDN: YA = YA + DY
5110 PRINT #2,IXO,YA,XA,YA,IXO,YA
5120 NEXT I
5130 PRINT #2,";PU;PA";IXM,IYO";PD;PA"
5140 XA = IXM-YTIC: YA = IYO
5150 FOR I = 1 TO YDN: YA = YA + DY
5160 PRINT #2,IXM,YA,XA,YA,IXM,YA
5170 NEXT I: PRINT #2,";PU;"
5180 REM HORIZONTAL LINE AT Y = 0
5190 IF YMIN >= 0 OR YMAX <= 0 GOTO 5360
5200 YB = IYO-HGT*YMIN/YMXX
5210 PRINT #2,"PA";IXO,YB";PD;PA";IXM,YB";PU;"
5220 GOTO 5360
5230 REM LOG Y AXIS
5240 PRINT #2,";PU;PA";IXO,IYO";PD;PA"
5250 DY = HGT/DECY: XA=IXO+YTIC: YA = IYO
5260 FOR I = 1 TO DECY: FOR J = 2 TO 10
5270 YAA= YA+DY*LOG(J)/LG10
5280 PRINT #2,IXO,YAA,XA,YAA,IXO,YAA
5290 NEXT J: YA=YAA: NEXT I
5300 PRINT #2,";PU;PA";IXM,IYO";PD;PA"
5310 XA = IXM-YTIC: YA = IYO
5320 FOR I = 1 TO DECY: FOR J = 2 TO 10
5330 YAA=YA+DY*LOG(J)/LG10
5340 PRINT #2,IXM,YAA,XA,YAA,IXM,YAA
5350 NEXT J: YA = YAA: NEXT I
5360 REM PLOT CURVES
5370 II = 0: PRINT #2,";PU;"
5380 FOR J = 1 TO JF
5390 BEEP:PRINT "Change pen for next curve: Press any key to continue"
5400 AA$ = INKEY$: IF AA$ = "" THEN 5400
5410 II = II + 1
5420 IF LN(J) = 3 THEN 5670
5430 REM LINE ONLY
5440 PRINT #2,";PU;PA";X(II),Y(II)
5450 PRINT #2,";PD;PA"
5460 FOR I = 2 TO NPP(J)
5470 II = II + 1
5480 PRINT #2, X(II),Y(II)
5490 NEXT I
5500 PRINT #2,";PU;"
5510 IF LN(J) = 1 THEN 5760
5520 REM LINE WITH SYMBOLS
5530 NPS=INT(NPP(J)/8): IF NPS=0 THEN NPS = 1
5540 II = II - NPP(J) + 1
5550 PRINT #2,";PU;PA";X(II),Y(II)
5560 NPD = 0 : IF NPS > 1 THEN 5580
5570 ON NS(J) GOSUB 6790,6820,6850,6880,6910
5580 FOR I = 2 TO NPP(J)
5590 II = II + 1: NPD = NPD + 1
5600 IF NPD < NPS THEN 5640
5610 PRINT #2, ";PA";X(II),Y(II)
5620 ON NS(J) GOSUB 6790,6820,6850,6880,6910
5630 NPD = 0
5640 NEXT I
5650 PRINT #2,";PU;"
5660 GOTO 5760
5670 REM SYMBOLS ONLY
5680 PRINT #2,";PU;PA";X(II),Y(II);";PA"
5690 ON NS(J) GOSUB 6790,6820,6850,6880,6910
5700 FOR I = 2 TO NPP(J)
5710 II = II + 1
5720 PRINT #2, ";PA";X(II),Y(II)
5730 ON NS(J) GOSUB 6790,6820,6850,6880,6910
5740 NEXT I
5750 PRINT #2,";PU;"
5760 REM WRITE LEGEND
5770 IF LGQ$<>"Y" AND LGQ$<>"y" THEN 5910
5780 CW=.2:CH=CW*1.3:PRINT #2,";SI";CW,CH";"
5790 ON LN(J) GOTO 5800,5800,5820
5800 PRINT #2,";PA";IXOL,IYOL";PD;PA";ELXL,IYOL";PU;"
5810 IF LN(J) = 1 THEN 5890
5820 PRINT #2,";PA";IXOL,IYOL";"
5830 ON NS(J) GOSUB 6790,6820,6850,6880,6910
5840 MXOL = (IXOL + ELXL)/2
5850 PRINT #2,";PA";MXOL,IYOL";"
5860 ON NS(J) GOSUB 6790,6820,6850,6880,6910
5870 PRINT #2,";PA";ELXL,IYOL";"
5880 ON NS(J) GOSUB 6790,6820,6850,6880,6910
5890 PRINT #2,";PU;PA";IXOL,IYOL+150";LB";LG$(J);CHR$(3)
5900 IYOL = IYOL + DYOL
5910 NEXT J
5920 REM ANNOTATION
5930 IF AT$ <> "Y" AND AT$ <> "y" GOTO 6770
5940 IF NHD > 2 THEN 5980
5950 YHED(1)=IYM+800: YHED(2)=IYM+400
5960 IF NHD = 2 THEN 5990
5970 YHED(1)=IYM+400: GOTO 5990
5980 YHED(1)=IYO-1500: YHED(2)=IYO-1900: NHD1=NHD-2
5990 BEEP:PRINT "Change pen for annotation: Press any key to continue"
6000 AA$ = INKEY$: IF AA$ = "" THEN 6000
6010 PRINT #2,";SI";CWS,CHS";"
6020 IF LGQ$<>"Y" AND LGQ$<>"y" THEN 6040
6030 PRINT #2,";PA";IXOL,IYOL";LBLEGEND";CHR$(3)
6040 WDL = 1.5*CWS/.0025: IF NHD1=0 THEN 6100
6050 FOR I = 1 TO NHD1
6060 DIS = .5*(WID-LEN(HED$(I))*WDL)
6070 XHED = DIS+IXO-WDD/2
6080 PRINT #2,";PU;PA";XHED,YHED(I)";LB"HED$(I);CHR$(3)
6090 NEXT I
6100 DIS=.5*(WID-LEN(XT$)*WDL):XXL=DIS+IXO-WDD/2: YXL=IYO-900
6110 PRINT #2,";PU;PA";XXL,YXL";LB"XT$;CHR$(3)
6120 CW2 = .24: CH2 = 1.3*CW2: WD2 = 1.5*CW2/.0025
6130 IF LX$="Y" OR LX$="y" GOTO 6360
6140 PRINT #2,";SI";CW2,CH2";"
6150 VMIN=XMIN: VMAX=XMAX: DN=XDN: GOSUB 6940
6160 DX=WID/XDN: XO=IXO-120-DX: YO=IYO-300
6170 XWR = VMIN-SNUM
6180 FOR I=1 TO XDN+1: XO=XO+DX: XWR=XWR+SNUM
6190 ST$ = STR$(XWR): AWR = ABS(XWR)
6200 IF LEN(ST$)>6 THEN ST$=LEFT$(ST$,6)
6210 IF AWR < 1 AND AWR > 0 THEN 6230
6220 GOTO 6260
6230 ST$ = MID$(ST$,2)
6240 IF XWR > 0 THEN ST$ = "0"+ST$
6250 IF XWR < 0 THEN ST$ = "-0"+ST$
6260 WRL=LEN(ST$) - 1
6270 DWR=.5*WRL*WD2:IF XWR<0 THEN DWR=DWR-WD2
6280 XOO=XO-DWR:IF I=1 THEN XOS=XOO
6290 PRINT #2,";PA";XOO,YO";LB"ST$;CHR$(3): NEXT I
6300 IF KK = 0 THEN 6440
6310 XO = IXO+.8*WID: YO = IYO - 550
6320 ST$=STR$(KK):IF KK>0 THEN ST$=MID$(ST$,2)
6330 ST$ = "X10**"+ST$
6340 PRINT #2,";SI";CWS,CHS";PA";XO,YO";LB"ST$;CHR$(3)
6350 GOTO 6440
6360 DX=WID/DECX:XO=IXO-200-DX:YO=IYO-350
6370 XOS = IXO - 250
6380 FOR I=1 TO DECX+1: XO=XO+DX
6390 PRINT #2,"PA";XO,YO";LB10";CHR$(3):NEXT I
6400 CW=.18:CH=CW*1.3:XO=IXO-DX+50:YO=IYO-150
6410 IEX=INT(LOG(XMIN)/LG10)-1:PRINT #2,";SI";CW,CH";"
6420 FOR I = 1 TO DECX+1: XO=XO+DX:IEX=IEX+1
6430 PRINT #2,";PA";XO,YO";LB";IEX;CHR$(3):NEXT I
6440 DIS=.5*(HGT-LEN(YT$)*WDL):YXL=DIS+IYO-WDD/2
6450 XXL=IXO-1000 :PRINT #2,";DI0,1;SI";CWS,CHS";"
6460 PRINT #2,";PU;PA";XXL,YXL";LB"YT$;CHR$(3)
6470 IF LY$="Y" OR LY$="y" GOTO 6700
6480 PRINT #2,";SI";CW2,CH2";"
6490 VMIN=YMIN: VMAX=YMAX: DN=YDN: GOSUB 6940
6500 DY=HGT/YDN: XO=XOS-100: YO=IYO-DY-150
6510 YWR = VMIN-SNUM
6520 FOR I=1 TO YDN+1: YO=YO+DY: YWR=YWR+SNUM
6530 ST$ = STR$(YWR): AWR = ABS(YWR)
6540 IF LEN(ST$)>6 THEN ST$=LEFT$(ST$,6)
6550 IF AWR < 1 AND AWR > 0 THEN 6570
6560 GOTO 6600
6570 ST$ = MID$(ST$,2)
6580 IF YWR > 0 THEN ST$ = "0"+ST$
6590 IF YWR < 0 THEN ST$ = "-0"+ST$
6600 WRL=LEN(ST$) - 1
6610 DWR=.5*WRL*WD2: IF YWR
6630 PRINT #2,";PA";XO,YOO";LB"ST$;CHR$(3):NEXT I
6640 IF KK = 0 THEN 6770
6650 XO = XOS-350: YO = IYO+.8*HGT
6660 ST$=STR$(KK):IF KK>0 THEN ST$=MID$(ST$,2)
6670 ST$ = "X10**"+ST$
6680 PRINT #2,";PA";XO,YO";LB"ST$;CHR$(3)
6690 GOTO 6770
6700 DY=HGT/DECY:XO=IXO-600:YO=IYO-50-DY
6710 PRINT #2,";DI;":FOR I=1 TO DECY+1: YO=YO+DY
6720 PRINT #2,"PA";XO,YO";LB10";CHR$(3):NEXT I
6730 CW=.18:CH=CW*1.3:XO=IXO-350:YO=IYO+150-DY
6740 IEX=INT(LOG(YMIN)/LG10)-1:PRINT #2,";SI";CW,CH";"
6750 FOR I = 1 TO DECY+1: YO=YO+DY:IEX=IEX+1
6760 PRINT #2,";PA";XO,YO";LB";IEX;CHR$(3):NEXT I
6770 PRINT #2,";PU;DI;SI;SP0;PA16000,11400;";CHR$(27);".)"
6780 CLOSE #2: GOTO 2700
6790 REM SQUARE SYSMBOL
6800 PRINT #2,";PU;PR50,50;PD;PR-100,0,0,-100,100,0,0,100;PU;PR-50,-50;"
6810 RETURN
6820 REM PLUS SYMBOL
6830 PRINT #2,";PU;PR50,0;PD;PR-100,0;PU;PR50,-50;PD;PR0,100;PU;PR0,-50;"
6840 RETURN
6850 REM X SYMBOL
6860 PRINT #2,";PU;PR50,50;PD;PR-100,-100;PU;PR0,100;PD;PR100,-100;PU;PR-50,50;"
6870 RETURN
6880 REM TRIANGLE SYMBOL
6890 PRINT #2,";PU;PR0,50;PD;PR-50,-100,100,0,-50,100;PU;PR0,-50;"
6900 RETURN
6910 REM DIAMOND SYMBOL
6920 PRINT #2,";PU;PR0,70;PD;PR-70,-70,70,-70,70,70,-70,70;PU;PR0,-70;"
6930 RETURN
6940 REM FIND SNUM - INCREMENT
6950 AMAX=ABS(VMAX): AMIN=ABS(VMIN)
6960 KK=0: AVAL=AMAX
6970 IF AMIN > AMAX THEN AVAL=AMIN
6980 IF AVAL >= .001 AND AVAL < 1000 THEN 7100
6990 IF AVAL < .001 THEN 7050
7000 KK = 2
7010 AVAL = AVAL/10
7020 KK = KK + 1
7030 IF AVAL > 1000 THEN 7010
7040 GOTO 7090
7050 KK = -3
7060 AVAL = AVAL*10
7070 KK = KK - 1
7080 IF AVAL < .001 THEN 7060
7090 SF=10^KK:VMIN=VMIN/SF:VMAX=VMAX/SF
7100 SNUM=(VMAX-VMIN)/DN
7110 RETURN
7120 END SUB
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/