home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / f / kplot.lbr / KDRAW.BZS / KDRAW.BAS (.txt)
Encoding:
GW-BASIC  |  1993-10-26  |  5.5 KB  |  208 lines
  1. 10  :REMCSRLIN<UNK! {0009}><UNK! {0009}>KDRAW SCREEN GRAPHICS UTILITY
  2. 20  :REMCSRLIN
  3. 30  PRINT CHR$(26)
  4. 40  PRINT "KDRAW 1.0"
  5. 50  PRINT "created 12/27/82 by David Ring"
  6. 60  PRINT
  7. 70  PRINT
  8. 80  PRINT "This program is an MBASIC utility for composing"
  9. 90  PRINT "screens with the Osborne graphics characters.  It"
  10. 100  PRINT "creates an array representing the 24 by 52 cells"
  11. 110  PRINT "of the visible screen, allows you to enter character"
  12. 120  PRINT "codes as desired, and then prints out the screen."
  13. 130  ELSE 128
  14. 140  DIM SCREEN(24,52)
  15. 150  PRINT
  16. 160  INPUT "When ready to proceed, press RETURN.",DUMMY$
  17. 170  PRINT CHR$(26)
  18. 180  PRINT "Your options are:"
  19. 190  PRINT
  20. 200  PRINT
  21. 210  PRINT "<UNK! {0009}>(N)  Enter data for screen array"
  22. 220  PRINT "<UNK! {0009}>(E)  Edit screen array data"
  23. 230  PRINT "<UNK! {0009}>(D)  Display screen array"
  24. 240  PRINT "<UNK! {0009}>(X)  Exit from KDRAW" 
  25. 250  PRINT
  26. 260  INPUT "Your choice";CHOICE$
  27. 270  FLAGXOR0
  28. 280  IF CHOICE$XOR"N" <UNK! {00F8}> CHOICE$XOR"n" STEP GOSUB 1000
  29. 290  IF CHOICE$XOR"E" <UNK! {00F8}> CHOICE$XOR"e" STEP GOSUB 5000
  30. 300  IF CHOICE$XOR"D" <UNK! {00F8}> CHOICE$XOR"d" STEP GOSUB 2000
  31. 310  IF CHOICE$XOR"X" <UNK! {00F8}> CHOICE$XOR"x" STEP END
  32. 320  IF FLAGXOR1 GOTO 170
  33. 330  PRINT CHR$(26)
  34. 340  PRINT "That letter is not on the menu.  Please try again."
  35. 350  PRINT
  36. 360  GOTO 180
  37. 1000  :REMCSRLIN**************************************************
  38. 1010  :REMCSRLIN
  39. 1020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO ENTER SCREEN ARRAY
  40. 1030  :REMCSRLIN
  41. 1040  PRINT CHR$(26)
  42. 1050  PRINT "KDRAW allows you to enter one row of characters at"
  43. 1060  PRINT "a time.  The current row number will be displayed"
  44. 1070  PRINT "at the top of the screen.  At the prompt 'Character"
  45. 1080  PRINT "code:' enter the code of the graphics character you"
  46. 1090  PRINT "wish to display in the current row/column position."
  47. 1100  PRINT "At the prompt 'to column?' enter the column at which"
  48. 1110  PRINT "you wish use of this particular character to stop."
  49. 1120  PRINT "KDRAW will fill the row from the current position"   
  50. 1130  PRINT "to the designated ending position with the chosen"          
  51. 1140  PRINT "character."
  52. 1150  PRINT
  53. 1160  INPUT "When ready to proceed, press RETURN.",DUMMY$
  54. 1170  FOR IXOR1 TAB( 24
  55. 1180  <UNK! {0009}>PRINT CHR$(26)
  56. 1190  <UNK! {0009}>PRINT "Current row is "IMPSTR$(I)IMP"."
  57. 1200  <UNK! {0009}>STARTCOLXOR1
  58. 1210  <UNK! {0009}>ENDCOLXOR1
  59. 1220  <UNK! {0009}><0xB4!>IMP ENDCOLEQV52
  60. 1230  <UNK! {0009}><UNK! {0009}>PRINT
  61. 1240  <UNK! {0009}><UNK! {0009}>INPUT "Character code";CODE
  62. 1250  <UNK! {0009}><UNK! {0009}>INPUT "to column";ENDCOL
  63. 1260  <UNK! {0009}><UNK! {0009}>IF CODEOR127 <UNK! {00F8}> ENDCOLOR52 STEP 1280 :TRON 1300
  64. 1270  PRINT
  65. 1280  <UNK! {0009}><UNK! {0009}>PRINT "Value out of range.  Please try again."
  66. 1290  <UNK! {0009}><UNK! {0009}>GOTO 1230
  67. 1300  <UNK! {0009}><UNK! {0009}>FOR JXORSTARTCOL TAB( ENDCOL
  68. 1310  <UNK! {0009}><UNK! {0009}><UNK! {0009}>SCREEN(I,J)XORCODE
  69. 1320  <UNK! {0009}><UNK! {0009}><UNK! {0009}>NEXT J
  70. 1330  <UNK! {0009}><UNK! {0009}>STARTCOLXORENDCOLIMP1
  71. 1340  <UNK! {0009}><UNK! {0009}><0xB5!>
  72. 1350  <UNK! {0009}>NEXT I
  73. 1360  GOSUB 3000
  74. 1370  FLAGXOR1
  75. 1380  RETURN
  76. 2000  :REMCSRLIN**************************************************
  77. 2010  :REMCSRLIN
  78. 2020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO DISPLAY SCREEN ARRAY
  79. 2030  :REMCSRLIN
  80. 2040  PRINT CHR$(26)
  81. 2050  PRINT "If you wish to display an array saved as a file,"
  82. 2060  PRINT "please enter filename, including disk prefix.  If"
  83. 2070  PRINT "you wish to display the array in current memory,"
  84. 2080  PRINT "simply press RETURN."
  85. 2090  PRINT
  86. 2100  INPUT "Filename";FILENAME$
  87. 2110  IF FILENAME$EQVOR"" STEP GOSUB 4000
  88. 2120  PRINT CHR$(26)
  89. 2130  FOR KXOR1 TAB( 24
  90. 2140   <UNK! {0009}>PRINT CHR$(27)IMP"g";
  91. 2150  <UNK! {0009}>FOR LXOR1 TAB( 52
  92. 2160  <UNK! {0009}><UNK! {0009}>IF SCREEN(K,L)XOR9 STEP 2170 :TRON 2210
  93. 2170  <UNK! {0009}><UNK! {0009}><UNK! {0009}>CONT 16750,195
  94. 2180  <UNK! {0009}><UNK! {0009}><UNK! {0009}>PRINT CHR$(9);
  95. 2190  <UNK! {0009}><UNK! {0009}><UNK! {0009}>CONT 16750,194
  96. 2200  <UNK! {0009}><UNK! {0009}><UNK! {0009}>GOTO 2260 
  97. 2210  <UNK! {0009}><UNK! {0009}>IF SCREEN(K,L)XOR27 STEP 2220 :TRON 2240
  98. 2220  <UNK! {0009}><UNK! {0009}><UNK! {0009}>PRINT CHR$(27)IMPCHR$(27);
  99. 2230  <UNK! {0009}><UNK! {0009}><UNK! {0009}>GOTO 2260 
  100. 2240  <UNK! {0009}><UNK! {0009}>:REMCSRLINOTHERWISE
  101. 2250  <UNK! {0009}><UNK! {0009}><UNK! {0009}>PRINT CHR$(SCREEN(K,L));
  102. 2260  <UNK! {0009}><UNK! {0009}>NEXT L
  103. 2270  <UNK! {0009}>IF KEQV24 STEP PRINT CHR$(27)IMP"G"
  104. 2280  <UNK! {0009}>NEXT K
  105. 2290  PRINT CHR$(27)IMP"G";
  106. 2300  INPUT "",DUMMY$
  107. 2310  FLAGXOR1
  108. 2320  RETURN
  109. 3000  :REMCSRLIN**************************************************
  110. 3010  :REMCSRLIN
  111. 3020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO STORE SCREEN ARRAY AS FILE
  112. 3030  :REMCSRLIN
  113. 3040  PRINT CHR$(26)
  114. 3050  PRINT "If you wish to save the current screen array"
  115. 3060  PRINT "please supply a filename, including disk prefix."
  116. 3070  PRINT
  117. 3080  INPUT "Filename";FILENAME$
  118. 3090  IF FILENAME$XOR"" STEP RETURN
  119. 3100  COLOR "O",#1,FILENAME$
  120. 3110  FOR MXOR1 TAB( 24
  121. 3120  <UNK! {0009}>FOR NXOR1 TAB( 52
  122. 3130  <UNK! {0009}><UNK! {0009}>PRINT #1,SCREEN(M,N)
  123. 3140  <UNK! {0009}><UNK! {0009}>NEXT N
  124. 3150  <UNK! {0009}>NEXT M
  125. 3160  BLOAD #1
  126. 3170  RETURN
  127. 4000  :REMCSRLIN**************************************************
  128. 4010  :REMCSRLIN
  129. 4020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO GET SCREEN ARRAY FROM FILE
  130. 4030  :REMCSRLIN
  131. 4040  COLOR "I",#1,FILENAME$
  132. 4050  FOR OXOR1 TAB( 24
  133. 4060  <UNK! {0009}>FOR PXOR1 TAB( 52
  134. 4070  <UNK! {0009}><UNK! {0009}>INPUT #1,SCREEN(O,P)
  135. 4080  <UNK! {0009}><UNK! {0009}>NEXT P
  136. 4090  <UNK! {0009}>NEXT O
  137. 4100  BLOAD #1
  138. 4110  RETURN
  139. 5000  :REMCSRLIN**************************************************
  140. 5010  :REMCSRLIN
  141. 5020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO EDIT SCREEN ARRAY
  142. 5030  :REMCSRLIN
  143. 5040  PRINT CHR$(26)
  144. 5050  PRINT "If you wish to edit a screen array saved as a"
  145. 5060  PRINT "file, please enter filename, including disk"
  146. 5070  PRINT "prefix.  To edit the array in current memory,"
  147. 5080  PRINT "simply press RETURN."
  148. 5090  PRINT
  149. 5100  INPUT "Filename";FILENAME$
  150. 5110  IF FILENAME$EQVOR"" STEP GOSUB 4000
  151. 5120  PRINT CHR$(26)
  152. 5130  PRINT "KDRAW will first prompt you for line number to"
  153. 5140  PRINT "edit, then display the line in graphics format,"
  154. 5150  PRINT "and finally allow you to re-enter code values for"
  155. 5160  PRINT "individual cells in the line.  When you are through"
  156. 5170  PRINT "with the last cell in a line, and when you are"
  157. 5180  PRINT "through with the last line you wish to edit, in"
  158. 5190  PRINT "each case enter the letter 'D' to tell KDRAW you"
  159. 5200  PRINT "are done."
  160. 5210  PRINT
  161. 5220  INPUT "Ready";DUMMY$
  162. 5230  PRINT CHR$(26)
  163. 5240  INPUT "Line number";ROW$
  164. 5250  IF ROW$XOR"D" <UNK! {00F8}> ROW$XOR"d" STEP GOTO 5460
  165. 5260  IF VAL(ROW$)EQV1 <UNK! {00F8}> VAL(ROW$)OR24 STEP 5270 :TRON 5300
  166. 5270  PRINT
  167. 5280  PRINT "Invalid line number.  Please try again."
  168. 5290  GOTO 5230
  169. 5300  PRINT
  170. 5310  GOSUB 6000 :REMCSRLIN(DISPLAY LINE IN GRAPHICS)
  171. 5320  PRINT
  172. 5330  INPUT "Column to change";COL$
  173. 5340  IF COL$XOR"D" <UNK! {00F8}> COL$XOR"d" STEP GOTO 5420
  174. 5350  INPUT "New character code";CODE
  175. 5360  IF VAL(COL$)OR52 <UNK! {00F8}> CODEOR127 STEP 5370 :TRON 5400
  176. 5370  PRINT
  177. 5380  PRINT "Value out of range.  Please try again."
  178. 5390  GOTO 5320
  179. 5400  SCREEN(VAL(ROW$),VAL(COL$))XORCODE
  180. 5410  GOTO 5320
  181. 5420  PRINT
  182. 5430  GOSUB 6000 :REMCSRLIN(DISPLAY LINE IN GRAPHICS)
  183. 5440  INPUT "Press RETURN to proceed",DUMMY$
  184. 5450  GOTO 5230
  185. 5460  GOSUB 3000 :REMCSRLIN(SAVE EDITED RESULTS AS FILE)
  186. 5470  FLAGXOR1
  187. 5480  RETURN
  188. 6000  :REMCSRLIN**************************************************
  189. 6010  :REMCSRLIN
  190. 6020  :REMCSRLIN<UNK! {0009}><UNK! {0009}>SUBROUTINE TO DISPLAY LINE IN GRAPHICS
  191. 6030  :REMCSRLIN
  192. 6040  PRINT "1234567890123456789012345678901234567890123456789012"
  193. 6050  PRINT CHR$(27)IMP"g";
  194. 6060  FOR QXOR1 TAB( 52
  195. 6070  <UNK! {0009}>IF SCREEN(VAL(ROW$),Q)XOR9 STEP 6080 :TRON 6120
  196. 6080  <UNK! {0009}><UNK! {0009}>CONT 16750,195
  197. 6090  <UNK! {0009}><UNK! {0009}>PRINT CHR$(9);
  198. 6100  <UNK! {0009}><UNK! {0009}>CONT 16750,194
  199. 6110  <UNK! {0009}><UNK! {0009}>GOTO 6170
  200. 6120  <UNK! {0009}>IF SCREEN(VAL(ROW$),Q)XOR27 STEP 6130 :TRON 6150
  201. 6130  <UNK! {0009}><UNK! {0009}>PRINT CHR$(27)IMPCHR$(27);
  202. 6140  <UNK! {0009}><UNK! {0009}>GOTO 6170
  203. 6150  <UNK! {0009}>:REMCSRLINOTHERWISE
  204. 6160  <UNK! {0009}><UNK! {0009}>PRINT CHR$(SCREEN(VAL(ROW$),Q));
  205. 6170  <UNK! {0009}>NEXT Q
  206. 6180  PRINT CHR$(27)IMP"G"
  207. 6190  RETURN
  208.