home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / droege1 / roland.bas < prev    next >
BASIC Source File  |  1986-10-20  |  6KB  |  157 lines
  1. 100 REM
  2. 200 REM   October 20, 1986.
  3. 300 REM
  4. 400 REM -- first issue some resets and define screen color
  5. 500 REM ==================================================
  6. 600 ON ERROR GOTO 15500
  7. 700 SCREEN 0:COLOR 11,1,1:CLS
  8. 800 REM
  9. 900 REM -- declare var types and dimension arrays
  10. 1000 REM =========================================
  11. 1100 DEFINT I-N
  12. 1200 DIM B$(1000)
  13. 1300 REM
  14. 1400 REM -- This sections defines constants and default values.
  15. 1500 REM ======================================================
  16. 1600 TWOPI=6.283185
  17. 1700 ARCFACTOR=360!/(TWOPI*500!)
  18. 1800 NSTRINGMAX=1000
  19. 1900 REM
  20. 2000 REM
  21. 2100 REM
  22. 2200 REM -- parameter initialization --
  23. 2300 REM ==============================
  24. 2400 IAPERTURE=-1
  25. 2500 REM
  26. 2600 REM
  27. 2700 INPUT"Ready pen-plotter and enter name of plot file [.PLT]: ",FILENAME$
  28. 2800 IF FILENAME$="" THEN END
  29. 2900 IF INSTR(FILENAME$,".")=0 THEN FILENAME$=FILENAME$ + ".PLT"
  30. 3000 REM
  31. 3100 REM
  32. 3200 REM -- Enter main body of program. Open plot file and begin reading.
  33. 3300 REM ================================================================
  34. 3400 OPEN "I",#1,FILENAME$
  35. 3500 ISTR=NSTRINGMAX
  36. 3600 GOSUB 10200
  37. 3700 IF ITYPE = 1 THEN 4400 'VALID MODE FOUND
  38. 3800 IF ITYPE <> 3 THEN 3600
  39. 3900 PRINT "END OF INPUT FILE...PLOT DONE.":GOTO 9200
  40. 4000 REM
  41. 4100 REM -- Come here when valid mode found --
  42. 4200 REM =====================================
  43. 4300 REM -- test IMODE and jump to process command --
  44. 4400 IF A$="M" THEN 5600
  45. 4500 IF A$="D" THEN 5600
  46. 4600 IF A$="H" THEN LPRINT "H":GOTO 3600
  47. 4700 IF A$="A" THEN 6300
  48. 4800 IF A$="P" THEN 6800
  49. 4900 IF A$="C" THEN 7700
  50. 5000 PRINT "Plot file error -- command not recognized."
  51. 5100 PRINT "Plot terminated.":GOTO 9200
  52. 5200 REM
  53. 5300 REM
  54. 5400 REM -- Come here to process M and D modes --
  55. 5500 REM ========================================
  56. 5600 MD$=A$:GOSUB 10200:IX=IVALUE
  57. 5700 GOSUB 10200:IY=IVALUE:LPRINT MD$;IX;",";IY
  58. 5800 GOSUB 10200:IF ITYPE <> 2 THEN 3700 ELSE IX=IVALUE:GOTO 5700
  59. 5900 REM
  60. 6000 REM
  61. 6100 REM -- Come here to process aperture command --
  62. 6200 REM ===========================================
  63. 6300 GOSUB 10200:IAPERTURE=IVALUE:GOTO 3700
  64. 6400 REM
  65. 6500 REM
  66. 6600 REM -- Come here to expose a pad --
  67. 6700 REM ===============================
  68. 6800 GOSUB 10200:IX=IVALUE
  69. 6900 GOSUB 10200:IY=IVALUE
  70. 7000 LPRINT "M";IX;",";IY
  71. 7100 GOSUB 12400
  72. 7200 GOSUB 10200:IF ITYPE <> 2 THEN 3700 ELSE IX=IVALUE:GOTO 6900
  73. 7300 REM
  74. 7400 REM
  75. 7500 REM -- Come here to draw an arc or circle
  76. 7600 REM =====================================
  77. 7700 GOSUB 10200:IXCENTER=IVALUE
  78. 7800 GOSUB 10200:IYCENTER=IVALUE
  79. 7900 GOSUB 10200:IRADIUS=IVALUE
  80. 8000 GOSUB 10200:ITHETA1=VALUE*ARCFACTOR
  81. 8100 GOSUB 10200:ITHETA2=VALUE*ARCFACTOR
  82. 8200 IF ITHETA1>360! THEN ITHETA1=ITHETA1-360!
  83. 8300 IF ITHETA2>360! THEN ITHETA2=ITHETA2-360!
  84. 8400 IF ITHETA2>ITHETA1 THEN LPRINT"C";IXCENTER;",";IYCENTER;",";IRADIUS;",";ITHETA1;",";ITHETA2:GOTO 8700
  85. 8500 LPRINT"C";IXCENTER;",";IYCENTER;",";IRADIUS;",";ITHETA1;",360"
  86. 8600 LPRINT"C";IXCENTER;",";IYCENTER;",";IRADIUS;",0,";ITHETA2
  87. 8700 GOSUB 10200:IF ITYPE=2 THEN IXCENTER=IVALUE:GOTO 7800 ELSE GOTO 3700
  88. 8800 REM
  89. 8900 REM
  90. 9000 REM -- Come here to close file, etc., at end of plot --
  91. 9100 REM ===================================================
  92. 9200 CLOSE #1:IAPERTURE=-1:LPRINT"H":GOTO 2400
  93. 9300 REM
  94. 9400 REM ========== END OF MAIN ROUTINE....MAJOR SUBROUTINES FOLLOW.
  95. 9500 REM ===========================================================
  96. 9600 REM ===========================================================
  97. 9700 REM ===========================================================
  98. 9800 REM
  99. 9900 REM
  100. 10000 REM This subroutine reads the plot file and classifies the data strings.
  101. 10100 REM ====================================================================
  102. 10200 IF ISTR < NSTRINGMAX THEN 10900
  103. 10300 FOR ISTR=1 TO NSTRINGMAX
  104. 10400 IF NOT EOF(1) THEN 10600
  105. 10500 B$(ISTR)="^Z":ISTR=NSTRINGMAX:GOTO 10700
  106. 10600 INPUT #1,B$(ISTR)
  107. 10700 NEXT ISTR
  108. 10800 ISTR=0
  109. 10900 ISTR=ISTR+1:A$=B$(ISTR):IF A$="" THEN 10200
  110. 11000 IF A$ = "^Z" THEN ITYPE=3:RETURN 'DECLARE END OF FILE
  111. 11100 REM
  112. 11200 REM now test first character for a numeral or + or - or decimal point.
  113. 11300 IASC=ASC(A$):IF IASC=43 OR IASC=45 OR IASC=46 OR (IASC>47 AND IASC<58) THEN 11900
  114. 11400 REM
  115. 11500 REM Come here if string seems to be a command letter.
  116. 11600 ITYPE=1:VALUE=0!:IVALUE=0:RETURN
  117. 11700 REM
  118. 11800 REM Come here if string seems to be numerical data.
  119. 11900 ITYPE=2:VALUE=VAL(A$):IVALUE=VALUE
  120. 12000 RETURN
  121. 12100 REM
  122. 12200 REM
  123. 12300 REM This routine draws pad outlines.
  124. 12400 LPRINT"A";IX;",";IY
  125. 12500 ON IAPERTURE GOTO 12800,12800,12900,13000,13100,13200,13300,13400,13500,13600,13700,13800,13900,14000,14100
  126. 12600 REM Draw an X if iaperture is not between 1 and 15 inclusive.
  127. 12700 LPRINT"R-15,-15":LPRINT"I30,30":LPRINT"R-30,0":LPRINT"I30,-30":RETURN
  128. 12800 IRADIUS=1:GOTO 14600
  129. 12900 IRADIUS=2:GOTO 14600
  130. 13000 IRADIUS=2:GOTO 14600
  131. 13100 IRADIUS=4:GOTO 14600
  132. 13200 IRADIUS=6:GOTO 14600
  133. 13300 IRADIUS=8:GOTO 14600
  134. 13400 IRADIUS=10:GOTO 14600
  135. 13500 IRADIUS=12:GOTO 14600
  136. 13600 IRADIUS=16:GOTO 14600
  137. 13700 ISIDE=13:GOTO 14900
  138. 13800 ISIDE=16:GOTO 14900
  139. 13900 ISIDE=20:GOTO 14900
  140. 14000 ISIDE=25:GOTO 14900
  141. 14100 IRADIUS=25:GOSUB 14600:ISIDE=2*IRADIUS
  142. 14200 LPRINT"I";-ISIDE;",0":LPRINT"R";IRADIUS;",";IRADIUS
  143. 14300 LPRINT"I0,";-ISIDE:RETURN
  144. 14400 REM
  145. 14500 REM This section draws a round pad outline of radius IRADIUS.
  146. 14600 LPRINT"G";IRADIUS;",0,360":RETURN
  147. 14700 REM
  148. 14800 REM This section draws a square pad outline of size ISIDE.
  149. 14900 IHALF=ISIDE\2
  150. 15000 LPRINT"R";IHALF;",";-IHALF
  151. 15100 LPRINT"I0,";ISIDE;",";-ISIDE;",0,0,";-ISIDE;",";ISIDE;",0"
  152. 15200 RETURN
  153. 15300 REM
  154. 15400 REM This code required to avoid timeout error with Roland pen plotter.
  155. 15500 IF ERR=24 THEN RESUME 0
  156. 15600 ON ERROR GOTO 0
  157.