home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / graphics / basplot.lbr / PLOT02.BZS / PLOT02.BAS
BASIC Source File  |  1991-06-25  |  40KB  |  552 lines
  1. '                            <<<   PLOT02.BAS   >>>
  2.  
  3. ' Plotting program for HP7225, HP7475 and FACIT plotters. Televideo terminal.  This program is complimentary to
  4. ' programs PLOT.BAS, which does data entry and calculates spline functions coefficients and regression coeffici-
  5. ' ents, and to program PLOT01.BAS, which is for the Microangelo or GDC512 graphics cards.  This program was
  6. ' written by J. V. Brancik of Univ. N. S. W.
  7.  
  8. ' Dimensions
  9. ' ----------
  10. DIM X%(4),Z$(4),G%(12),XD(40),YD(40),X(400),Y(400),LIM(13),EX(40),EY(40)
  11. ' X%()=margins; Z$()=legends and title; G%()=flags; XD(),YD()=exptl data; X(),Y()=fnctn points; LIM()=lims;
  12. ' EX(),EY()=errors
  13.  
  14. ' Equates
  15. ' -------
  16. ' defaults: (in absolute plotter units)
  17. '           X%(0),X%(1)=left and right margins;
  18. '           X%(2),X%(3)=bottom and top margins;
  19. '           XSPAN,YSPAN=x and y span.
  20. ' limits:   (in user units where applicable)
  21. '           LIM(0),(1)=point where axis intersect (the origin);
  22. '           LIM(2)-(5)=Xmin,Xmax,Ymin,Ymax (for scaling);
  23. '           LIM(6),(7)=x and y axis divisions;
  24. '           LIM(8),(9)=f(x)min,f(x)max (real min and max of the function being plotted);
  25. '           LIM(10),(11)=x-tick % below and % above x-axis (% of XSPAN),
  26. '           LIM(12),(13)=y-tick % right and % left of y-axis(% of YSPAN)
  27. LIM(0)=0:LIM(1)=0:LIM(6)=10:LIM(7)=10:LIM(10)=.5:LIM(11)=.5:LIM(12)=.5:LIM(13)=.5:' default values
  28. MFX=1:MFY=1:' multiplication factors of x and y axis, respectively (valid for labels only)
  29. CFW=.55:CFH=1.15:' axis labels character width and heigth (as % of XSPAN or YSPAN)
  30. CLW=.55:CLH=1.15:' axis legend character width and height (as % of XSPAN or YSPAN)
  31. CTW=.55:CTH=1.15:' plot title and notes character width and height (as % of XSPAN or YSPAN)
  32. CMW=.55:CMH=1.15:' width and height of a character plotted as experimental point (% of XSPAN or YSPAN)
  33. HV=0:TJ=0:' direction HV=0 for horizontal or HV=1 for vertical x axis; plot title justification: 0=center or 1=left
  34.  
  35. STATP%=133:DATP%=132:CTCP%=137:' Status port, Data port, CTC port - Z80-SIO; change if needed
  36. '                                output routine for 8251 is also provided; comment out the one not required
  37.  
  38. GOTO 6000:' location of the MAIN section of this program from where the subroutines are called
  39.  
  40.  
  41. '                            SUBROUTINES SECTION
  42. '                            ===================
  43.  
  44. '    Subroutine to setup communication port and to setup plotter to X-on/X-off handshake
  45. '    (sbc512 board - you never heard of; status=133, data=132, CTC=137 - change if needed)
  46. '    Some explanatory notes:
  47. '    The first part of this subroutine is needed to change the baud rate for rather slow HP7225 plotter.
  48. '    The FACIT and the HP7475 can work quite comfortably at 9600 baud.  The port is Z80-SIO and only three
  49. '    wires are needed since only pins 2, 3, and 7 are used.  It should be noted that for HP pins 20, 8, 6 should
  50. '    be connected together at the plotter (and NOT connected to the computer).  If your system supports xon/xoff
  51. '    (CP/M 3) then this feature should be turned off (it could interfere as it does on mine).  For those with CP/M 2.2
  52. '    calls to PUN: and RDR: could be utilised - I would include them here if I knew how .....
  53. '
  54. '    WARNING: Comment out this section if your computer has different arrangement.  This was used for 6MHz sbc512, but
  55. '    do not despare - this sub is called just before the actual plotting takes place and if you intend to plot into a
  56. '    data file then only the second part is called.
  57. '
  58. 1000 IF PD%=1 THEN 1010:' if we are plotting to a data file and the commands below are not required
  59.      OUT(STATP%),24:OUT(STATP%),4:OUT(STATP%),68:OUT(CTCP%),71:' channel reset, 16x clock, async, 1 stop, data for CTC
  60.      IF FACIT=0 THEN OUT(CTCP%),16 ELSE OUT(CTCP%),4:' CTC divider, 2400/9600 baud (HP-7225/FACIT)
  61.      OUT(STATP%),3:OUT(STATP%),193:' 8 data, Rx enable, DCD/CTS inactive
  62.      OUT(STATP%),5:OUT(STATP%),104:' 8 data, Tx enable, DTR/RTS inactive
  63. '    here we send the setup command strings to the plotter
  64. 1010 IF PD%=0 THEN 1020 ELSE M%=3:N%=1:GOSUB 1110:M%=22:GOSUB 1120:INPUT"Include plotter setup commands (Y)";A$
  65.      IF A$="N" OR A$="n" THEN RETURN:' if setup strings are not required (for whatever reason)
  66. 1020 P$=CHR$(27)+".(":GOSUB 3050:' turn plotter on (playing safe, changing paper may turn it off)
  67.      P$=CHR$(27)+".@;0:":GOSUB 3050:' reset the plotter, cancell hardwire h/s (default is hardwire h/s for HP)
  68.      P$=CHR$(27)+".I80;;17:":GOSUB 3050:' set the plotter buffer treshold, set X-on/X-of protocol (X-on char)
  69.      P$=CHR$(27)+".N;19:":GOSUB 3050:' set X-off character (fill buffer if there is a space for 80 bytes)
  70.      RETURN:' all nicely in a file - can be coppied later to a plotter with no worries
  71.  
  72. '    Subroutines to control the screen (Televideo terminal)
  73. 1100 PRINT CHR$(27)CHR$(43):RETURN:' to clear the whole screen
  74. 1110 GOSUB 1130:PRINT CHR$(27)CHR$(89):GOSUB 1130:RETURN:' clear to the end of screen (foreground)
  75. 1120 GOSUB 1130:PRINT CHR$(27)CHR$(84):GOSUB 1130:RETURN:' to clear line at the cursor address
  76. 1130 PRINT CHR$(27)CHR$(61)CHR$(M%+31)CHR$(N%+31);:RETURN:' for direct cursor address
  77.  
  78. '    Subroutine repeat set-up/save set-up data/do the plot (called by all routines after completion of setup)
  79. 1200 M%=22:N%=1:GOSUB 1120:INPUT"Type R to repeat the routine, S to save the setup data, P to plot: ",A$:RETURN
  80.  
  81. '    Subroutine to do calls for the plotter setup
  82. '    calls to: 1100 - clear screen
  83. '              2000 - display (fancy) header for plotter setup
  84. '              2100 - change drawing area (area of actual x-y plot without text)
  85. '              2200 - change ploting limits (intersection of axis, axis divisions, grid or ticks, etc.)
  86. '              2300 - change labels, legends, title and explanatory notes (if any)
  87. '              2500 - change symbol for drawing experimental poins (including experimental error - if required)
  88. '              2600 - change line type (solid line, dashed or dotted or both, etc..)
  89. 1300 FOR W%=1 TO 7:ON W% GOSUB 1100,2000,2100,2200,2300,2500,2600:NEXT:RETURN
  90.  
  91. '    Subroutine to do calls for the plotting (user is prompted before each draw)
  92. '    calls to: 3010 - select output and pause before plot
  93. '              3000 - initialize the port (if required) and the plotter (if required)
  94. '              3300 - draw axis and labels (selection of pen)
  95. '              3500 - draw axis legend (selection of pen, justification)
  96. '              3600 - draw title and explanatory notes (selection of pen, justification)
  97. '              3700 - draw experimental points (selection of pen)
  98. '              3400 - draw function curve (selection of pen)
  99. '              3040 - home pen, close $PLOT.PLT (or user specified) file, reset flags
  100. '              4000 - repeat? chamge plotter? new data? exit?
  101. '              1100 - clear screen
  102. 1400 GOSUB 3010:GOSUB 3000:FOR W%=1 TO 5:ON W% GOSUB 3300,3500,3600,3700,3400:NEXT
  103.      GOSUB 3040:GOSUB 4000:GOSUB 1100:RETURN:' end of plot, park pen, close files/again? save? exit?/cls
  104.  
  105. '                       Subroutines to handle the data
  106. '                       ------------------------------
  107.  
  108. '    Subroutine to open a file for random access; F$=filename, FL%=rec. length, R$=rec. string,
  109. 1500 OPEN"R",#1,F$,FL%:FIELD#1,FL% AS R$:RETURN
  110.  
  111. '    Subroutine to read experimental data file
  112. 1510 FOR J%=1 TO G%(4+SET%):GET#1,2*J%-1+SET%*80:XD(J%)=CVS(R$):GET#1,2*J%+SET%*80:YD(J%)=CVS(R$):NEXT:CLOSE:RETURN
  113.  
  114. '    Subroutine to read all experimental points errors
  115. 1520 FOR J%=1 TO G%(4+SET%):GET#1,2*J%-1+SET%*80:EX(J%)=CVS(R$):GET#1,2*J%+SET%*80:EY(J%)=CVS(R$):NEXT:CLOSE:RETURN
  116.  
  117. '    Subroutine to write and read the info file (PLOT.FLG)
  118. 1530 GET#1,1:G%(0)=CVI(R$):FOR I%=1 TO G%(0):GET#1,I%+1:G%(I%)=CVI(R$):NEXT:CLOSE
  119.      IF G%(1)=1 THEN H$="Plot experimental points.":F2$="<data set no.:"
  120.      IF G%(1)=2 THEN H$="Spline functions plot.":F2$="<"
  121.      IF G%(1)=3 THEN H$="Plot linear regression.":F2$="<model no.:"
  122.      IF G%(1)=4 THEN H$="Plot user defined function.":F2$="<data set no.:"
  123.      RETURN:' returns flag values and the strings for the header
  124. 1540 FOR I%=0 TO 11:G%(I%)=0:LSET R$=MKI$(G%(I%)):PUT#1,I%+1:NEXT:CLOSE:RETURN:' to write the data
  125.  
  126. '    Subroutine to read points for functions to be plotted
  127. 1550 FOR J%=1 TO 400:GET#1,J%:X(J%)=CVS(R$):K%=J%+400*(SET%+1):GET#1,K%:Y(J%)=CVS(R$):NEXT:CLOSE:RETURN:' read F(x,y)
  128.  
  129. '    Subroutine to calculate minimum and maximum of experimental points (just for the convenience of the user)
  130. 1600 LIM(2)=XD(1):LIM(3)=XD(1):LIM(4)=YD(1):LIM(5)=YD(1):FOR J%=1 TO G%(4+SET%):' set initial values
  131.      IF XD(J%)<=LIM(2) THEN LIM(2)=XD(J%) ELSE IF XD(J%)>=LIM(3) THEN LIM(3)=XD(J%):' search for xmin and xmax
  132.      IF YD(J%)<=LIM(4) THEN LIM(4)=YD(J%) ELSE IF YD(J%)>=LIM(5) THEN LIM(5)=YD(J%):' search for ymin and ymax
  133.      NEXT:DX=LIM(3)-LIM(2):DY=LIM(5)-LIM(4):RETURN
  134.  
  135. '    Subroutine to calculate minima and maxima of functions (just for the convenience of the user)
  136. 1610 LIM(8)=Y(1):LIM(9)=Y(1):FOR J%=1 TO 400:' set initial values
  137.      IF Y(J%)<=LIM(8) THEN LIM(8)=Y(J%) ELSE IF Y(J%)>=LIM(9) THEN LIM(9)=Y(J%):' search for F(x)min and F(x)max
  138.      NEXT:RETURN
  139.  
  140. '    Subroutine to calculate absolute units from the user units (x-axis horizontal - so called landscape)
  141. '    The user units are in variables P (x-value) and Q (y-value) and the plotter absolute units are in variables
  142. '    X (x-value) and Y (y-value)
  143. 1620 X=X%(0)+((P-LIM(2))/DX)*XSPAN:Y=X%(2)+((Q-LIM(4))/DY)*YSPAN:X$=STR$(X):Y$=STR$(Y):RETURN
  144.  
  145. '    Subroutine to calculate absolute units from user units (x-axis vertical - so called portrait)
  146. '    The user units are in variables P (x-value) and Q (y-value) and the plotter absolute units are in variables
  147. '    X (x-value) and Y (y-value)
  148. 1630 X=X%(0)+(1-(Q-LIM(4))/DY)*XSPAN:Y=X%(2)+((P-LIM(2))/DX)*YSPAN:X$=STR$(X):Y$=STR$(Y):RETURN
  149.  
  150. '    Subroutine to lower the pen at given coordinates
  151. 1700 P$="PA"+X$+","+Y$+";PD;":RETURN
  152.  
  153. '    Subroutine to draw a vector (line) from current position to given coordinates
  154. 1710 P$="PA"+X$+","+Y$+";":RETURN
  155.  
  156. '    Subroutine to read the limits
  157. 1800 F1$="set limits":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=22:N%=1
  158. 1810 GOSUB 1120:INPUT"Type K to use keyboard, D data-file for plotter set-up: ",A$
  159.      IF A$="K" THEN RETURN ELSE IF A$="D" THEN 1820 ELSE 1810
  160. 1820 GOSUB 1120:LINE INPUT"Filename is ";F$:IF F$="" THEN F$="PLOT0"+MID$(STR$(G%(1)),2,1)+".SET"
  161.      FL%=40:GOSUB 1500:GET#1,SET%+1:Q$=R$:FOR J%=0 TO 9:LIM(J%)=CVS(MID$(Q$,1+4*J%,4)):NEXT:CLOSE:RETURN
  162.  
  163. '    Subroutine to record plotting data limits (default file PLOT??.SET)
  164. 1830 M%=22:N%=1:GOSUB 1120:LINE INPUT"Filename is ";F$:IF F$="" THEN F$="PLOT0"+MID$(STR$(G%(1)),2,1)+".SET"
  165.      FL%=40:GOSUB 1500:Q$="":FOR J%=0 TO 9:Q$=Q$+MKS$(LIM(J%)):NEXT:LSET R$=Q$:PUT#1,SET%+1:CLOSE:RETURN
  166.  
  167. '             Subroutines to setup the data for plot enhancement
  168. '             --------------------------------------------------
  169.  
  170. '    Subroutine to display (fancy) header and the number of the data set in use (useful)
  171. 2000 M%=1:N%=1:GOSUB 1120:PRINT"<"+F1$+">":' show the menu in use
  172.      N%=40-LEN(H$)/2:GOSUB 1120:PRINT H$:' show the plot option
  173.      N%=77-LEN(F2$+STR$(SET%+1)+">"):GOSUB 1120:PRINT F2$;STR$(SET%+1);">":' show the set no.
  174.      M%=2:N%=1:GOSUB 1120:PRINT STRING$(77,61):RETURN
  175.  
  176. '    Subroutine to display and change the drawing area
  177. 2100 F1$="set drawing area":GOSUB 2000:M%=4:N%=1:GOSUB 1130:' display header and print some notes
  178.      PRINT"All the text (incl. labels) is outside the drawing area indicated"
  179.      M%=5:N%=1:GOSUB 1130:PRINT"The total graphics area is 285.5 x 203.5mm"
  180.      M%=6:GOSUB 1130:PRINT"Suggested plotting areas are as follows:"
  181.      M%=8:N%=1:GOSUB 1130:PRINT"------------------------------------------------------"
  182.      M%=9:N%=1:GOSUB 1130:PRINT"        |  x-axis (as on Hewlett-Packard)   | default"
  183.      M%=10:N%=1:GOSUB 1130:PRINT"margins | horizontal | vertical | vertical* |   set"
  184.      M%=11:N%=1:GOSUB 1130:PRINT"------------------------------------------------------"
  185.      M%=12:N%=1:GOSUB 1130:PRINT"left        55.50       40.00      31.25     "
  186.      M%=13:N%=1:GOSUB 1130:PRINT"right       40.00       55.50     134.375    "
  187.      M%=14:N%=1:GOSUB 1130:PRINT"bottom      41.00       41.00      37.50     "
  188.      M%=15:N%=1:GOSUB 1130:PRINT"top         20.00       20.00      40.625    "
  189.      M%=16:N%=1:GOSUB 1130:PRINT"                    default plotting area is "
  190.      M%=17:N%=1:GOSUB 1130:PRINT"note:"
  191.      M%=18:N%=1:GOSUB 1130:PRINT"      all values in mm"
  192.      M%=19:N%=1:GOSUB 1130:PRINT"      *) suitable for daisy-wheel printer (text) and plot together"
  193. 2105 FOR I%=0 TO 3:M%=12+I%:N%=50:GOSUB 1120:PRINT X%(I%)*.025:NEXT:M%=16:GOSUB 1120:PRINT XSPAN*.025;" x";YSPAN*.025
  194. 2110 N%=1:M%=22:GOSUB 1120:INPUT"OK (Y/N)";A$:' setting of the drawing area of the plotter
  195.      IF A$="Y" THEN 2160 ELSE IF A$="N" THEN 2120 ELSE 2110
  196. 2120 FOR I%=0 to 3:M%=12+I%:MRGN=X%(I%)*.025:N%=50+LEN(STR$(MRGN)):GOSUB 1120:INPUT A$
  197.      IF A$<>"" THEN X%(I%)=VAL(A$)/.025
  198.      NEXT:GOSUB 2160:GOTO 2105
  199. '    the FACIT platten is 10880x7640 absolute plotter units while the Hewlett-Packard is 11420x8140.  Change to suit.
  200. 2160 IF FACIT=0 THEN XSPAN=11420-X%(0)-X%(1):YSPAN=8140-X%(2)-X%(3):FX=XSPAN/11420:FY=YSPAN/8140:RETURN
  201.      XSPAN=10880-X%(0)-X%(1):YSPAN=7640-X%(2)-X%(3):FX=XSPAN/10880:FY=YSPAN/7640:RETURN
  202.  
  203. '    Subroutine to display and change plotting limits
  204. 2200 F1$="set limits":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=4:N%=3:GOSUB 1130:PRINT"Axis intersect at X ="
  205.      M%=5:N%=21:GOSUB 1130:PRINT"Y =":M%=6:N%=16:GOSUB 1130:PRINT"X(MIN) =":M%=7:GOSUB 1130:PRINT"X(MAX) ="
  206.      M%=8:GOSUB 1130:PRINT"Y(MIN) =":M%=9:GOSUB 1130:PRINT"Y(MAX) =":M%=10:N%=8:GOSUB 1130:PRINT STRING$(62,45)
  207.      M%=11:N%=6:GOSUB 1130:PRINT"X-axis divisions =":M%=12:GOSUB 1130:PRINT"Y-axis divisions =":M%=13:N%=8:GOSUB 1130
  208.      PRINT STRING$(62,45):M%=14:N%=16:GOSUB 1130:PRINT"F(MIN) =":M%=15:GOSUB 1130:PRINT"F(MAX) =":M%=16:N%=8
  209.      GOSUB 1130:PRINT STRING$(62,45):M%=17:N%=1:GOSUB 1130:PRINT"X-axis tick (% above) =":M%=18:N%=13:GOSUB 1130
  210.      PRINT"(% below) =":M%=19:N%=1:GOSUB 1130:PRINT"Y-axis tick (% right) =":M%=20:N%=14:GOSUB 1130
  211.      PRINT"(% left) =":' end of text display
  212.      N%=24:FOR I%=0 TO 13:M%=I%-4*(I%<6)+5*(I%=>6)*(I%<8)+6*(I%=>8)*(I%<10)-7*(I%=>10):' display values
  213.      GOSUB 1120:PRINT LIM(I%):NEXT:' end of display of current values of limits
  214. 2210 N%=1:M%=22:GOSUB 1130:INPUT"OK (Y/N)";A$:' all limits ok?
  215.      IF A$="N"THEN 2220 ELSE IF A$="Y"THEN 2250 ELSE GOSUB 1120:GOTO 2210:' on Y correct the range, ret
  216. 2220 N%=24:FOR I%=0 TO 13:M%=I%-4*(I%<6)+5*(I%=>6)*(I%<8)+6*(I%=>8)*(I%<10)-7*(I%=>10):IF I%=8 OR I%=9 THEN 2240
  217. 2230 GOSUB 1120:PRINT LIM(I%);:INPUT;A$:IF A$="" THEN 2240:' cr/lf means no change
  218.      LIM(I%)=VAL(A$):GOTO 2230:' change the value and go back to display it (and ok'it)t 
  219. 2240 NEXT:N%=1:M%=22:GOSUB 1120:GOTO 2210:' end of display and change limits subroutine
  220. 2250 DX=LIM(3)-LIM(2):DY=LIM(5)-LIM(4):RETURN
  221.  
  222. '    Subroutine to display and change labels, legends, and title
  223. 2300 F1$="set labels":GOSUB 2000:' display the header
  224.      M%=4:N%=1:GOSUB 1110:PRINT"        Multiplication factor, x-axis is";MFX
  225.      M%=5:GOSUB 1120:PRINT"                               y-axis is";MFY
  226.      M%=7:GOSUB 1120:PRINT"           x-axis is (horiz.=0, vert.=1)";HV
  227.      M%=9:GOSUB 1120:PRINT"Label char. size width  (% of x-span) is";CFW
  228.      M%=10:GOSUB 1120:PRINT"                 height (% of y-span) is";CFH
  229.      M%=22:GOSUB 1110:INPUT"OK (Y)?",A$:IF A$="N" or A$="n" THEN 2310 ELSE 2320
  230. 2310 M%=4:N%=41+LEN(STR$(MFX)):GOSUB 1120:INPUT A$:IF A$<>"" THEN MFX=VAL(A$)
  231.      M%=5:N%=41+LEN(STR$(MFY)):GOSUB 1120:INPUT A$:IF A$<>"" THEN MFY=VAL(A$)
  232.      M%=7:N%=41+LEN(STR$(HV)):GOSUB 1120:INPUT A$:IF A$<>"" THEN HV=VAL(A$)
  233.      M%=9:N%=41+LEN(STR$(CFW)):GOSUB 1120:INPUT A$:IF A$<>"" THEN CFW=VAL(A$)
  234.      M%=10:N%=41+LEN(STR$(CFH)):GOSUB 1120:INPUT A$:IF A$<>"" THEN CFH=VAL(A$)
  235.      GOTO 2300
  236. 2320 F1$="set legends":GOSUB 2000
  237.      M%=4:N%=1:GOSUB 1110:PRINT"                     Legend for x-axis is":M%=5:GOSUB 1120:PRINT XX$
  238.      M%=7:GOSUB 1120:PRINT"                     Legend for y-axis is":M%=8:GOSUB 1120:PRINT YY$
  239.      M%=10:GOSUB 1120:PRINT"Legend char. size width  (% of x-span) is";CLW
  240.      M%=11:GOSUB 1120:PRINT"                  height (% of y-span) is";CLH
  241.      M%=22:GOSUB 1110:INPUT"OK (Y)";A$:IF A$="N" or A$="n" THEN 2330 ELSE 2340
  242. 2330 M%=4:N%=43:GOSUB 1120:INPUT" [OK (Y)]";A$:IF A$="" THEN 2331 ELSE M%=22:N%=1:GOSUB 1120:LINE INPUT"->";XX$
  243.      M%=5:N%=1:GOSUB 1120:PRINT XX$:GOTO 2330
  244. 2331 M%=7:N%=43:GOSUB 1120:INPUT" [OK (Y)]";A$:IF A$="" THEN 2332 ELSE M%=22:N%=1:GOSUB 1120:LINE INPUT"->";YY$
  245.      M%=8:N%=1:GOSUB 1120:PRINT YY$:GOTO 2331
  246. 2332 M%=10:N%=43+LEN(STR$(CLW)):GOSUB 1120:INPUT A$:IF A$="" THEN 2333 ELSE CLW=VAL(A$)
  247. 2333 M%=11:N%=43+LEN(STR$(CLH)):GOSUB 1120:INPUT A$:IF A$="" THEN 2320 ELSE CLW=VAL(A$):GOTO 2320
  248. 2340 F1$="set title":GOSUB 2000:M%=4:N%=1:GOSUB 1110:PRINT"Title of the graph is"
  249.      IF G%(1)=3 THEN OPEN"I",#1,"PLOT03.DOC":GOSUB 2380:Z$(0)=Z$(4)
  250.      M%=5:GOSUB 1120:PRINT Z$(0):IF HV=1 THEN 2341 ELSE 2342:' vertical plot can have an additional note
  251. 2341 M%=7:GOSUB 1120:PRINT"Additional note has three lines.  The first line is":M%=8:GOSUB 1120:PRINT Z$(1)
  252.      M%=9:GOSUB 1120:PRINT"The second line is":M%=10:GOSUB 1120:PRINT Z$(2):M%=11:GOSUB 1120:PRINT"The third line is"
  253.      M%=12:GOSUB 1120:PRINT Z$(3)
  254. 2342 M%=14:GOSUB 1120:PRINT"   Title char. size width  (% of x-span) is";CTW
  255.      M%=15:GOSUB 1120:PRINT"                    height (% of y-span) is";CTH
  256.      M%=16:GOSUB 1120:PRINT"Title justification is (left=0, centered=1)";TJ
  257.      M%=22:N%=1:GOSUB 1120:INPUT"OK (Y)";A$:IF A$="N" or A$="n" THEN 2350 ELSE RETURN
  258. 2350 M%=4:N%=23:GOSUB 1120:INPUT"[OK (Y)]";A$:IF A$="" THEN 2351 ELSE M%=22:N%=1:GOSUB 1120:LINE INPUT"->";Z$(0)
  259.      M%=5:N%=1:GOSUB 1120:PRINT Z$(0):GOTO 2350:' write over the old title text
  260. 2351 IF HV=1 THEN 2352 ELSE 2360:' switch for vertical or horizontal x-axis (as for number of note lines)
  261. 2352 M%=7:N%=53:GOSUB 1120:INPUT"[OK (Y)]";A$:IF A$="" THEN 2353 ELSE M%=22:N%=1:GOSUB 1120:LINE INPUT"->";Z$(1)
  262.      M%=8:N%=1:GOSUB 1120:PRINT Z$(1):GOTO 2352:' write new text over the old one
  263. 2353 M%=9:N%=20:GOSUB 1120:INPUT"[OK (Y)]";A$:IF A$="" THEN 2354 ELSE M%=22:N%=1:GOSUB 1120:LINE INPUT"->";Z$(2)
  264.      M%=10:N%=1:GOSUB 1120:PRINT Z$(2):GOTO 2353:' write new text over the old one
  265. 2354 M%=11:N%=21:GOSUB 1120:INPUT"[OK (Y)]";A$:IF A$="" THEN 2360 ELSE M%=22:N%=1:GOSUB 1120:line INPUT"->";Z$(3)
  266.      M%=12:N%=1:GOSUB 1120:PRINT Z$(3):GOTO 2354:' write new text over the old one
  267. 2360 M%=14:N%=45+LEN(STR$(CTW)):GOSUB 1120:INPUT A$:IF A$<>"" THEN CTW=VAL(A$)
  268.      M%=15:N%=45+LEN(STR$(CTH)):GOSUB 1120:INPUT A$:IF A$<>"" THEN CTH=VAL(A$)
  269.      M%=16:N%=45+LEN(STR$(TJ)):GOSUB 1120:INPUT A$:IF A$<>"" THEN TJ=VAL(A$)
  270.      GOTO 2340:' repeat the routine using the new data
  271. 2380 FOR I%=1 TO 8:INPUT#1,A$:IF SET%+1=I% THEN Z$(4)=A$:' susub to read regression models data strings
  272.      NEXT:CLOSE:RETURN
  273.  
  274. '    Subroutine to display and change symbol for drawing of experimental points errors
  275. 2500 F1$="error symbol set":GOSUB 2000:era=0:M%=3:N%=1:GOSUB 1110:'display the header and clear the screen
  276.      M%=4:N%=1:GOSUB 1120:INPUT"When drawing experimental points, include rel. error (N)";A$
  277.      IF A$="Y" or A$="y" THEN 2510 ELSE 2550
  278. 2510 ERA=1:M%=6:GOSUB 1130:PRINT"The error can be entered as an average error of the set, or as"
  279.      M%=7:GOSUB 1130:PRINT" error of each individual point."
  280. 2520 M%=9:GOSUB 1120:INPUT"Type 0 for average, 1 for individual errors: ",A$:IF VAL(A$)<>0 and VAL(A$)<>1 THEN 2520
  281.      IF VAL(A$)=0 THEN 2530 ELSE 2540
  282. 2530 M%=11:N%=1:GOSUB 1130:INPUT"Average rel. error of x-values is ",EX(0):' as percentage
  283.      M%=12:N%=1:GOSUB 1130:INPUT"Average rel. error of y-values is ",EY(0):' as percentage
  284.      FOR I%=1 TO G%(4+SET%):EX(I%)=EX(0):EY(I%)=EY(0):NEXT:RETURN:' all error are the same
  285. 2540 M%=11:N%=1:GOSUB 1130:LINE INPUT"The name of data file containing error values is",A$
  286.      IF A$="" THEN GOSUB 1110:GOTO 2500:' start the routine again when at loss
  287.      F$=A$:FL%=4:GOSUB 1500:GOSUB 1520:RETURN:' get individual errors from a file
  288. 2550 M%=4:N%=1:GOSUB 1110:M%=6:GOSUB 1130:INPUT"Symbol for the points: ",A$:IF A$="" THEN 2550 ELSE SM=ASC(A$)
  289. 2560 M%=8:N%=1:GOSUB 1120:PRINT"Char. size, width  (% x-span): ";CMW;:INPUT;A$
  290.      IF A$="" THEN 2570 ELSE CMW=VAL(A$):GOTO 2560
  291. 2570 M%=9:N%=1:GOSUB 1120:PRINT"Char. size, height (% x-span): ";CMH;:INPUT;A$
  292.      IF A$="" THEN 2580 ELSE CMH=VAL(A$):GOTO 2570
  293. 2580 M%=22:N%=1:GOSUB 1120:INPUT"OK (Y)";A$:IF A$="N" or A$="n" THEN 2250 ELSE RETURN
  294.  
  295. '    Subroutine to display and change line types and pen velocity
  296. 2600 F1$="line type set":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=5:GOSUB 1130
  297.      PRINT"Line types that can be used to plot functions:"
  298.      M%=7:N%=8:GOSUB 1130:PRINT"Solid line (type 0)":M%=8:GOSUB 1130:PRINT"Dotted line (type 1)"
  299.      M%=9:GOSUB 1130:PRINT"Dashed line (type 2)":M%=10:GOSUB 1130:PRINT"Dotted/dashed line (type 3)"
  300. 2610 M%=12:N%=1:GOSUB 1120:INPUT"Line type";A$:IF A$="" THEN 2610 ELSE LT=VAL(A$)
  301.      IF LT<0 OR LT>3 THEN 2610 ELSE IF LT=3 THEN LT=5:' our pattern no. 3 is HP pattern no. 5!
  302.      IF LT>0 THEN 2620 ELSE LT$="LT;":GOTO 2630:' solid line (no parameters)
  303. 2620 M%=14:N%=1:GOSUB 1120:INPUT"Pattern length (default is 4% of x-span)";A$
  304.      IF A$="" THEN PL=4 ELSE PL=VAL(A$)
  305.      IF PL<1 OR PL>60 THEN 2620 ELSE LT$="LT"+STR$(LT)+","+STR$(PL)+";"
  306. 2630 F1$="pen velocity set":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=5:GOSUB 1130
  307.      PRINT"Pen velocity settings":M%=7:N%=8:GOSUB 1130:PRINT"1. Low velocity (ink pen)":M%=9:GOSUB 1130
  308.      PRINT"2. Medium velocity (fiber pen)":M%=11:GOSUB 1130:PRINT"3. High velocity (ball pen)":M%=13:GOSUB 1130
  309.      PRINT"(default velocity is LOW)":M%=22:N%=1:GOSUB 1110:INPUT"Type the velocity number (or RETURN for default): ",A$
  310.      IF A$="" THEN VS%=9 ELSE VSS=VAL(A$):IF VSS<=1 THEN VS%=9 ELSE IF VSS=2 THEN VS%=12 ELSE IF VSS>2 THEN VS%=25
  311.      RETURN
  312.  
  313. '    Subroutine to change the pen (called during program execution)
  314. 2700 M%=3:N%=1:GOSUB 1110:M%=5:GOSUB 1130:PRINT"Colour pens available on FACIT plotter are as follows:"
  315.      M%=7:N%=1:GOSUB 1130:PRINT"Black (type 1 or RETURN)":M%=8:GOSUB 1130:PRINT"Red (type 2)"
  316.      M%=9:GOSUB 1130:PRINT"Green (type 3)":M%=10:GOSUB 1130:PRINT"Blue (type 4)"
  317.      M%=11:GOSUB 1130:PRINT"Orange (type 5)":M%=12:GOSUB 1130:PRINT"Brown (type 6)"
  318. 2710 M%=22:N%=1:GOSUB 1120:INPUT"Colour no.: ",A$:IF A$="" THEN SP$="SP1;" ELSE IF VAL(A$)<1 OR VAL(A$)>6 THEN 2710
  319.      SP$="SP"+A$+";":F1$=temp$:GOSUB 2000:M%=3:N%=1:GOSUB 1110:' change the header, clear screen
  320.      RETURN
  321.  
  322. '                     Subroutines to control the plotter
  323. '                     ----------------------------------
  324.  
  325. '    Subroutine to send initialization command string to the plotter
  326. '    The initial points are set here at the maximum, however, it is not necessary to follow that and the initial
  327. '    points can be set lower.
  328. 3000 GOSUB 1000:IF FACIT=0 THEN P$="IN;DF;IP0,0,11420,8140;VS"+STR$(VS%)+";":GOSUB 3050:RETURN:' init to HP (defaults)
  329.      P$="IN;DF;IP0,0,10880,7640;VS"+STR$(VS%)+";":GOSUB 3050:RETURN:' init command to FACIT plotter (defaults)
  330.  
  331. '    Subroutine to specify the output and pause before the plot
  332. '    output to plotter or user specified SEQUENTIAL data file.  For multiple (fancy) plots the user has to supply
  333. '    different file names (and join the files outside this program for continuous plot).
  334. 3010 GOSUB 3100:M%=22:N%=1:GOSUB 1120:INPUT"Change plotting paper, press ENTER when ready!",A$:RETURN
  335.  
  336. '    Subroutine to move with pen up
  337. 3020 ON HV+1 GOSUB 1620,1630:GOSUB 1710:GOSUB 3050:RETURN
  338.  
  339. '    Subroutine to move with pen down 
  340. 3030 ON HV+1 GOSUB 1620,1630:GOSUB 1700:GOSUB 3050:RETURN
  341.  
  342. '    Subroutine to end the plotting and close $PLOT.PLT
  343. 3040 P$="PU;PA11420,8140;":GOSUB 3050:CLOSE:PD%=0:DF%=0:RETURN:' close $PLOT.PLT, reset flags
  344.  
  345. '    Subroutine to direct output command string to plotter or to data file or to both
  346. 3050 IF PD%=1 THEN GOSUB 4200 ELSE GOSUB 3200:GOSUB 4200:' avoid plot from data file into data file
  347.      RETURN
  348.  
  349. '    Subroutine to set the flag of output command string to data file only or to a default data file and the plotter
  350. 3100 PD%=0:CLOSE:F1$="program output":GOSUB 2000:M%=3:N%=1:GOSUB 1110:'display header, clear screen
  351. 3101 M%=22:N%=1:GOSUB 1120:INPUT"Output to P)lotter or D)ata file";A$
  352.      IF A$<>"P" and A$<>"D" THEN 3100
  353.      IF A$="P" THEN FF$="$PLOT.PLT":PD%=0:RETURN:' default temporary data file to store command lines
  354.      IF A$="D" THEN PD%=1:GOSUB 1120:LINE INPUT"Filename is ";FF$:IF FF$="" THEN FF$="$PLOT.PLT"
  355.      RETURN
  356.  
  357. '    Subroutine to send a command string to the plotter (set for x-on/x-off handshake protocol)
  358. '    Comment OUT that part of this subroutine that is not relevant to your system.  The label of the subroutine
  359. '    is always 3200 and the RETURN statement is at the very end of this subroutine.
  360. '-----------------------
  361. '3200 LPRINT P$:' for those who are using parallel connection or when the system does the handshake
  362. '-----------------------
  363. ' The following is for Z80 SIO, status port is 133, data 132. Change to suit to your system.
  364. 3200 FOR L%=1 TO LEN(P$):' start the data send loop
  365. 3210 S%=INP(STATP%):' read RR0, 0 = rec buffer empty, 1 = full
  366.      IF (S% AND 1)=0 THEN 3230:' send char if rec buff empty
  367. 3220 D%=INP(DATP%):' read char from the rec buffer
  368.      IF D%=19 THEN 3220:' it is X-off char, so loop
  369.      IF D%=17 THEN 3230:' it is X-on char, so send another char
  370.      OUT(STATP%),48:GOTO 3210:' reset on all other chars (incl err) and go for more
  371. 3230 IF (S% AND 4)=0 THEN 3210:' transmit buffer not empty, so loop
  372. 3240 OUT(DATP%),ASC(MID$(P$,L%,1)):NEXT:' send a char of the string
  373. '-----------------------
  374. ' The following is for the 8251 UART, status port is 89, data 88. Change to suit your system.
  375. '3200 IF(INP(STATP%) AND 2)=0 THEN 3210:' is there a Rx char? jump if not
  376. '     C%=INP(DATP%):IF C%=17 THEN C%=0 ELSE IF C%=19 THEN C%=1:' Rx char into a variable
  377. '3210 IF C%<>0 THEN 3200 ELSE 3220:' loop if x-off
  378. '3220 FOR L%=1 to LEN(P$):' start sending data
  379. '3230 IF(INP(STATP%) AND 1)=0 THEN 3230 ELSE OUT(DATP%),ASC(MID$(P$,L%,1)):NEXT:' loop if trans buffer full else transmit
  380. '-----------------------
  381.      RETURN:' return gracefully when all send (the very END of this subroutine)
  382.  
  383. '    Subroutine to draw axis and axis labels
  384. 3300 F1$="draw axis and labels":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=22:N%=1:GOSUB 1120:INPUT"Draw axis (Y)";A$
  385.      IF A$="N" OR A$="n" THEN RETURN ELSE GOSUB 1120:' last chance to do axis and now for the optional labels
  386.      INPUT"Label axis (Y)";A$:IF A$="N" or A$="n" THEN LBL=0 ELSE LBL=1:' will draw axis with or without labels
  387.      GOSUB 2700:GOSUB 2000:P$=SP$+"SR"+STR$(CFW)+","+STR$(CFH)+";":GOSUB 3050:' end of common for both routines
  388.      IF HV=1 THEN 3310 ELSE TA=LIM(10)*FY:' branch for "portrait" or continue with "landscape" - no ROT function used
  389.      TB=LIM(11)*FY:P$="DI1,0;TL"+STR$(TA)+","+STR$(TB)+";":GOSUB 3050:YT=LIM(1):FOR I%=0 TO LIM(6)
  390.      XT=LIM(2)+I%*DX/LIM(6):P=XT:Q=YT:GOSUB 1620:GOSUB 1700:P$=P$+"XT;PU;":XLB=MFX*XT
  391.      IF LBL=1 THEN P$=P$+"CP"+STR$(-LEN(STR$(XLB))/2)+",-.95;LB"+STR$(XLB)+CHR$(3):' add label if required
  392.      GOSUB 3050:P=XT:Q=YT:GOSUB 3030:NEXT:TA=LIM(12)*FX:TB=LIM(13)*FX:P$="PU;TL"+STR$(TA)+","+STR$(TB)+";":GOSUB 3050
  393.      XT=LIM(0):FOR I%=0 TO LIM(7):YT=LIM(4)+I%*DY/LIM(7):P=XT:Q=YT:GOSUB 1620:GOSUB 1700:P$=P$+"YT;PU;":YLB=MFY*YT
  394.      IF LBL=1 THEN P$=P$+"CP"+STR$(-LEN(STR$(YLB))-2)+",-.3;LB"+STR$(YLB)+CHR$(3):' add label if required
  395.      GOSUB 3050:P=XT:Q=YT:GOSUB 3030:NEXT:P$="PU;":GOSUB 3050
  396.      RETURN:' end of x-axis horizontal routine
  397. 3310 TA=LIM(13)*FX:TB=LIM(12)*FX:P$="DI0,1;TL"+STR$(TA)+","+STR$(TB)+";":GOSUB 3050:YT=LIM(1):FOR I%=0 TO LIM(6)
  398.      XT=LIM(2)+I%*DX/LIM(6):P=XT:Q=YT:GOSUB 1630:GOSUB 1700:P$=P$+"YT;PU;":XLB=MFX*XT
  399.      IF LBL=1 THEN P$=P$+"CP"+STR$(-LEN(STR$(XLB))/2)+",-.95;LB"+STR$(XLB)+CHR$(3):' add label if required
  400.      GOSUB 3050:P=XT:Q=YT:GOSUB 3030:NEXT:TA=FY*LIM(10):TB=FY*LIM(11):P$="PU;TL"+STR$(TA)+","+STR$(TB)+";":GOSUB 3050
  401.      XT=LIM(0):FOR I%=0 TO LIM(7):YT=LIM(4)+I%*DY/LIM(7):P=XT:Q=YT:GOSUB 1630:GOSUB 1700:P$=P$+"XT;PU;":YLB=MFY*YT
  402.      IF LBL=1 THEN P$=P$+"CP"+STR$(-LEN(STR$(YLB))-2)+",-.3;LB"+STR$(YLB)+CHR$(3):' add label if required
  403.      GOSUB 3050:P=XT:Q=YT:GOSUB 3030:NEXT:P$="PU;":GOSUB 3050
  404.      RETURN:' end of x-axis vertical routine
  405.  
  406. '    Subroutine to draw a function curve
  407. 3400 F1$="draw curve":GOSUB 2000:M%=3:N%=1:GOSUB 1110
  408.      IF G%(1)=1 THEN GOSUB 3800:RETURN:' draw line between points
  409.      M%=22:N%=1:GOSUB 1120:INPUT"Plot function (Y)";A$:IF A$="N" or A$="n" THEN RETURN
  410.      GOSUB 2700:P$=LT$+SP$:GOSUB 3050:FOR I%=1 TO 400:P=X(I%):Q=Y(I%):' check if curve is within the axis frame
  411.      IF P>=LIM(2) THEN IF P<=LIM(3) THEN IF Q>=LIM(4) THEN IF Q<=LIM(5) THEN GOSUB 3030 ELSE GOSUB 3020:' skip if not
  412.      NEXT:P$="PU;SP1;":GOSUB 3050:RETURN
  413.  
  414. '    Subroutine to draw axis legends (if any)
  415. 3500 F1$="legends":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=22:N%=1:GOSUB 1120:INPUT"Plot legend (Y)";A$
  416.      IF A$="N" or A$="n" THEN RETURN:' conditionally plot axis legend
  417.      IF XX$="" THEN 3510 ELSE GOSUB 2700:P$=SP$+"SR"+STR$(CLW)+","+STR$(CLH)+";":GOSUB 3050:P=LIM(2)+DX/2:Q=LIM(4)
  418.      ON HV+1 GOSUB 1620,1630:GOSUB 1710:IF HV=0 THEN P$=P$+"DI1,0;CP" ELSE P$=P$+"DI0,1;CP":' x-axis (horiz./vert.)
  419.      P$=P$+STR$(0-LEN(XX$)/2)+",-3;LB"+XX$+CHR$(3):GOSUB 3050:' draw legend
  420. 3510 IF YY$="" THEN RETURN ELSE GOSUB 2700:P=LIM(2):Q=LIM(4)+DY/2:ON HV+1 GOSUB 1620,1630:GOSUB 1710:' centered
  421.      IF HV=0 THEN P$=P$+SP$+"DI0,1;CP" ELSE P$=P$+SP$+"DI-1,0;CP":' according to x-axis (horiz./vert.)
  422.      P$=P$+STR$(0-LEN(YY$)/2)+",5;LB"+YY$+CHR$(3):GOSUB 3050:RETURN
  423.  
  424. '    Subroutine to draw title and explanatory notes
  425. 3600 F1$="title":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=22:N%=1:GOSUB 1120:INPUT"Plot title (Y)";A$
  426.      IF A$="N" OR A$="n" THEN RETURN:' plot title and notes if wanted
  427.      IF HV=0 AND Z$(0)="" THEN RETURN ELSE IF Z$(0)="" THEN 3610 ELSE 3605:' no title but we have notes
  428. 3605 GOSUB 2700:P$=SP$+"SR"+STR$(CTW)+","+STR$(CTH)+";":GOSUB 3050:P=LIM(2)+TJ*DX/2:Q=LIM(4):ON HV+1 GOSUB 1620,1630
  429.      GOSUB 1710:IF HV=0 THEN P$=P$+"DI1,0;CP" ELSE P$=P$+"DI0,1;CP"
  430.      P$=P$+STR$(0-TJ*LEN(Z$(0))/2)+",-5;LB"+Z$(0)+CHR$(3):GOSUB 3050:IF HV=0 THEN RETURN
  431. 3610 F1$="notes":GOSUB 2000:GOSUB 2700:P$=SP$+"SR"+STR$(CLW)+","+STR$(CLH)+";":GOSUB 3050:P=LIM(2):Q=LIM(4)
  432.      ON HV+1 GOSUB 1620,1630:GOSUB 1710:O$=P$+"DI0,1;CP0,":' branch for horizontal or vertical x-axis
  433.      FOR I%=1 TO 3:IF Z$(I%)="" THEN 3620:' do not sent empty strings to plotter
  434.      P$=O$+STR$(-5-I%)+";LB"+Z$(I%)+CHR$(3):GOSUB 3050:' plot content of notes string
  435. 3620 NEXT:RETURN
  436.  
  437. '    Subroutine to plot experimental points
  438. 3700 F1$="data points":GOSUB 2000:M%=3:N%=1:GOSUB 1110:M%=22:N%=1:GOSUB 1120:INPUT"Plot points (Y)";A$
  439.      IF A$="N" OR A$="n" THEN RETURN:' conditionally plot experimental points
  440.      IF ERA=1 THEN GOSUB 3900:RETURN:' should experimental data plot include experimental errors, then skip following
  441.      IF HV=0 THEN P$="DI1,0;" ELSE P$="DI0,1;":GOSUB 3050:' correct direction of points symbol (H/V)
  442.      GOSUB 2700:P$=P$+SP$+"SR"+STR$(CMW)+","+STR$(CMH)+";SM"+CHR$(SM)+";":GOSUB 3050:FOR I%=1 TO G%(4+SET%):P=XD(I%)
  443.      Q=YD(I%):GOSUB 3020:NEXT:P$="SM;PU;":GOSUB 3050:RETURN
  444.  
  445. '   Subroutine to connect experimental points by line
  446. 3800 M%=22:N%=1:GOSUB 1120:INPUT"Connect points by line (Y)";A$:IF A$="N" or A$="n" THEN RETURN:' only if required
  447.      GOSUB 2700:IF LT=0 THEN P$="LT;"+SP$ ELSE P$="LT"+STR$(LT)+","+STR$(PL)+";"+SP$
  448.      GOSUB 3050:FOR I%=1 TO G%(4+SET%):P=XD(I%):Q=YD(I%):GOSUB 3030
  449.      NEXT:P$="PU;SP1;":GOSUB 3050:RETURN
  450.  
  451. '    Subroutine to draw experimental points with their errors (draws a rectangle around the point)
  452. 3900 F1$="exptl errors":GOSUB 2000:GOSUB 2700:P$=SP$+"LT;":GOSUB 3050:FOR I%=1 TO G%(4+SET%):P=XD(I%)-EX(I%)
  453.      Q=YD(I%)-EY(I%):GOSUB 3030:P=XD(I%)+EX(I%):GOSUB 3030:Q=YD(I%)+EY(I%):GOSUB 3030:P=XD(I%)-EX(I%):GOSUB 3030
  454.      Q=YD(I%)-EY(I%):GOSUB 3030:P$="PU;":GOSUB 3050:NEXT:P$="PU;":GOSUB 3050:M%=22:N%=1:GOSUB 1120
  455.      INPUT"Put little crosses in (Y)";A$:IF A$="N" or A$="n" THEN RETURN:' we can put + in the middle
  456.      GOSUB 2700:P$=SP$+"SR"+STR$(CFW)+","+STR$(CFH)+";SM+;":GOSUB 3050:FOR I%=1 TO G%(4+SET%):P=XD(I%):Q=YD(I%)
  457.      GOSUB 3020:NEXT:P$="SM;PU;SP1;":GOSUB 3050:RETURN
  458.  
  459. '    Subroutine to display the after plot menu (again?, save plot?, new data?, new-set?, exit?)
  460. 4000 GOSUB 1100:M%=3:N%=8:IF PD%=0 THEN GOSUB 1120:PRINT"- to repeat the same plot, type A,"
  461.      M%=5:GOSUB 1120:PRINT"- to plot next set of data, type S,":' stay with this program
  462.      M%=7:GOSUB 1120:PRINT"- to change the plotter, type P,":' to change plotters
  463.      M%=9:GOSUB 1120:PRINT"- to enter new data, type D,":' chain the data entry program
  464.      M%=11:GOSUB 1120:PRINT"- to exit this program, type X,":' back to the operating system
  465. 4010 M%=22:N%=1:GOSUB 1120:INPUT"Your choice";A$:
  466.      IF PD%=1 THEN IF A$="A" THEN 4010:' to avoid plotting from file into file
  467.      IF A$="A" THEN GOSUB 4100:GOTO 4000::' read from default file
  468.      IF A$="S" THEN RETURN:' because when plotting then the command lines are stored in default file $PLOT.PLT
  469.      IF A$="P" THEN GOTO 6000:' start this program all over again
  470.      IF A$="D" THEN G%(0)=0:F$="PLOT.FLG":FL%=2:GOSUB 1500:GOSUB 1540:CHAIN "PLOT.COM":' chain to data entry program
  471.      IF A$="X" THEN END
  472.      GOTO 4010
  473.  
  474. '    Subroutine to plot from the SEQUENTIONAL data file (from either default $PLOT.PLT or given data file)
  475. 4100 OPEN"I",#2,FF$:PDF%=1:' open sequentional data file for input, set plot-data-file flag
  476. 4110 INPUT#2,Q$:IF MID$(Q$,1,2)="SP" THEN GOSUB 4120:' change pen on HP, no need for FACIT to stop
  477.      P$=Q$:GOSUB 3200:IF EOF(2) THEN 4130 ELSE 4110:' command string to plotter, check if end of file
  478. 4120 INPUT"Change pen, then press ENTER to continue!",A$:P$=CHR$(27)+".(":GOSUB 3200:RETURN:' break, then plotter ON
  479. 4130 CLOSE:PDF%=0:RETURN:' close the file, reset flag and return
  480.  
  481. '    Subroutine to store command lines for the plotter in SEQUENTIONAL data file
  482. 4200 IF PDF%=1 THEN RETURN:' we are plotting from a data file (psssible from user-defined-function option)
  483.      IF DF%=0 THEN OPEN"O",#2,FF$:DF%=1:' open seq data file for output
  484.      WRITE#2,P$:RETURN:' this file will be closed elsewhere
  485.  
  486.  
  487. '                       The MAIN section of this program 
  488. '                       ================================
  489.      
  490. 6000 F$="PLOT.FLG":FL%=2:GOSUB 1500:GOSUB 1530:' info filename, rec. length, open info. file, read data (flags)
  491.      GOSUB 1100:M%=22:N%=1:GOSUB 1130:INPUT"Continue with the plotter routine? (Y)",A$:IF A$="N" THEN END
  492.  
  493. 6010 FACIT=0:GOSUB 1100:M%=22:N%=1:GOSUB 1130:INPUT"Plotter is HP (Y/N)";A$:IF A$<>"Y" AND A$<>"N" THEN 6010
  494.      IF A$="N" THEN 6020 ELSE 6030
  495. 6020 FACIT=1:X%(0)=2220:X%(1)=1600:X%(2)=1640:X%(3)=800:XSPAN=10880-X%(0)-X%(1):YSPAN=7640-X%(2)-X%(3):FY=YSPAN/7640
  496.      FX=XSPAN/10880:GOTO 6050:' default FACIT
  497. 6030 X%(0)=1250:X%(1)=5375:X%(2)=1500:X%(3)=1625:XSPAN=11420-X%(0)-X%(1):YSPAN=8140-X%(2)-X%(3):FY=YSPAN/8140
  498.      FX=XSPAN/11420:FACIT=0:' default HP
  499.  
  500. 6050 ON G%(1) GOTO 6100,6200,6300,6400:' set HP plotter and serial port, what-to-plot flag branching
  501.  
  502. '    routine to plot experimental points and connect these, if required, by a line
  503. 6100 GOSUB 1100:F$="PLOT.$$$":FL%=4:GOSUB 1500:' cls, plotter or file?, open experimental data file
  504. 6110 M%=22:N%=1:GOSUB 1120:PRINT"There are";G%(3);:INPUT"sets of data. Do data set no.: ",A$:A=VAL(A$)
  505.      IF A<1 OR A>G%(3) THEN 6110 ELSE SET%=A-1:GOSUB 1510:GOSUB 1600:GOSUB 1100:GOSUB 1800:GOSUB 1300
  506. '    read data file, calc min and max, cls, read lims, do plotter setup routine
  507. 6120 GOSUB 1200:' repeat=back to start / plot=abbreviated routine / save=limits for plot, return
  508.      IF A$="R" THEN 6100 ELSE IF A$="P" THEN 6130 ELSE IF A$<>"S" THEN 6120 ELSE IF A$="S" THEN GOSUB 1830:GOTO 6120
  509. 6130 GOSUB 1400:GOTO 6100:' plot and return to the start, end of points/points-line routine
  510.  
  511. '    plot spline functions routine
  512. 6200 GOSUB 1100:F$="PLOT.$$$":FL%=4:GOSUB 1500:SET%=0:GOSUB 1510:GOSUB 1600:' read data points, calc. lims
  513. 6210 M%=22:N%=1:GOSUB 1120:INPUT"To plot F(X) type F, F'(X) type D1, F''(X) type D2: ",A$
  514.      IF A$="F" THEN SET%=0 ELSE IF A$="D1" THEN SET%=1 ELSE IF A$="D2" THEN SET%=2 ELSE 6210:' what to plot
  515.      F$="PLOT02.DAT":FL%=4:GOSUB 1500:GOSUB 1550:GOSUB 1610:GOSUB 1800:GOSUB 1300
  516. '    read data file, calc min and max, cls, read lims, do plotter setup routine, do plot
  517. 6220 GOSUB 1200:' repeat=back to start / plot=abbreviated routine / save=limits for plot, return
  518.      IF A$="R" THEN 6210 ELSE IF A$="P" THEN 6230 ELSE IF A$<>"S" THEN 6220 ELSE IF A$="S" THEN GOSUB 1830:GOTO 6220
  519. 6230 GOSUB 1400:GOTO 6210:' plot and return to the start, end of plot spline routine
  520.  
  521. '    family regression analysis routine
  522. 6300 GOSUB 1100:SET%=0:F$="PLOT.$$$":FL%=4:GOSUB 1500:GOSUB 1510:GOSUB 1600:' read data, calc min/max
  523.      FOR I%=5 TO 11:G%(I%)=G%(4):NEXT:' the SET% is pointer for model no. as well as for data set no. (1 set allowed)
  524. 6310 GOSUB 1100:F1$="regression models":GOSUB 2000:open"I",#1,"PLOT03.DOC":' display header, read regression file
  525.      M%=4:N%=1:GOSUB 1120:PRINT"1. model  y = A + B*x":M%=5:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$
  526.      M%=6:N%=1:GOSUB 1120:PRINT"2. model  y = A + B/x":M%=7:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$
  527.      M%=8:N%=1:GOSUB 1120:PRINT"3. model  1/y = A + B/x":M%=9:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$
  528.      M%=10:N%=1:GOSUB 1120:PRINT"4. model  y = A + B*(x^.5)":M%=11:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$
  529.      M%=12:N%=1:GOSUB 1120:PRINT"5. model  y  = A*EXP(B*x)":M%=13:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$
  530.      M%=14:N%=1:GOSUB 1120:PRINT"6. model  y = A*x^B":M%=15:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$
  531.      M%=16:N%=1:GOSUB 1120:PRINT"7. model  y = A + B*LN(x)":M%=17:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$
  532.      M%=18:N%=1:GOSUB 1120:PRINT"8. model  y = A + B*x + C*x^2":M%=19:N%=6:GOSUB 1120:INPUT#1,A$:PRINT A$:CLOSE
  533. 6320 M%=22:N%=1:GOSUB 1120:INPUT"Plot model number ",A$:A=VAL(A$):IF A<1 OR A>8 THEN 6320 ELSE SET%=A-1
  534.      F$="PLOT03.DAT":FL%=4:GOSUB 1500:GOSUB 1550:GOSUB 1610:GOSUB 1800:GOSUB 1300:' get all the data (KB or DF)
  535. 6330 GOSUB 1200:' repeat=back to start / plot=abbreviated routine / save=limits for plot, return
  536.      IF A$="R" THEN 6310 ELSE IF A$="P" THEN 6340 ELSE IF A$<>"S" THEN 6330 ELSE GOSUB 1830:GOTO 6330
  537. 6340 GOSUB 1400:GOTO 6310:' conditional plot routine, end of family regression analysis plot
  538.  
  539. '    user function routine
  540. 6400 GOSUB 1100:M%=22:N%=1:GOSUB 1120:INPUT"Plot from data file (Y/)";A$:IF A$="Y" THEN 6410 ELSE 6420
  541. 6410 GOSUB 1120:LINE INPUT"Filename is ";A$:IF A$="" THEN 6400 ELSE FF$=A$:PD%=1:GOSUB 4100:GOTO 6400:' plot from a file
  542. 6420 M%=22:N%=1:GOSUB 1120:INPUT"Plot function for set no.: ",A$:' up to 8 data sets, each 400 points
  543.      A=VAL(A$):IF A<1 OR A>8 THEN 6420:' no check for valid set
  544.      SET%=A-1:F$="PLOT.$$$":FL%=4:GOSUB 1500:GOSUB 1510:GOSUB 1600:' get experimental points, calc. min and max
  545.      F$="PLOT04.DAT":GOSUB 1500:GOSUB 1550:GOSUB 1610:' get function points, calculate min and max
  546. 6430 GOSUB 1300:' call plotter setup routine (plot limits, enhancements, etc.)
  547. 6440 GOSUB 1200:' repeat=back to start / plot=abbreviated routine / save=limits for plot, return
  548.      IF A$="R" THEN 6430 ELSE IF A$="P" THEN 6450 ELSE IF A$<>"S" THEN 6440 ELSE GOSUB 1830:GOTO 6440
  549. 6450 GOSUB 1400:GOTO 6400:' conditional plot routine, end of user's function plot
  550.  
  551. END
  552.