home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / mlpc / mfmcad_j.bas < prev    next >
Encoding:
BASIC Source File  |  1990-09-29  |  27.3 KB  |  844 lines
  1. 100 CLS : CLEAR
  2. 120 ON TIMER (1) GOSUB 6120
  3. 140 TIMER ON
  4. 150 ON ERROR GOTO 10600
  5. 160 '
  6. 170 '      ******      TITLE  SCREEN      ******
  7. 171 SCREEN 2,0,0: SCREEN 0,1,0,0:KEY OFF:COLOR 4,0,1:CLS
  8. 172 PRINT:PRINT
  9. 173 PRINT:PRINT
  10. 180 PRINT "        ************************************************************"
  11. 200 PRINT "        ******  COMPUTER ASSISTED DESIGN AND DRAWING PROGRAM  ******"
  12. 220 PRINT "        ************************************************************"
  13. 222 PRINT:PRINT:PRINT
  14. 224 PRINT "                      COLOR VERSION  -  WRITTEN  BY:  "
  15. 226 PRINT:PRINT
  16. 228 PRINT "                            MICHAEL F. MILAN "
  17. 230 PRINT:PRINT "                                  1985"
  18. 232 FOR W7=1 TO 5000: NEXT W7
  19. 240 '
  20. 260   KEY OFF
  21. 280 DIM PIXARAY%(7361)
  22. 300 DIM STORE%(7361)
  23. 310 DIM X(20),Y(20),B(20),XP(100),YP(100)
  24. 315  CV=160:CH=100:CLR=2
  25. 320 '
  26. 340 '******      INSTRUCTION SCREENS      ******
  27. 360 '
  28. 380 SCREEN 2,0,0:CLS
  29. 400 SCREEN 0,1,0,0:CLS: COLOR 15,1,4 : KEY OFF : CLS
  30. 420  L$= "COMPUTER ASSISTED DESIGN     BY      MICHAEL F. MILAN  M.D."
  31. 440  GOSUB 5960
  32. 460 COLOR 6,1,4
  33. 480 PRINT TAB(6)"*********************************************************************" : PRINT
  34. 500 COLOR 15,1,4
  35. 520 PRINT"USE NUMERIC KEYPAD TO DRAW"TAB(50)"DIAG'S ANGLE = 45 DEGREES"
  36. 540 PRINT
  37. 560 PRINT"SPACE BAR TO CHANGE COLOR OF CURSOR " TAB(50)"X KEY TO END "
  38. 580 PRINT
  39. 600 COLOR 0,1,4
  40. 620 PRINT "CTRL F-1 : X=7,Y=6   CURSOR MOVEMENT" TAB(50)"SHIFT F-1  : CIRCLE"
  41. 640 PRINT "CTRL F-2 : X=01,Y=1  CURSOR MOVEMENT" TAB(50)"SHIFT F-2  : CHANGE DIAG (A/B)"
  42. 660 PRINT "CTRL F-3 : ELIPSE GENERATOR " TAB(50)"SHIFT F-3  : DRAW ANY ANGLE "
  43. 680 PRINT "CTRL F-4 : CHANGE CURSOR MOTION (X,Y)" TAB(50)"SHIFT F-4  : PIE CHART"
  44. 700 PRINT "CTRL F-5 : DRAW LINE   " TAB(50)"SHIFT F-5  : "
  45. 720 PRINT "CTRL F-6 : FILLED RECTANGLE" TAB(50)"SHIFT F-6  :"
  46. 740 PRINT "CTRL F-7 : RECTANGLE" TAB(50)"SHIFT F-7  :"
  47. 760 PRINT "CTRL F-8 : *PAINT* INSIDE OF FIGURE" TAB(50)"SHIFT F-8  :"
  48. 780 PRINT "CTRL F-9 : PRESENT (X,Y) POSITION" TAB(50)"SHIFT F-9  :JOYSTICK DRAWING"
  49. 800 PRINT "CTRL F-10: CHANGE CURSOR POSITION" TAB(50)"SHIFT F-10 :BEZIER CURVE FIT"
  50. 820 PRINT
  51. 840 COLOR 14,1
  52. 860 PRINT "PROGRAM SAVE:   S=SAVE SCREEN  E=ERASE  O=OVERLAY  R=REPLACE  P=PRINT ON SCREEN"
  53. 865 PRINT
  54. 880 PRINT "DRAW LINE   :   B=DEFINE START LINE  T=DEFINE END LINE  (WITH CURSOR LOCATION)"
  55. 900 COLOR 15,1,4
  56. 920 SOUND 800,1: SOUND 1200,1: SOUND 1800,1
  57. 940 PRINT "STIKE ANY KEY"
  58. 960 K$=INKEY$: IF K$="" THEN 960:BEEP:CLS
  59. 980 '
  60. 1000 '      ******       INSTRUCTION SCREEN PAGE 2      ******
  61. 1020 '
  62. 1040 CLS: LOCATE 1,2:PRINT:PRINT
  63. 1060 COLOR 0,1,4
  64. 1080 PRINT " ALT F-1:  BSAVE SCREEN IMAGE " TAB(50) " \   TO CLEAR PROMPTS"
  65. 1100 PRINT " ALT F-2:  BLOAD SCREEN IMAGE "
  66. 1120 PRINT " ALT F-3:  SAVE FOR NEG. IMAGE"
  67. 1140 PRINT " ALT F-4:  LOAD FOR NEG. IMAGE"
  68. 1160 PRINT " ALT F-5:  BSAVE TO ANY FILE"
  69. 1180 PRINT " ALT F-6:  BLOAD TO ANY FILE"
  70. 1200 PRINT " ALT F-7:  SAVE PART OF SCREEN"
  71. 1220 PRINT " ALT F-8:  PUT TO NEW LOCATION"
  72. 1240 PRINT " ALT F-9:  CHANGE COLOR AND PALETTE"
  73. 1260 PRINT " ALT F-10: INSTRUCTION "
  74. 1280 PRINT:COLOR 6,1:PRINT "BEZEIR CURVE FITTING:   `.'  TO DEFINE CONTROL POINTS";
  75. 1282 PRINT TAB(24) "` C ' TO CLEAR ALL CONTROL POINTS"
  76. 1284 PRINT:PRINT:PRINT TAB(24) "PRESS JOYSTICK BUTTON (2) TO ACTIVATE CURSOR KEYS AGAIN" :PRINT:PRINT
  77. 1300 COLOR 14,1: PRINT "STRIKE ANY KEY TO SELECT BACKGROUND COLOR AND PALETTE"
  78. 1320 BEEP
  79. 1340 '
  80. 1360 SOUND 200,1: SOUND 400,1: SOUND 800,1: SOUND 1600,1: SOUND 3200,1
  81. 1380 K$=INKEY$: IF K$="" THEN 1380
  82. 1400 '                   ************************
  83. 1420 '                   * MAIN CAD PROGRAM !!! *
  84. 1440 '                   ************************
  85. 1460 CLS
  86. 1480 GOSUB 7880
  87. 1500 '
  88. 1520 A=7 : B=6 : W$=" 45 DEGREE MODE "
  89. 1540 ' CV=160:CH=100:CLR=1
  90. 1560 PSET (CV,CH)
  91. 1580 PSET (CV,CH)
  92. 1600 '
  93. 1620 '      ******      KEYPAD FUNCTIONS DEFINED      ******
  94. 1640 '
  95. 1660 K$=INKEY$: IF K$="  " THEN 1660
  96. 1680 IF LEN(K$)>1 THEN 2220
  97. 1700 IF K$="X" OR K$="x" THEN 1720 ELSE 1740
  98. 1720 SCREEN 2,0,0: CLS: KEY ON : END
  99. 1740 'STOR
  100. 1760 IF K$="S" OR K$="s" THEN OLDX=CV:OLDY=CH:OLDCOLR=POINT(CV,CH):GET(0,8)-(319,191),STORE%:BEEP:STORFLAG=1: PSET (OLDX,OLDY),OLDCOLR:GOTO 2120
  101. 1780  'OVERLAY
  102. 1800 IF K$="O" OR K$="o" THEN PUT (0,8),STORE%,OR:BEEP:PSET(OLDX,OLDY),OLDCOLR:GOTO 2120
  103. 1820  'REPL
  104. 1840 IF K$="R" OR K$="r" THEN PUT(0,8),STORE%,PSET:BEEP:PSET (OLDX,OLDY),OLDCOLR:GOTO 2120
  105. 1860 '
  106. 1880 IF K$="E" OR K$="e" THEN CLS:PSET (CV,CH):GOTO 2120
  107. 1900 IF K$="B" OR K$="b" THEN STARTX=POINT(0):STARTY=POINT(1):BEEP:GOTO 2120
  108. 1920 IF K$="T" OR K$="t" THEN ENDX=POINT(0)  :ENDY=POINT(1)  :BEEP:GOTO 10060
  109. 1923 IF K$="P" OR K$="p" THEN BEEP :GOSUB 4422
  110. 1926 IF K$="[" OR K$="{" THEN STARTX=POINT(0):STARTY=POINT(1):BEEP:GOTO 2120
  111. 1928 IF K$="]" OR K$="}" THEN ENDX=POINT(0)  :ENDY=POINT(1)  :BEEP:GOTO 2120
  112. 1930 IF K$="."           THEN GOSUB 11000
  113. 1931 IF K$="C" OR K$="c" THEN GOSUB 11200
  114. 1932 IF K$="N" THEN W$=SPC(20):GOTO 2120
  115. 1935 IF K$="\" THEN GOSUB 11300           ' ERASE PROMPT AREA
  116. 1940 '
  117. 1952 '
  118. 1954 '
  119. 1960 '      ******      COLOR CHANGE WITH SPACE BAR      ******
  120. 1980 '
  121. 2000 IF K$<>CHR$(32) THEN 1660
  122. 2020 CLR=CLR+1 : IF CLR>3 THEN CLR=0
  123. 2040 PSET (CV,CH),CLR
  124. 2060 '
  125. 2080 '      ******      HEADING DISPLAYED      ******
  126. 2100 '
  127. 2120  LOCATE 1,(42-LEN(W$))/2:PRINT W$
  128. 2130 TIMER ON
  129. 2140 GOTO 1660
  130. 2160 '
  131. 2180 '      ******      CURSOR KEYS ACTIVATED       ******
  132. 2200 '
  133. 2220 K= ASC (RIGHT$(K$,1))
  134. 2240 SOUND 1200,1
  135. 2260 '
  136. 2280 '
  137. 2300 '      ******      CURSOR KEYS      ******
  138. 2320 '
  139. 2340 '
  140. 2360 IF K=72  THEN GOSUB 3380   ' UP
  141. 2380 IF K=80  THEN GOSUB 3480   ' DOWN
  142. 2400 IF K=77  THEN GOSUB 3600   ' RIGHT
  143. 2420 IF K=75  THEN GOSUB 3720   ' LEFT
  144. 2440 IF K=71  THEN GOSUB 3840   ' UP AND LEFT
  145. 2460 IF K=73  THEN GOSUB 3960   ' UP AND RIGHT
  146. 2480 IF K=79  THEN GOSUB 4080   ' DOWN AND LEFT
  147. 2500 IF K=81  THEN GOSUB 4200   ' DOWN AND RIGHT
  148. 2520 '
  149. 2540 '
  150. 2560 IF K=84  THEN GOSUB 8360  ' SHIFT F-1 CIRCLE GENERATOR
  151. 2580 IF K=85  THEN GOSUB 7180  ' SHIFT F-2 CHANGE DIAGONAL SUBROUTINE
  152. 2600 IF K=86  THEN GOSUB 8560  ' SHIFT F-3 RADIUS ANGLE DRAW
  153. 2620 IF K=87  THEN GOSUB 8860 ' SHIFT F-4 PIE CHART
  154. 2640 IF K=88  THEN GOSUB ***** ' SHIFT F-5
  155. 2660 IF K=89  THEN GOSUB ***** ' SHIFT F-6
  156. 2680 IF K=90  THEN GOSUB ***** ' SHIFT F-7
  157. 2700 IF K=91  THEN GOSUB ***** ' SHIFT F-8
  158. 2720 IF K=92  THEN GOSUB 20000 ' SHIFT F-9  JOYSTICK CONTROL
  159. 2740 IF K=93  THEN GOSUB 16000 ' SHIFT F-10 BEZIER CURVE FITTING
  160. 2760 '
  161. 2780 '
  162. 2800 IF K=94  THEN GOSUB 4320 ' CTRL F-1  CURSOR MOVEMENT: X=07, Y=6
  163. 2820 IF K=95  THEN GOSUB 4380 ' CTRL F-2  CURSOR MOVEMENT: X=1, Y=1
  164. 2840 IF K=96  THEN GOSUB 4500 ' CTRL F-3  ELIPSE SUBROUTINE
  165. 2860 IF K=97  THEN GOSUB 4760 ' CTRL F-4  CHANGE CURSOR MOTION TO ANY LENGTH
  166. 2880 IF K=98  THEN GOSUB 5200 ' CTRL F-5  LINE
  167. 2900 IF K=99  THEN GOSUB 5400 ' CTRL F-6  BOX WITH FILL
  168. 2920 IF K=100 THEN GOSUB 5620 ' CTRL F-7  BOX
  169. 2940 IF K=101 THEN GOSUB 7380 ' CTRL F-8  PAINT INTERIOR
  170. 2960 IF K=102 THEN GOSUB 5060 ' CTRL F-9  X,Y COORIDINATES OF CURSOR
  171. 2980 IF K=103 THEN GOSUB 4880 ' CTRL F-10 MOVE CURSOR TO ANY (X,Y)POSITION
  172. 3000 '
  173. 3020 '
  174. 3040 IF K=104 THEN GOSUB 6940  ' ALT F-1  BSAVE SCREEN
  175. 3060 IF K=105 THEN GOSUB 7040  ' ALT F-2  BLOAD SCREEN
  176. 3080 IF K=106 THEN GOSUB 6300  ' ALT F-3  SAVE SCREEN FOR CREATING NEG
  177. 3100 IF K=107 THEN GOSUB 6580  ' ALT F-4  LOAD SCREEN FOR NEGATINE IMAGE
  178. 3120 IF K=108 THEN GOSUB 10220 ' ALT F-5  BSAVE TO FILE OF CHOICE
  179. 3140 IF K=109 THEN GOSUB 10460 ' ALT F-6  BLOAD TO FILE OF CHOICE
  180. 3160 IF K=110 THEN GOSUB 6862  ' ALT F-7  SAVE PART OF SCREEN
  181. 3180 IF K=111 THEN GOSUB 6880  ' ALT F-8  PUT TO NEW LOCATION
  182. 3200 IF K=112 THEN GOSUB 7760  ' ALT F-9   COLOR INSTRUCTIONS
  183. 3220 IF K=113 THEN GOTO  3280  ' ALT F-10  INSTRUCTIONS REVEIW
  184. 3240 '
  185. 3260 ' SAVE SCREEN WHILE DISPLAYING INSTRUCTIONS!
  186. 3280 GET (0,8)-(319,191),PIXARAY%: INSTRFLAG=1 : GOTO 380
  187. 3300 GOTO 1660
  188. 3320 '
  189. 3340 '      ******      EXECUTION OF CURSOR MOTION      ******
  190. 3360 '
  191. 3380 LINE (CV,CH)-(CV,CH-B),CLR    'UP
  192. 3400 CV=CV: CH=CH-B
  193. 3420 PSET (CV,CH)
  194. 3440 RETURN 2120
  195. 3460 '
  196. 3480 LINE (CV,CH)-(CV,CH+B),CLR    'DOWN
  197. 3500 CV=CV: CH=CH+B
  198. 3520 PSET (CV,CH)
  199. 3540 RETURN 2120
  200. 3560 '
  201. 3580 '
  202. 3600 LINE (CV,CH)-(CV+A,CH),CLR    'RIGHT
  203. 3620 CV=CV+A: CH=CH
  204. 3640 PSET (CV,CH)
  205. 3660 RETURN 2120
  206. 3680 '
  207. 3700 '
  208. 3720 LINE (CV,CH)-(CV-A,CH),CLR    'LEFT
  209. 3740 CV=CV-A: CH=CH
  210. 3760 PSET (CV,CH)
  211. 3780 RETURN 2120
  212. 3800 '
  213. 3820 '
  214. 3840 LINE (CV,CH)-(CV-A,CH-B),CLR     'UP & LEFT
  215. 3860 CV=CV-A: CH=CH-B
  216. 3880 PSET (CV,CH)
  217. 3900 RETURN 2120
  218. 3920 '
  219. 3940 '
  220. 3960 LINE (CV,CH)-(CV+A,CH-B),CLR     'UP & RIGHT
  221. 3980 CV=CV+A:CH=CH-B
  222. 4000 PSET (CV,CH)
  223. 4020 RETURN 2120
  224. 4040 '
  225. 4060 '
  226. 4080 LINE (CV,CH)-(CV-A,CH+B),CLR     'DOWN & LEFT
  227. 4100 CV=CV-A:CH=CH+B
  228. 4120 PSET (CV,CH)
  229. 4140 RETURN 2120
  230. 4160 '
  231. 4180 '
  232. 4200 LINE (CV,CH)-(CV+A,CH+B),CLR     'DOWN & RIGHT
  233. 4220 CV=CV+A:CH=CH+B
  234. 4240 PSET (CV,CH)
  235. 4260 RETURN 2120
  236. 4280 '
  237. 4300 '
  238. 4320 A=7 : B=6 :W$="45 DEGREE MODE     "
  239. 4330 LOCATE 1,1:PRINT SPC(39)
  240. 4340 RETURN 2120
  241. 4360 '
  242. 4380 A=1 : B=1 : W$="X & Y MOVEMENT=1"
  243. 4390 LOCATE 1,1:PRINT SPC(39)
  244. 4400 RETURN 2120
  245. 4420 '
  246. 4422 '      ******      SCREEN LABEL SUBROUTINE      ******
  247. 4423 LOCATE 1,1:PRINT SPC(39)
  248. 4424 LOCATE 1,1: INPUT "ENTER LABEL";P$
  249. 4425 XP=(CV/8)+.5: YP=(CH/8)+.5
  250. 4426 LOCATE YP,XP:PRINT P$
  251. 4427 LOCATE 1,1:PRINT SPC(39)
  252. 4428 CV=CV+6
  253. 4429 PSET (CV,CH),2
  254. 4430 RETURN 2120
  255. 4432 '
  256. 4440 '
  257. 4460 '      ******       CIRCLE SUBROUTINE      ******
  258. 4480 '
  259. 4500 LOCATE 1,1: PRINT"                                                   "
  260. 4520 LOCATE 1,1: INPUT "ENTER RADIUS";R
  261. 4540 LOCATE 1,1: INPUT "COLOR: 0,1,2,3)";C
  262. 4560 LOCATE 1,1: INPUT "  START IN DEGREES";F
  263. 4580 LOCATE 1,1: INPUT "       END IN DEGREES  ";E
  264. 4600 LOCATE 1,1: INPUT "                 ASPECT RATIO";A2
  265. 4620 PI=3.141593 : F=F*PI/180 : E=E*PI/180
  266. 4640 CIRCLE (CV,CH),R,C,F,E,A2
  267. 4660 LOCATE 1,1:PRINT"                                               "
  268. 4680 RETURN 2120
  269. 4700 '
  270. 4720 '      ******      GIVE CURSOR ANY MOTION       ******
  271. 4740 '
  272. 4760 LOCATE 1,1: INPUT "CURSOR MOTION X,Y";A,B
  273. 4780 LOCATE 1,1: PRINT "                                             "
  274. 4800 RETURN 2120
  275. 4820 '
  276. 4840 '      ******      MOVE CURSOR TO ANY POSITION      ******
  277. 4860 '
  278. 4880 LOCATE 1,1: INPUT "CURSOR POSITION: X , Y " ; X2,Y2
  279. 4900 LOCATE 1,1: PRINT "                                              "
  280. 4920 PRESET (CV,CH)
  281. 4940 CV=X2 : CH=Y2
  282. 4960 PSET (CV,CH)
  283. 4980 RETURN 2120
  284. 5000 '
  285. 5020 '      ******      PRESENT CURSOR POSITION      ******
  286. 5040 '
  287. 5060 LOCATE 1,1:PRINT "CURSOR AT:(X,Y)" TAB(30) "("CV",";CH")" TAB(60) "SPACE BAR TO CONT."
  288. 5080 IF INKEY$=CHR$(32) THEN 5100 ELSE 5060
  289. 5100 LOCATE 1,1: PRINT "                                                                               "
  290. 5120 RETURN 2120
  291. 5140 '
  292. 5160 '      ******      LINE USING PHYSICAL COORIDANATES      ******
  293. 5180 '
  294. 5200 LOCATE 1,1:INPUT "DRAW LINE FROM (X,Y) TO (X1,Y1)";S,T,U,V
  295. 5220 LOCATE 1,1:PRINT"                                                        "
  296. 5240 LOCATE 1,1:INPUT "COLOR (0,1,2,3)";W
  297. 5260 LOCATE 1,1:PRINT"                                                        "
  298. 5280 LOCATE 1,1:PRINT"                                                       "
  299. 5300 LINE (S,T)-(U,V),W
  300. 5320 RETURN 2120
  301. 5340 '
  302. 5360 '      ******      RECTANGLE FILLED WITH COLOR      ******
  303. 5380 '
  304. 5400 LOCATE 1,1: INPUT "RECTANGLE; DIAGONAL FROM (X,Y) TO (X1,Y1)";S,T,U,V
  305. 5420 LOCATE 1,1:PRINT "                                                               "
  306. 5440 LOCATE 1,1: INPUT "COLOR (0,1,2,3)";W
  307. 5460 LOCATE 1,1:PRINT "                                                    "
  308. 5480 PRESET (CV,CH)
  309. 5500 LINE (S,T)-(U,V),W,BF
  310. 5520 CV=U:CH=V
  311. 5540 RETURN 2120
  312. 5560 '
  313. 5580 '      ******      RECTANGLE WITHOUT FILLED COLOR      ******
  314. 5600 '
  315. 5620 LOCATE 1,1:  INPUT "RECTANGLE; DIAGONAL FROM (X,Y)TO (X1,Y1)";S,T,U,V
  316. 5640 LOCATE 1,1:PRINT"                                                        "
  317. 5660 LOCATE 1,1:  INPUT "COLOR (0,1,2,3)";W
  318. 5680 LOCATE 1,1:PRINT "                                    "
  319. 5700 PRESET (CV,CH)
  320. 5720 LINE (S,T)-(U,V),W,B
  321. 5740 CV=U:CH=V
  322. 5760 RETURN 2120
  323. 5780 '
  324. 5800 '
  325. 5820 '      ******       CENTERED TITLE      ******
  326. 5840 '
  327. 5860 '
  328. 5880 GOTO 200 ' GO TO MAIN PROGRAM
  329. 5900 '
  330. 5920 '
  331. 5940 '
  332. 5960 ' L$ IS A STRING CONTAINING A TITLE
  333. 5980 '
  334. 6000 LOCATE 1, (80-LEN(L$))/2
  335. 6020 PRINT L$
  336. 6040 RETURN
  337. 6060 '
  338. 6080 '      ******       TIME DISPLAY SUBROUTINE      ******
  339. 6100 '
  340. 6120 OLDROW=CSRLIN ' SAVE CURRENT ROW
  341. 6140 OLDCOL=POS(0) ' SAVE CURRENT COLUMN
  342. 6160 LOCATE 1,1:PRINT TIME$;
  343. 6180 LOCATE OLDROW,OLDCOL    'RESTORE ROW & COL
  344. 6200 RETURN
  345. 6220 '
  346. 6240 '
  347. 6260 '   ****** STORAGE SUBROUTINES ******
  348. 6280 '
  349. 6300 ' PUT SCREEN IMAGE INTO ARRAY
  350. 6320 ERASE PIXARAY%: ' TO REDIMENSION
  351. 6340 DIM PIXARAY% (7361): 'SCREEN
  352. 6360 GET (0,8)-(319,191),PIXARAY%
  353. 6380 '
  354. 6400 'PUT IN DISK
  355. 6420 OPEN "PICTURE" FOR OUTPUT AS #1
  356. 6440 FOR ELEMENT=0 TO 7361
  357. 6460 PRINT #1, PIXARAY%(ELEMENT)
  358. 6480 NEXT ELEMENT
  359. 6500 CLOSE
  360. 6520 PSET (CV,CH)
  361. 6540 RETURN 2120
  362. 6560 '
  363. 6580 ' READ IMAGE FROM DISK INTO ARRAY
  364. 6600 ERASE PIXARAY%: ' CLEAR
  365. 6620 DIM PIXARAY%(7361)
  366. 6640 ELEMENT=0
  367. 6660 OPEN "PICTURE" FOR INPUT AS #1
  368. 6680 IF EOF(1) THEN CLOSE: GOTO 6800
  369. 6700 INPUT #1, PIXARAY%(ELEMENT)
  370. 6720 ELEMENT=ELEMENT+1
  371. 6740 GOTO 6680
  372. 6760 '
  373. 6780 ' PUT ARRAY BACK ON SCREEN
  374. 6800  PUT (0,8), PIXARAY%, PRESET
  375. 6820 PRESET (CV,CH)
  376. 6840 RETURN 2120
  377. 6860 '
  378. 6862 '      ******      SAVE PART OF SCREEN      ******
  379. 6864 ERASE PIXARAY%
  380. 6866 T5=4+INT(((STARTX-ENDX)*2+7)/8)*(STARTY-ENDY)
  381. 6868 DIM PIXARAY%(T5)
  382. 6870 GET (STARTX,STARTY)-(ENDX,ENDY),PIXARAY%
  383. 6872 PSET (CV,CH)
  384. 6874 RETURN 2120
  385. 6876 '
  386. 6878       ******      PUT PART OF SCREEN TO NEW LOCATION      ******
  387. 6880 '
  388. 6882 PUT (STARTX,STARTY),PIXARAY%,OR  ' OVERLAY
  389. 6884 BEEP
  390. 6886  PSET (CV,CH):PSET (ENDX,ENDY),0
  391. 6888 RETURN 2120
  392. 6889 '      ******      SAVE IMAGE ON DISK IN FILE "IMAGE.BIN"      ******
  393. 6900 '
  394. 6920 ' SAVE ONTO DISK WITH BSAVE AND BLOAD
  395. 6940 DEF SEG=&HB800: 'COLOR BUFFER
  396. 6960 BSAVE "IMAGE.BIN",0,16192
  397. 6980 CLS
  398. 7000 PSET (CV,CH)
  399. 7020 RETURN 2120
  400. 7040 DEF SEG=&HB800: '
  401. 7060 BLOAD "IMAGE.BIN",0
  402. 7080 DEF SEG
  403. 7100 PSET (CV,CH)
  404. 7120 RETURN 2120
  405. 7140 '
  406. 7160 '
  407. 7180 '      ******      DIAGNAL ANGLE SUBROUTINE      ******
  408. 7200 '
  409. 7220 LOCATE 1,1:PRINT"                                                 "
  410. 7240 LOCATE 1,1
  411. 7260 INPUT "DIAG. ANGLE: 30 , 45 , 60";M
  412. 7280 LOCATE 1,1:PRINT"                                               "
  413. 7300 IF M=30 THEN A=6: B=9:W$="30 DEGREE MODE"
  414. 7320 IF M=45 THEN A=7: B=6:W$="45 DEGREE MODE"
  415. 7340 IF M=60 THEN A=11:B=5:W$="60 DEGREE MODE"
  416. 7360 RETURN 2120
  417. 7380 '
  418. 7400 '       ******      PAINT SUBROUTINE       ******
  419. 7420 '
  420. 7440 CLR=OLDCLR
  421. 7460 LOCATE 1,1:INPUT "PAINT; PALETTE #: (0,1,2,3) ";C3
  422. 7480 LOCATE 1,1:PRINT"                                         "
  423. 7500 LOCATE 1,1:INPUT "WHAT IS BOUNDRY COLOR";C7
  424. 7520 LOCATE 1,1:PRINT"                                           "
  425. 7580 PAINT (CV-24,CH),C3,C7
  426. 7600 PSET (CV,CH),C3
  427. 7620 '
  428. 7640 RETURN 2120
  429. 7660 '
  430. 7680 PAINT (CV,CH),0,0
  431. 7700 'PSET (CV,CH)
  432. 7720 '
  433. 7740 RETURN 2120
  434. 7760 '
  435. 7780 '
  436. 7800 '      ******      COLOR SELECTION SUBROUTINE      ******
  437. 7820 '
  438. 7840 GET (0,8)-(319,191),PIXARAY% : INSTRFLAG=1
  439. 7860 SCREEN 2:CLS
  440. 7880 SCREEN 0,1,0,0 : COLOR 15,8,1 : CLS
  441. 7900 LOCATE 1,27: PRINT" SELECT COLORS FROM LIST "
  442. 7920 PRINT : PRINT
  443. 7940 PRINT"        BACKGROUND                        PALETTE"
  444. 7960 PRINT
  445. 7980 PRINT "  0 BLACK     8 GRAY                 0:     1 GREEN"
  446. 8000 PRINT "  1 BLUE      9 LIGHT BLUE                  2 RED  "
  447. 8020 PRINT "  2 GREEN    10 LIGHT GREEN                 3 BROWN"
  448. 8040 PRINT "  3 CYAN     11 LIGHT CYAN                         "
  449. 8060 PRINT "  4 RED      12 LIGHT RED            1:     1 CYAN "
  450. 8080 PRINT "  5 MAGENTA  13 LIGHT MAGENTA               2 MAGENTA"
  451. 8100 PRINT "  6 BROWN    14 YELLOW                      3 WHITE  "
  452. 8120 PRINT "  7 WHITE    15 HIGH INTENSITY WHITE                 "
  453. 8140 COLOR 4,8,1:PRINT"***************************************************************************"
  454. 8160 COLOR 15,8,1:PRINT:
  455. 8180 INPUT "DO YOU WANT TO CHANGE COLOR SETTINGS? Y/N";K$
  456. 8200 IF K$="Y" OR K$="y"  THEN 8240
  457. 8220 IF K$="N" OR K$="n"  THEN  8300
  458. 8240 PRINT:PRINT:
  459. 8260 INPUT "BACKGROUND COLOR 1-15";KK
  460. 8280 INPUT "PALETTE NUMBER 1 OR 0";JJ
  461. 8300 CLS : SCREEN 1,0 : COLOR KK,JJ
  462. 8310 IF INSTRFLAG=1 THEN PUT(0,8),PIXARAY%,OR : INSTRFLAG=0 : GOTO 2120
  463. 8320 RETURN 1500
  464. 8340 '
  465. 8360 '      ******      CILCLE SUBROUTINE (MEDIUM RESOLUTION)      ******
  466. 8380 '
  467. 8400 LOCATE 1,1:PRINT"                                                "
  468. 8420 LOCATE 1,1:INPUT "RADIUS";R3
  469. 8440 LOCATE 1,1:INPUT "COLOR:  0,1,2,3:";C3
  470. 8460 LOCATE 1,1:PRINT "                                               "
  471. 8480 '
  472. 8500 CIRCLE (CV,CH),R3,C3,,,.8333
  473. 8520 '
  474. 8540 RETURN 2120
  475. 8560 '
  476. 8580 '
  477. 8600 '      ******      ANGLES GENERATED BY RADIUS DRAWING      ******
  478. 8620 '
  479. 8640 LOCATE 1,1:PRINT "                                               "
  480. 8660 LOCATE 1,1:INPUT "LENGTH OF SIDES ";R4
  481. 8680 LOCATE 1,1:INPUT "               COLOR  ";C4
  482. 8700 LOCATE 1,1:INPUT "HEADING (IN DEGREES) SIDE 1";F4
  483. 8720 LOCATE 1,1:INPUT "    HEADING (IN DEGREES) SIDE 2";E4
  484. 8740 PI=3.141593 : F4=F4*PI/180 :  E4=E4*PI/180
  485. 8760 '
  486. 8780 CIRCLE (CV,CH),R4,C4,-F4,-E4,.8333
  487. 8800 CIRCLE (CV,CH),R4,0 , F4, E4,.8333
  488. 8820 LOCATE 1,1:PRINT"                                                    "
  489. 8840 RETURN 2120
  490. 8860 '
  491. 8880 ' *********************************************************************
  492. 8900 ' ******                     PIE CHART                           ******
  493. 8920 ' *********************************************************************
  494. 8940 ' SCREEN 1,0 : COLOR 1,1
  495. 8960 ' CLS
  496. 8980 '
  497. 9000 PI=3.1415926535#
  498. 9020 DIM SECTOR%(25)
  499. 9040 '
  500. 9060 LOCATE 1,10: PRINT "TO STOP, ENTER A NEGATIVE"
  501. 9080 FOR D5= 1 TO 1000:NEXT D5
  502. 9100 TOTAL = 0
  503. 9120 J2 = 0
  504. 9140 ' INPUT LOOP
  505. 9160 J2 = J2+1
  506. 9180 LOCATE 1,1: PRINT "                                          "
  507. 9200 LOCATE 1,1: INPUT "SIZE OF SECTOR";SECTOR%(J2)
  508. 9220 LOCATE 1,1: PRINT "                                          "
  509. 9240 '  LOCATE 1,1: INPUT SECTOR(J2)
  510. 9260 IF SECTOR%(J2)<0 THEN 9340
  511. 9280 TOTAL = TOTAL+SECTOR%(J2)
  512. 9300 GOTO 9140
  513. 9320 '
  514. 9340 ' CONTINUE
  515. 9360 LOCATE 1,1: INPUT "RADIUS";RADIUS
  516. 9380 LOCATE 1,1:PRINT"                                                 "
  517. 9400 N=J2-1
  518. 9420 '
  519. 9440 IF CV=160 AND CH=100 THEN 9460 ELSE 9480
  520. 9460 LOCATE 22,1:PRINT"TOTAL=";TOTAL
  521. 9480 LOCATE 1,1:INPUT "TITLE OF PIE CHART";W$
  522. 9490 LOCATE 1,1:PRINT"                                                   "
  523. 9500 '
  524. 9520 BEGA=0
  525. 9540 ' (RADIUS LINE)
  526. 9560 '
  527. 9580 FOR J2=1 TO N
  528. 9600  ENDA=2*PI*SECTOR%(J2)/TOTAL+BEGA
  529. 9620  MIDA=(BEGA+ENDA)/2
  530. 9640 '
  531. 9660  X9 = CV+COS(MIDA)*RADIUS*1.2
  532. 9680  Y9 = CH-SIN(MIDA)*RADIUS*1
  533. 9700  M$ = STR$(SECTOR%(J2))
  534. 9720  LOCATE (Y9+5)/8, X9/8-LEN(M$)/2 +.5
  535. 9740 PRINT M$;
  536. 9760 '
  537. 9780   A1 = -BEGA-.001
  538. 9800   A2 = -ENDA
  539. 9820   CIRCLE(CV,CH),RADIUS,,A1,A2
  540. 9840 '
  541. 9860 BEGA=ENDA
  542. 9880  X9 = CV+COS(MIDA)*RADIUS/2
  543. 9900  Y9 = CH-SIN(MIDA)*RADIUS/2
  544. 9920  PAINT (X9,Y9),(J2 MOD 4),3
  545. 9940 NEXT J2
  546. 9960 '
  547. 9980 ERASE SECTOR%
  548. 10000 RETURN 2120
  549. 10020 '
  550. 10040 '      ******      LINE USING CURSOR POSITION      ******
  551. 10060 '
  552. 10080 ' ###################################################################
  553. 10100 '       ******      LINE BY CURSOR POSITION      ******
  554. 10120 '
  555. 10140 LINE (STARTX,STARTY)-(ENDX,ENDY),CLR
  556. 10160 PSET (CV,CH)
  557. 10180 GOTO 2120
  558. 10200 ' ###################################################################
  559. 10220 '
  560. 10240 '      ******       SAVE ONTO DISK WITH BSAVE AND BLOAD      ******
  561. 10260 '
  562. 10280 LOCATE 1,1: INPUT "WHAT IS THE NAME OF FILE";FILE$
  563. 10300 LOCATE 1,1:PRINT"                                                       "
  564. 10320 DEF SEG=&HB800: 'COLOR BUFFER
  565. 10340 BSAVE FILE$ ,0,16192
  566. 10360 CLS
  567. 10380 PSET (CV,CH)
  568. 10400 RETURN 2120
  569. 10420 '
  570. 10440 '      ******       LOAD TO SCREEN IMAGE FROM DISK FILE      ******
  571. 10460 '
  572. 10480 DEF SEG=&HB800: '
  573. 10500 LOCATE 1,1:INPUT"WHAT IS THE FILE NAME ";FILE$
  574. 10520 LOCATE 1,1:PRINT"                                                       "
  575. 10540 BLOAD FILE$,0
  576. 10560 DEF SEG
  577. 10580 RETURN 2120
  578. 10600 '
  579. 10610 '   ******   ERROR TRAP   ******
  580. 10620 BEEP:BEEP:BEEP
  581. 10625 TIMER OFF
  582. 10630 LOCATE 1,1:PRINT SPC(39)
  583. 10640 LOCATE 25,1:PRINT SPC(39)
  584. 10650 LOCATE 1,1:PRINT "ERROR # " ERR "IN LINE" ERL;
  585. 10660 RESUME 10670
  586. 10670 POKE 1050,PEEK(1052)
  587. 10680 LOCATE 25,1:PRINT " -PRESS ANY KEY TO CONTINUE";
  588. 10690 K$=INKEY$: IF K$="" THEN 10690
  589. 10700 GOSUB 10720
  590. 10710 GOTO 2120
  591. 10720 LOCATE 1,1:PRINT SPC(39)
  592. 10730 LOCATE 25,1:PRINT SPC(39)
  593. 10740 RETURN
  594. 10750 '
  595. 11000 '
  596. 11010 ' ******      PLOT CONTROL POINTS FOR BEZEIR CURVE FITTING     ******
  597. 11020 X(I)=POINT(0): Y(I)=POINT(1)
  598. 11030 '     W$=VAL(X(I)) "," VAL(Y(I))
  599. 11040 NC=NC+1  :  I=I+1
  600. 11050 BEEP
  601. 11060 IF NC=>21 THEN W$="> LIMIT CON. PTS." ELSE W$="ANOTHER CONTROL POINT?"
  602. 11070 RETURN 2120
  603. 11080 '
  604. 11200 '
  605. 11210 '      ******   CLEAR CONTROL POINTS (BEZEIR CURVE FITTING)   ******
  606. 11220 FOR I2=0 TO I
  607. 11230   X(I)=0 :Y(I)=0
  608. 11235 I=I+1
  609. 11240 NEXT I2
  610. 11250 NC=0 : I=0
  611. 11255 BEEP:BEEP
  612. 11260 RETURN 2120
  613. 11270 '
  614. 11280 '
  615. 11300 '
  616. 11320 '      ******      CLEAR PROMPT AREAS      ******
  617. 11340 '
  618. 11350 TIMER OFF
  619. 11360 LOCATE 1,1:PRINT SPC(39)
  620. 11380 LOCATE 25,1: PRINT SPC(39)
  621. 11400 IF INKEY$="" THEN 11400
  622. 11420 BEEP
  623. 11440 RETURN 2120
  624. 11460 '
  625. 11480 '
  626. 16000 '      ***********************************************
  627. 16020 '      ***********      BEZFIT      ******************
  628. 16040 '      ***********************************************
  629. 16060 '
  630. 16080 '
  631. 16100 '     ***   BEZFIT FOR INTERACTIVE BEZIER CURVE FITTING   ***
  632. 16120 '
  633. 16124 TIMER OFF
  634. 16140 '  DIM X(20),Y(20),B(20),XP(100),YP(100)
  635. 16160 '                 KEY OFF:  SCREEN 1,0,0,0: COLOR 0,0  CLS
  636. 16180 DEF FN  LCASE$(A$)=CHR$(ASC(A$+" ") -32*("A"<=A$ AND A$<="Z"))
  637. 16200 DUMP$="BEZDUMP":  B$=CHR$(29)
  638. 16220 ON ERROR GOTO 19820
  639. 16240 '
  640. 16260 '     ***   DISPLAY MAIN MENU AND BRANCH ON RESPONSE   ***
  641. 16280 '
  642. 16300 CO=CLR
  643. 16310 FLAG=0
  644. 16320 GOSUB 18620
  645. 16335 LOCATE 1,1
  646. 16340  PRINT " 1 PLOT 2 ERASE 3 CHANGE CURVE OR LINE"
  647. 16360 LOCATE 25,1
  648. 16380 PRINT "4 DUMP 5 CLEAR 6 RELD SCREEN 7 QUIT ";
  649. 16400 OP=VAL(INPUT$(1))
  650. 16420 GOSUB 18620: ON OP GOTO 16540,17160,17260,18000,18200,18300,18500
  651. 16440 GOSUB 18760:  GOTO 16300
  652. 16460 '
  653. 16480 '
  654. 16500 '     ***   PLOT A CURVE   ***
  655. 16520 '
  656. 16540 LOCATE 1,1: PRINT "NUMBER OF CONTROL PTS.= ";NC
  657. 16560  IF NC<1 OR NC>21 THEN GOSUB 18740: GOTO 16260
  658. 16580 N=NC-1
  659. 16600 LOCATE 25,1
  660. 16620 PRINT " WANT TO SEE THE POINTS (TYPE y OR n): ";
  661. 16640 Q$=FN LCASE$(INPUT$(1)): GOSUB 18620
  662. 16660 FOR I=0 TO N
  663. 16690 LOCATE 1,1: PRINT SPC(39) : LOCATE 1,1
  664. 16700  PRINT "POINT" I+1 B$ ":" X(I) Y(I);
  665. 16740  IF Q$="y" THEN PSET (X(I),Y(I))
  666. 16760 LOCATE 25,1:  PRINT "TYPE k TO KEEP, c TO CHANGE: ";
  667. 16780  R$=FN LCASE$(INPUT$(1)):  GOSUB 18660
  668. 16800  IF R$<>"c" THEN 16900
  669. 16820   PRESET (X(I),Y(I))
  670. 16850 LOCATE 1,1
  671. 16860    PRINT SPC(18)
  672. 16880   GOTO 16680
  673. 16900 NEXT I
  674. 16920 IF N=0 THEN PSET (X(0),Y(0)),CO:  GOTO 16980
  675. 16940 IF N=1 THEN LINE (X(0),Y(0))-(X(1),Y(1)),CO:  GOTO 16980
  676. 16960 GOSUB 18920
  677. 16980 GOSUB 18620:  PRINT "PRESS ANY KEY TO ERASE THE DATA";
  678. 17000  IN$=INPUT$(1)
  679. 17020  LOCATE 1,1:PRINT SPC(39)
  680. 17040   LOCATE 25,1:  PRINT SPACE$(39);
  681. 17080  GOTO 16300
  682. 17100 '
  683. 17120 '   ***   ERASE A CURVE   ***
  684. 17140 '
  685. 17160 CO=0:FLAG=1
  686. 17180 GOTO 16540
  687. 17200 '
  688. 17220 '
  689. 17240 '   ***   ALTER A CURVE   ***
  690. 17260 GOSUB 18620
  691. 17270 LOCATE 1,1
  692. 17280  PRINT "1ERASE 1ST CURVE,2 DIS COORD,3 ALT PT ";
  693. 17320 LOCATE 25,1
  694. 17340  PRINT "4 DIS NEW CURVE, 5 RETURNS MAIN MENU: ";
  695. 17360 OQ=VAL(INPUT$(1))
  696. 17380 GOSUB 18620
  697. 17400 ON OQ GOTO 17480,17560,17700,17900,16300
  698. 17420  GOSUB 18740:  GOTO 17240
  699. 17440 '
  700. 17460 '   ***   ERASE THE LAST CURVE   ***
  701. 17480 CO=0:FLAG=1:  GOSUB 19520
  702. 17500 CO=CLR:FLAG=0: GOTO 17240
  703. 17520 '
  704. 17540 '   ***   DISPLAY THE COORDINATES   ***
  705. 17560 FOR I=0 TO N
  706. 17580 PSET ( X(I), Y(I) ),2
  707. 17620 NEXT I
  708. 17640 GOTO 17240
  709. 17660 '
  710. 17680 '   ***   ALTER A POINT   ***
  711. 17700 INPUT; "ID # OF POINT: ", I
  712. 17720  LOCATE 1,1: PRINT SPC(38)
  713. 17740 LOCATE 25,1: PRINT "OLD X,Y:" X(I-1) B$ ","Y(I-1);
  714. 17760 LOCATE 1,6:  INPUT; "NEW X: ",V$
  715. 17780   IF V$="" THEN PRINT X(I-1) B$; ELSE X(I-1)=VAL(V$)
  716. 17820 LOCATE 1,20:  INPUT; "NEW Y: ",V$
  717. 17840 IF V$="" THEN PRINT Y(I-1); ELSE Y(I-1)=VAL(V$)
  718. 17860 GOTO 17240
  719. 17880 '
  720. 17900 '   ***   DISPLAY NEW CURVE   ***
  721. 17920 GOSUB 18920
  722. 17940 GOTO 17240
  723. 17960 '
  724. 17980 '   ***   DUMP THE SCREEN   ***
  725. 18000 DEF SEG=&HB800
  726. 18020 PRINT "NAME OF FILE (WAS " DUMP$ "): ";
  727. 18040 INPUT; "", NEWDUMP$
  728. 18060 IF NEWDUMP$ <> "" THEN DUMP$=NEWDUMP$
  729. 18080 BSAVE DUMP$,0,&H4000
  730. 18100 DEF SEG=0
  731. 18120 GOTO 16300
  732. 18140 '
  733. 18160 '
  734. 18180 '   ***   CLEAR THE SCREEN   ***
  735. 18200 CLS
  736. 18220 GOTO 16300
  737. 18240 '
  738. 18260 '
  739. 18280 '   ***   RELOAD SCREEN   ***
  740. 18300 DEF SEG=&HB800
  741. 18320 PRINT "NAME OF FILE (WAS " DUMP$ "): ";
  742. 18340 INPUT; "", NEWDUMP$
  743. 18360 IF NEWDUMP$ <> "" THEN DUMP$=NEWDUMP$
  744. 18380 BLOAD DUMP$,0
  745. 18400 DEF SEG=0
  746. 18420 GOTO 16300
  747. 18440 '
  748. 18460 '
  749. 18480 '   ***   QUIT   ***
  750. 18500 CLOSE
  751. 18520 ON ERROR GOTO 0
  752. 18540 LOCATE 1,1
  753. 18560 GOTO 2120
  754. 18580 '
  755. 18600 '
  756. 18620 '   ***   CLEAR THE PROMPT AREA   ***
  757. 18640 LOCATE 1,1:  PRINT SPC(39)
  758. 18660 LOCATE 25,1:  PRINT SPC(39):  LOCATE 1,1
  759. 18680 RETURN
  760. 18700 '
  761. 18720 '
  762. 18740 '   ***   INVALID RESPONSE TO A PROMPT   ***
  763. 18760 GOSUB 18620:  PRINT "INVALID REQUEST";
  764. 18780  LOCATE 25,1: PRINT " - PRESS ANY KEY TO CONTINUE";
  765. 18800 LOCATE 1,1
  766. 18820 POKE 1050,PEEK(1052)
  767. 18840 IF INKEY$="" THEN 18840
  768. 18850 GOSUB 18640
  769. 18860 RETURN
  770. 18880 '
  771. 18900 '
  772. 18920 '   ***   PLOT A CURVE   ***
  773. 18940 GOSUB 18620
  774. 18960  INPUT; "NUMBER OF POINTS TO BE PLOTTED: ",NU
  775. 18980 IF NU<3 THEN RETURN ELSE IF NU>100 THEN NU=100
  776. 19000 NP=NU-2
  777. 19020 XP(0)=X(0)
  778. 19040 YP(0)=Y(0)
  779. 19060   FOR IP=1 TO NP
  780. 19080    LOCATE 25,30
  781. 19100     IF IP MOD 2 THEN PRINT "COMPUTING"; ELSE PRINT SPC(10)
  782. 19120   U=IP/(NP+1)
  783. 19140 B(0)=(1-U)^N:  B(N)=U^N
  784. 19160 IF IP>NP/2 THEN 19260
  785. 19180 FOR I=1 TO N-1
  786. 19200  B(I)=(N-I+1)/I * U/(1-U) * B(I-1)
  787. 19220 NEXT I
  788. 19240 GOTO 19320
  789. 19260  FOR I=N-1 TO 1 STEP -1
  790. 19280   B(I)=(I+1)/(N-I) * (1-U)/U * B(I+1)
  791. 19300 NEXT I
  792. 19320 XP(IP)=0
  793. 19340 YP(IP)=0
  794. 19360 FOR I=0 TO N
  795. 19380  XP(IP)=XP(IP)+B(I)*X(I)
  796. 19400  YP(IP)=YP(IP)+B(I)*Y(I)
  797. 19420 NEXT I
  798. 19440 NEXT IP
  799. 19460 XP(NP+1)=X(N)
  800. 19480 YP(NP+1)=Y(N)
  801. 19500 GOSUB 18620
  802. 19520 PRINT " 1 JUST  CURVE, 2  CURVE AND HULL: ";
  803. 19540  IN=VAL(INPUT$(1))
  804. 19545 IF FLAG=0 THEN GOTO 19550 ELSE GOTO 19560
  805. 19550 LOCATE 1,1:PRINT SPC(39)
  806. 19552 LOCATE 1,1:INPUT "COLOR (0,1,2,3)"; CO
  807. 19560 PSET (X(0),Y(0)),CO
  808. 19580 IF IN=1 THEN 19680
  809. 19600 FOR I=1 TO N
  810. 19620  LINE -(X(I),Y(I)),CO
  811. 19640 NEXT I
  812. 19660 PSET (XP(0),YP(0)),CO
  813. 19680 FOR IP=1 TO NP+1
  814. 19700  LINE -(XP(IP),YP(IP)),CO
  815. 19720 NEXT IP
  816. 19740 RETURN
  817. 19760 '
  818. 19780 '
  819. 19800 '
  820. 19820 '   ***   ERROR TRAP   ***
  821. 19840 BEEP
  822. 19860 GOSUB 18620:  PRINT "ERROR NO." ERR "IN LINE" ERL;
  823. 19880 RESUME 19900
  824. 19900 GOSUB 18800
  825. 19920 GOTO 16260
  826. 19940 '
  827. 19960 '   ***   JOYSTICK DRAWING SUBROUTINE   ***
  828. 19980 '   ***************************************
  829. 20000 '   SCREEN 1,0: COLOR K,CLR
  830. 20020 STRIG(0) ON
  831. 20040 STRIG(4) ON
  832. 20060 ON STRIG(0) GOSUB 20200
  833. 20080 ON STRIG(4) GOSUB 20260
  834. 20100 PSET(STICK(0)*2.8,STICK(1)*2.1)
  835. 20120 X = STICK(0)*2.8
  836. 20140 Y = STICK(1)*2.1
  837. 20160 LINE -(X,Y),CLR
  838. 20180 GOTO 20120
  839. 20200 CLR=CLR+1 : IF CLR>3 THEN CLR=0
  840. 20240 RETURN
  841. 20260 '
  842. 20280 PSET(STICK(0)*2.8,STICK(1)*2.1),CLR: STRIG(0) OFF: STRIG(4) OFF
  843. 20300 RETURN 2120
  844.