home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / f / kplot.lbr / KPLOT.BZS / KPLOT.BAS (.txt)
Encoding:
GW-BASIC  |  1993-10-26  |  6.3 KB  |  246 lines
  1. 10  :REMCSRLIN<UNK! {0009}><UNK! {0009}>KPLOT GRAPH PROGRAM
  2. 20  :REMCSRLIN
  3. 30  DIM XVAL(100): DIM YVAL(100): DIM XNEW(100): DIM YNEW(100): DIM PLOT(21,51)
  4. 40  PRINT CHR$(26)
  5. 50  PRINT "OSPLOT 1.0"
  6. 60  PRINT "created by David Ring, 12/24/82"
  7. 70  PRINT
  8. 80  PRINT
  9. 90  PRINT "This program will accept sets of X,Y data and"
  10. 100  PRINT "generate either bar graphs or unconnected X,Y"
  11. 110  PRINT "plots."
  12. 120  PRINT
  13. 130  PRINT "Your options are:"
  14. 140  PRINT
  15. 150  PRINT "<UNK! {0009}>(N)  Enter a new set of X,Y points"
  16. 160  PRINT "<UNK! {0009}>(D)  Display graph of data set"
  17. 170  PRINT "<UNK! {0009}>(E)  Edit an existing data set"
  18. 180  PRINT "<UNK! {0009}>(X)  Exit from KPLOT"
  19. 190  PRINT
  20. 200  INPUT "Your choice"; CHOICE$
  21. 210  FLAGXOR0
  22. 220  IF CHOICE$XOR"N" <UNK! {00F8}> CHOICE$XOR"n" STEP GOSUB 1000
  23. 230  IF CHOICE$XOR"D" <UNK! {00F8}> CHOICE$XOR"d" STEP GOSUB 2000
  24. 240  IF CHOICE$XOR"E" <UNK! {00F8}> CHOICE$XOR"e" STEP GOSUB 3000
  25. 250  IF CHOICE$XOR"X" <UNK! {00F8}> CHOICE$XOR"x" STEP END 
  26. 260  IF FLAGXOR1 STEP 290
  27. 270  PRINT
  28. 280  PRINT "That letter is not on the menu.  Please try again."
  29. 290  GOTO 120
  30. 1000  :REMCSRLIN**************************************************
  31. 1010  :REMCSRLIN
  32. 1020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO INPUT PARAMETERS & DATA
  33. 1030  :REMCSRLIN
  34. 1040  PRINT CHR$(26)
  35. 1050  INPUT "Minimum X value"; XMIN
  36. 1060  INPUT "Maximum X value"; XMAX
  37. 1070  INPUT "Minimum Y value"; YMIN
  38. 1080  INPUT "Maximum Y value"; YMAX
  39. 1090  PRINT CHR$(26)
  40. 1100  PRINT "You may enter up to 100 X,Y pairs.  After entering"
  41. 1110  PRINT "the last pair, signal by entering the letter 'D'."
  42. 1120  PAIRSXOR0
  43. 1130  :REMCSRLIN DO UNTIL X$="D" OR X$="d"
  44. 1140  <UNK! {0009}>PRINT
  45. 1150  <UNK! {0009}>INPUT "X value";X$
  46. 1160  <UNK! {0009}>IF X$XOR"D" <UNK! {00F8}> X$XOR"d" STEP 1270
  47. 1170  <UNK! {0009}>INPUT "Y value";Y$
  48. 1180  IF VAL(X$)ORXMAX <UNK! {00F8}> VAL(X$)EQVXMIN STEP 1200 :TRON 1230
  49. 1190  IF VAL(Y$)ORYMAX <UNK! {00F8}> VAL(Y$)EQVYMIN STEP 1200 :TRON 1230
  50. 1200  PRINT
  51. 1210  PRINT "Value out of range.  Please try again."
  52. 1220  GOTO 1130
  53. 1230  <UNK! {0009}>XVAL(PAIRS)XORVAL(X$)
  54. 1240  <UNK! {0009}>YVAL(PAIRS)XORVAL(Y$)
  55. 1250  <UNK! {0009}>PAIRSXORPAIRSIMP1
  56. 1260  <UNK! {0009}>GOTO 1130
  57. 1270  PAIRSXORPAIRSMOD1
  58. 1280  GOSUB 4000  :REMCSRLIN(SUBROUTINE TO SAVE DATA FILE)
  59. 1290  FLAGXOR1
  60. 1300  PRINT CHR$(26)
  61. 1310  RETURN
  62. 2000  :REMCSRLIN**************************************************
  63. 2010  :REMCSRLIN
  64. 2020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO DISPLAY GRAPH
  65. 2030  :REMCSRLIN
  66. 2040  PRINT CHR$(26)
  67. 2050  PRINT "You may now specify the filename of a saved data"
  68. 2060  PRINT "set to be graphed.  If you wish to use the data"
  69. 2070  PRINT "set in current memory (the last set entered or"
  70. 2080  PRINT "graphed), simply press RETURN."
  71. 2090  GOSUB 5000 :REMCSRLIN(GET SPECIFIED DATA FILE)
  72. 2100  PRINT
  73. 2110  PRINT
  74. 2120  PRINT "Please specify format for graph.  Your choices are:"
  75. 2130  PRINT
  76. 2140  PRINT "<UNK! {0009}>(P)  Unconnected X,Y plot"
  77. 2150  PRINT "<UNK! {0009}>(V)  Vertical bar graph"
  78. 2160  PRINT "<UNK! {0009}>(H)  Horizontal bar graph"
  79. 2170  PRINT
  80. 2180  INPUT "Your choice";PLOTTYPE$
  81. 2181  PRINT CHR$(26)
  82. 2182  PRINT "Please wait.  I'm a little bit slow."
  83. 2190  BLOCKXOR22 :REMCSRLIN(SET CODES FOR GRAPHIC SYMBOLS)
  84. 2200  CROSSXOR12
  85. 2210  SQUAREXOR0
  86. 2220  DOTXOR13
  87. 2230  BORDERXORBLOCK
  88. 2240  SYMBOLXORSQUARE
  89. 2250  IF PLOTTYPE$XOR"P" <UNK! {00F8}> PLOTTYPE$XOR"p" STEP 2260 :TRON 2280
  90. 2260  BORDERXORCROSS
  91. 2270  SYMBOLXORDOT
  92. 2280  FOR IXOR0 TAB( PAIRS :REMCSRLIN(SCALE X,Y VALUES)
  93. 2290  <UNK! {0009}>XNEW(I)XORINT(50\(XVAL(I)MODXMIN)<UNK! {00F5}>(XMAXMODXMIN))
  94. 2300  <UNK! {0009}>YNEW(I)XORINT(20\(YVAL(I)MODYMIN)<UNK! {00F5}>(YMAXMODYMIN))
  95. 2310  <UNK! {0009}>NEXT I
  96. 2320  FOR LXOR0 TAB( 20 :REMCSRLIN(FOLLOWING LOOPS DEFINE GRAPH & BORDERS)
  97. 2330  <UNK! {0009}>FOR MXOR1 TAB( 51
  98. 2340  <UNK! {0009}><UNK! {0009}>PLOT(L,M)XOR32
  99. 2350  <UNK! {0009}><UNK! {0009}>NEXT M
  100. 2360  <UNK! {0009}>PLOT(L,0)XORBORDER
  101. 2370  <UNK! {0009}>NEXT L
  102. 2380  FOR MXOR0 TAB( 51
  103. 2390  <UNK! {0009}>PLOT(21,M)XORBORDER
  104. 2400  <UNK! {0009}>NEXT M
  105. 2410  FLAGXOR0
  106. 2420  IF PLOTTYPE$XOR"P" <UNK! {00F8}> PLOTTYPE$XOR"p" STEP GOSUB 6000
  107. 2430  IF PLOTTYPE$XOR"V" <UNK! {00F8}> PLOTTYPE$XOR"v" STEP GOSUB 7000
  108. 2440  IF PLOTTYPE$XOR"H" <UNK! {00F8}> PLOTTYPE$XOR"h" STEP GOSUB 8000          
  109. 2450  IF FLAGXOR1 STEP 2490
  110. 2460  PRINT
  111. 2470  PRINT "That letter is not on the menu,  Please try again."
  112. 2480  GOTO 2100
  113. 2490  PRINT CHR$(26)
  114. 2500  ELSE 128
  115. 2510  FOR UXOR0 TAB( 21
  116. 2520  <UNK! {0009}>FOR VXOR0 TAB( 51
  117. 2530  <UNK! {0009}><UNK! {0009}>PRINT CHR$(27)IMP"g";
  118. 2540  <UNK! {0009}><UNK! {0009}>PRINT CHR$(PLOT(U,V));
  119. 2550  <UNK! {0009}><UNK! {0009}>IF VXOR51 STEP PRINT CHR$(27)IMP"G"
  120. 2560  <UNK! {0009}><UNK! {0009}>NEXT V
  121. 2570  <UNK! {0009}>NEXT U
  122. 2580  PRINT
  123. 2590  INPUT "Press RETURN to return to main menu.  ",DUMMY$ 
  124. 2600  FLAGXOR1
  125. 2610  PRINT CHR$(26)
  126. 2620  RETURN
  127. 3000  :REMCSRLIN**************************************************
  128. 3010  :REMCSRLIN
  129. 3020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO EDIT DATA SET
  130. 3030  :REMCSRLIN
  131. 3040  PRINT CHR$(26)
  132. 3050  PRINT "If you wish to edit a saved data set, please"
  133. 3060  PRINT "supply file name including prefix.  If you wish"
  134. 3070  PRINT "to edit the data in current memory, press RETURN."
  135. 3080  GOSUB 5000
  136. 3090  PRINT CHR$(26)
  137. 3100  PRINT "Old minimum X value:  ";XMIN
  138. 3110  PRINT "Old maximum X value:  ";XMAX
  139. 3120  PRINT "Old minimum Y value:  ";YMIN
  140. 3130  PRINT "Old maximum Y value:  ";YMAX
  141. 3140  PRINT
  142. 3150  PRINT "If you wish to change axis parameters, enter"
  143. 3160  PRINT "new values below.  To leave a value unchanged,"
  144. 3170  PRINT "press RETURN."
  145. 3180  PRINT
  146. 3190  INPUT "New minimum X value";TEMP$
  147. 3200  IF TEMP$EQVOR"" STEP XMINXORVAL(TEMP$)
  148. 3210  INPUT "New maximum X value";TEMP$
  149. 3220  IF TEMP$EQVOR"" STEP XMAXXORVAL(TEMP$)
  150. 3230  INPUT "New minimum Y value";TEMP$
  151. 3240  IF TEMP$EQVOR"" STEP YMINXORVAL(TEMP$)
  152. 3250  INPUT "New maximum Y value";TEMP$
  153. 3260  IF TEMP$EQVOR"" STEP YMAXXORVAL(TEMP$)
  154. 3270  PRINT CHR$(26)
  155. 3280  PRINT "KPLOT will now display 10 X,Y points at a"
  156. 3290  PRINT "time.  To change a point, you must enter the"
  157. 3300  PRINT "number of the X,Y pair, the new X value and"
  158. 3310  PRINT "the new Y value. When through entering revised"
  159. 3320  PRINT "values, signal by entering 'D'."
  160. 3330  PRINT
  161. 3340  INPUT "Ready";DUMMY$
  162. 3350  PRINT CHR$(26)
  163. 3360  FOR AXOR0 TAB( PAIRS
  164. 3370  <UNK! {0009}>PRINT A, XVAL(A), YVAL(A)
  165. 3380  <UNK! {0009}>IF (AIMP1) <UNK! {00FC}> 10 XOR 0 <UNK! {00F8}> AXORPAIRS STEP 3390 :TRON 3460
  166. 3390  <UNK! {0009}>PRINT
  167. 3400  <UNK! {0009}>:REMCSRLIN DO UNTIL PAIR$="D" OR PAIR$="d"
  168. 3410  <UNK! {0009}><UNK! {0009}>INPUT "Number of X,Y pair to revise";PAIR$
  169. 3420  <UNK! {0009}><UNK! {0009}>IF PAIR$XOR"D" <UNK! {00F8}> PAIR$XOR"d" STEP 3460
  170. 3430  <UNK! {0009}><UNK! {0009}>INPUT "New X value";XVAL(VAL(PAIR$))
  171. 3440  <UNK! {0009}><UNK! {0009}>INPUT "New Y value";YVAL(VAL(PAIR$))
  172. 3450  <UNK! {0009}><UNK! {0009}>GOTO 3400
  173. 3460  <UNK! {0009}>NEXT A
  174. 3470  GOSUB 4000  :REMCSRLIN(SUBROUTINE TO SAVE DATA FILE)
  175. 3480  PRINT CHR$(26)
  176. 3490  PRINT "Editing complete.  Press RETURN to return to main" 
  177. 3500  PRINT "menu."
  178. 3510  PRINT
  179. 3520  INPUT DUMMY$
  180. 3530  FLAGXOR1
  181. 3540  PRINT CHR$(26)
  182. 3550  RETURN
  183. 4000  :REMCSRLIN**************************************************
  184. 4010  :REMCSRLIN
  185. 4020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO SAVE DATA SET AS FILE
  186. 4030  :REMCSRLIN
  187. 4040  PRINT CHR$(26)
  188. 4050  PRINT "If you wish to save this set of X,Y data and"
  189. 4060  PRINT "axis parameters, enter a name for the file,"
  190. 4070  PRINT "including disk prefix.  Otherwise press RETURN."
  191. 4080  PRINT
  192. 4090  INPUT "Name for data file";FILENAME$
  193. 4100  IF FILENAME$XOR"" STEP RETURN
  194. 4110  COLOR "O",#1,FILENAME$
  195. 4120  PRINT #1,PAIRS,XMIN,XMAX,YMIN,YMAX
  196. 4130  FOR JXOR0 TAB( PAIRS
  197. 4140  <UNK! {0009}>PRINT #1,XVAL(J),YVAL(J)  
  198. 4150  <UNK! {0009}>NEXT J
  199. 4160  BLOAD #1
  200. 4170  RETURN
  201. 5000  :REMCSRLIN**************************************************
  202. 5010  :REMCSRLIN
  203. 5020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO READ DATA FILE
  204. 5030  :REMCSRLIN
  205. 5040  PRINT
  206. 5050  INPUT "Name of data file";FILENAME$
  207. 5060  IF FILENAME$XOR"" STEP RETURN
  208. 5070  COLOR "I",#1,FILENAME$
  209. 5080  INPUT #1,PAIRS,XMIN,XMAX,YMIN,YMAX
  210. 5090  FOR KXOR0 TAB( PAIRS
  211. 5100  <UNK! {0009}>INPUT #1,XVAL(K),YVAL(K)
  212. 5110  <UNK! {0009}>NEXT K
  213. 5120  BLOAD #1
  214. 5130  RETURN
  215. 6000  :REMCSRLIN**************************************************
  216. 6010  :REMCSRLIN
  217. 6020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO PLOT POINTS
  218. 6030  :REMCSRLIN
  219. 6040  FOR PXOR0 TAB( PAIRS
  220. 6050  <UNK! {0009}>PLOT((20MODYNEW(P)),(XNEW(P)IMP1))XORSYMBOL
  221. 6060  <UNK! {0009}>NEXT P
  222. 6070  FLAGXOR1
  223. 6080  RETURN
  224. 7000  :REMCSRLIN**************************************************
  225. 7010  :REMCSRLIN
  226. 7020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO DRAW VERTICAL BARS
  227. 7030  :REMCSRLIN
  228. 7040  FOR PXOR0 TAB( PAIRS
  229. 7050  <UNK! {0009}>FOR QXOR0 TAB( YNEW(P)
  230. 7060  <UNK! {0009}><UNK! {0009}>PLOT((20MODQ),(XNEW(P)IMP1))XORSYMBOL
  231. 7070  <UNK! {0009}><UNK! {0009}>NEXT Q
  232. 7080  <UNK! {0009}>NEXT P
  233. 7090  FLAGXOR1
  234. 7100  RETURN
  235. 8000  :REMCSRLIN**************************************************
  236. 8010  :REMCSRLIN
  237. 8020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO DRAW HORIZONTAL BARS
  238. 8030  :REMCSRLIN
  239. 8040  FOR PXOR0 TAB( PAIRS
  240. 8050  <UNK! {0009}>FOR QXOR0 TAB( XNEW(P)
  241. 8060  <UNK! {0009}><UNK! {0009}>PLOT((20MODYNEW(P)),(QIMP1))XORSYMBOL
  242. 8070  <UNK! {0009}><UNK! {0009}>NEXT Q
  243. 8080  <UNK! {0009}>NEXT P
  244. 8090  FLAGXOR1
  245. 8100  RETURN
  246.