home *** CD-ROM | disk | FTP | other *** search
/ 64'er / 64ER_CD.iso / s85xx / s8504a.d64 / Quellprog. (.txt) < prev    next >
Commodore BASIC  |  1995-03-30  |  17KB  |  950 lines

  1. 10 REM ********************************
  2. 20 REM *        PLOTTER-BASIC         *
  3. 30 REM *     (BEFEHLSERWEITERUNG)     *
  4. 40 REM *COPYRIGHT BY:STEPHAN SCHAEFER *
  5. 50 REM *             BURBACHERSTR.162 *
  6. 60 REM *JAN.1985     5300 BONN 1      *
  7. 70 REM *             TEL.:0228/235567 *
  8. 80 REM ********************************
  9. 90 SYS 9*4096
  10. 100 .OPT OO
  11. 110 CHRGET   = $0073  ; ZEICHEN HOLEN
  12. 120 CHR(null)T   = $0079
  13. 130 ZEIGER   = $0308  ; AUF ERKENNROUT.
  14. 140 INTPRT   = $A7AE  ; INTERPRETER
  15. 150 BSOUT    = $FFD2  ; ZEICHEN AUSGEBEN
  16. 160 GA       = 6      ; GERAETE-ADRESSE
  17. 170 LF       = 99     ; LOG. FILENUMMER
  18. 180 PUFFER   = $C8D7  ; NACH PROGR.ENDE
  19. 190 KX       = PUFFER
  20. 200 KY       = KX+5
  21. 210 XRAD     = KY+5
  22. 220 YRAD     = XRAD+5
  23. 230 STEP     = YRAD+5
  24. 240 ARGU     = STEP+5
  25. 250 XR       = KX
  26. 260 YR       = KY
  27. 270 ZR       = XRAD
  28. 280 XV       = YRAD
  29. 290 YV       = STEP
  30. 300 KOEF     = ARGU
  31. 310 WINK     = ARGU+5
  32. 320 PARK     = WINK+5
  33. 330 POINTER  = $FB    ;INHALT=PUFFERADR.
  34. 340 BEFZEIG  = $FD    ;AUF BEFEHLSTAB.
  35. 350 OPEN     = $FFC0
  36. 360 CLOSE    = $FFC3
  37. 370 SETFLS   = $FFBA
  38. 380 SETNAM   = $FFBD
  39. 390 CKOUT    = $FFC9
  40. 400 CLRCH    = $FFCC
  41. 410 CHKOM    = $AEFD  ; TEST AUF KOMMA
  42. 420 FRMEVL   = $AD9E  ; AUSDRUCK HOLEN
  43. 430 FRMNUM   = $AD8A
  44. 440 GETADR   = $B7F7
  45. 450 MEMFAC   = $BBA2
  46. 460 FACMEM   = $BBD4
  47. 470 VERGLCH  = $BC5B  ; FAC MIT A/Y
  48. 480 CHSGN    = $BFB4  ; FAC=-FAC
  49. 490 MEMMULT  = $BA28
  50. 500 MEMPLUS  = $B867
  51. 510 COS      = $E264
  52. 520 SIN      = $E26B
  53. 530 FACASC   = $BDDD
  54. 540 FACVAR   = $A9D6  ; FAC NACH VAR.
  55. 550 BYTFAC   = $B3A2
  56. 560 PRINT    = $AAA4
  57. 570 GOTO     = $A8A3
  58. 580 READY    = $A474
  59. 590 VARSUCH  = $B08B  ; SUCHT BASICVAR.
  60. 600 STROUT   = $AB1E  ; STRING AUSGEBEN
  61. 610 ;
  62. 620 ;
  63. 630 *= $C000
  64. 640 NOP ; WIRD NACH START DURCH RTS ERSETZT
  65. 650 JSR SYSTEM        ; TEXT AUSGEBEN/VEKTOREN AENDERN
  66. 660 RTS
  67. 670 ;
  68. 680 ;
  69. 690 AUS LDA HILF
  70. 700 STA $300    ; WARMSTART-VEKTOR
  71. 710 LDA HILF+1
  72. 720 STA $301
  73. 730 LDA JUMP+1
  74. 740 STA ZEIGER  ; ALTE VEKTOREN
  75. 750 LDA JUMP+2  ; ZURUECKSETZEN
  76. 760 STA ZEIGER+1
  77. 770 LDA #$EA    ; NOP-CODE
  78. 780 STA $C000   ; RESTART ERMOEGLICHEN
  79. 790 RTS
  80. 800 ;
  81. 810 ;
  82. 820 NEU JSR CHRGET
  83. 830 CMP #"."
  84. 840 BEQ FOUND
  85. 850 SEC
  86. 860 LDA $7A     ;TEXTPOINTER CHRGET
  87. 870 SBC #1      ;ERNIEDRIGEN
  88. 880 STA $7A     ;UM GLEICHES ZEICHEN
  89. 890 LDA $7B     ;2 MAL ZU LESEN
  90. 900 SBC #0
  91. 910 STA $7B
  92. 920 JUMP JMP $0000 ; BASIC-BEFEHL AUSFUEHREN
  93. 930 FOUND LDA #<PUFFER:STA POINTER
  94. 940 LDA #>PUFFER:STA POINTER+1
  95. 950 LDA #<BEFEHLE:STA BEFZEIG
  96. 960 LDA #>BEFEHLE:STA BEFZEIG+1
  97. 970 ;
  98. 980 JSR CHRGET
  99. 990 JSR HOLEN   ;BEFEHL HOLEN
  100. 1000 JSR ERKENN  ;ERKENNEN+AUSFUEHREN
  101. 1010 JMP INTPRT
  102. 1020 ;
  103. 1030 ;
  104. 1040 HOLEN LDY #0
  105. 1050 STORE STA (POINTER),Y
  106. 1060 INY
  107. 1070 JSR CHRGET
  108. 1080 BEQ NULL
  109. 1090 CMP #","
  110. 1100 BEQ NULL
  111. 1110 CMP #":"
  112. 1120 BEQ NULL
  113. 1130 JMP STORE
  114. 1140 NULL LDA #0
  115. 1150 STA (POINTER),Y
  116. 1160 RTS
  117. 1170 ;
  118. 1180 ERKENN LDX #0
  119. 1190 LDY #0
  120. 1200 SCHLEIFE LDA (POINTER),Y
  121. 1210 BEQ ENDE
  122. 1220 CMP (BEFZEIG),Y
  123. 1230 BNE NEXT
  124. 1240 INY
  125. 1250 JMP SCHLEIFE
  126. 1260 ENDE JMP EXEC
  127. 1270 NEXT INX   ;NAECHSTER BEFEHL
  128. 1280 CPX #35    ;BEFEHLSTAB. ENDE
  129. 1290 BEQ SYNTAX
  130. 1300 CLC
  131. 1310 LDA #7  ; LAENGE JEDES BEFEHLS
  132. 1320 ADC BEFZEIG
  133. 1330 STA BEFZEIG     ; ZEIGER AUF
  134. 1340 LDA #0          ; BEFEHLSTABELLE
  135. 1350 ADC BEFZEIG+1   ; ERHOEHEN
  136. 1360 STA BEFZEIG+1
  137. 1370 LDY #0
  138. 1380 JMP SCHLEIFE
  139. 1390 SYNTAX JMP $AF08 ; SYNTAX ERROR
  140. 1400 ;
  141. 1410 ;
  142. 1420 ;
  143. 1430 EXEC TXA         ; BEFEHLSNUMMER
  144. 1440 CLC              ; =ZEIGER
  145. 1450 ASL              ; MAL 2
  146. 1460 ADC #<SPRUNGTAB  ; AUF
  147. 1470 STA POINTER      ; SPRUNGTABELLE
  148. 1480 LDA #>SPRUNGTAB
  149. 1490 ADC #0
  150. 1500 STA POINTER+1
  151. 1510 LDY #0
  152. 1520 LDA (POINTER),Y  ; LSB BEF.ADRESSE
  153. 1530 STA BEFZEIG
  154. 1540 INY
  155. 1550 LDA (POINTER),Y  ; MSB BEF.ADRESSE
  156. 1560 STA BEFZEIG+1
  157. 1570 JMP (BEFZEIG)    ; AUSFUEHRUNG
  158. 1580 ;
  159. 1590 ;
  160. 1600 ;
  161. 1610 BEFEHLE .ASC "INIT   "
  162. 1620 .ASC "MOVE   "
  163. 1630 .ASC "DRAW   "
  164. 1640 .ASC "RMOVE  "
  165. 1650 .ASC "RDRAW  "
  166. 1660 .ASC "HOME   "
  167. 1670 .ASC "RAHMEN "
  168. 1680 .ASC "LINIE  "
  169. 1690 .ASC "KREIS  "
  170. 1700 .ASC "RADIUS "
  171. 1710 .ASC "TRANSM "
  172. 1720 .ASC "TRANSD "
  173. 1730 .ASC "TRANSL "
  174. 1740 .ASC "TURN   "
  175. 1750 .ASC "BLAU   "
  176. 1760 .ASC "ROT    "
  177. 1770 .ASC "GRUEN  "
  178. 1780 .ASC "SCHWARZ"
  179. 1790 .ASC "FARBE  "
  180. 1800 .ASC "KLEIN  "
  181. 1810 .ASC "MITTEL "
  182. 1820 .ASC "GROSS  "
  183. 1830 .ASC "SUPER  "
  184. 1840 .ASC "SIZE   "
  185. 1850 .ASC "DREH   "
  186. 1860 .ASC "STRICH "
  187. 1870 .ASC "GG     "
  188. 1880 .ASC "GK     "
  189. 1890 .ASC "PROG   "
  190. 1900 .ASC "TEXT   "
  191. 1910 .ASC "RESET  "
  192. 1920 .ASC "ERRJUMP"
  193. 1930 .ASC "ERROUT "
  194. 1940 .ASC "ERRNUM "
  195. 1950 .ASC "AUS    "
  196. 1960 ;
  197. 1970 SPRUNGTAB .WORD INIT
  198. 1980 .WORD MOVE
  199. 1990 .WORD DRAW
  200. 2000 .WORD RMOVE
  201. 2010 .WORD RDRAW
  202. 2020 .WORD HOME
  203. 2030 .WORD RAHMEN
  204. 2040 .WORD LINIE
  205. 2050 .WORD KREIS
  206. 2060 .WORD RADIUS
  207. 2070 .WORD TRANSM
  208. 2080 .WORD TRANSD
  209. 2090 .WORD TRANSL
  210. 2100 .WORD TURN
  211. 2110 .WORD BLAU
  212. 2120 .WORD ROT
  213. 2130 .WORD GRUEN
  214. 2140 .WORD SCHWARZ
  215. 2150 .WORD FARBE
  216. 2160 .WORD KLEIN
  217. 2170 .WORD MITTEL
  218. 2180 .WORD GROSS
  219. 2190 .WORD SUPER
  220. 2200 .WORD SIZE
  221. 2210 .WORD DREH
  222. 2220 .WORD STRICH
  223. 2230 .WORD GG
  224. 2240 .WORD GK
  225. 2250 .WORD PROG
  226. 2260 .WORD TEXT
  227. 2270 .WORD RESET
  228. 2280 .WORD ERRJUMP
  229. 2290 .WORD ERROUT
  230. 2300 .WORD ERRNUM
  231. 2310 .WORD AUS
  232. 2320 ;
  233. 2330 ; BEFEHLE
  234. 2340 ;
  235. 2350 COLOR LDY #2      ; SEKUNDAER-ADR.
  236. 2360 BYTSEND JSR AUF   ; KANAL OEFFNEN
  237. 2370 LDA $FF      ; FARBE HOLEN
  238. 2380 JSR BSOUT
  239. 2390 JSR ZU       ; KANAL SCHLIESSEN
  240. 2400 RTS
  241. 2410 ;
  242. 2420 ; KANAL OEFFNEN
  243. 2430 ;
  244. 2440 AUF LDX #GA    ; PLOTTER-ADRESSE
  245. 2450 LDA #LF        ; FILE#
  246. 2460 JSR SETFLS
  247. 2470 LDA #0         ; KEIN NAME NOETIG
  248. 2480 JSR SETNAM
  249. 2490 JSR OPEN
  250. 2500 LDX #LF
  251. 2510 JSR CKOUT      ; AUSGABE NACH #LF
  252. 2520 RTS
  253. 2530 ;
  254. 2540 ; KANAL SCHLIESSEN
  255. 2550 ;
  256. 2560 ZU JSR CLRCH
  257. 2570 LDA #LF
  258. 2580 JSR CLOSE
  259. 2590 RTS
  260. 2600 ;
  261. 2610 ;
  262. 2620 BLAU LDA #"1"
  263. 2630 STA $FF
  264. 2640 JSR COLOR
  265. 2650 RTS
  266. 2660 ;
  267. 2670 ROT LDA #"3"
  268. 2680 STA $FF
  269. 2690 JSR COLOR
  270. 2700 RTS
  271. 2710 ;
  272. 2720 GRUEN LDA #"2"
  273. 2730 STA $FF
  274. 2740 JSR COLOR
  275. 2750 RTS
  276. 2760 ;
  277. 2770 SCHWARZ LDA #"0"
  278. 2780 STA $FF
  279. 2790 JSR COLOR
  280. 2800 RTS
  281. 2810 ;
  282. 2820 ;
  283. 2830 FARBE JSR CHKOM
  284. 2840 LDY #2
  285. 2850 JSR AUF
  286. 2860 JSR FRMEVL
  287. 2870 JSR SENDER
  288. 2880 JSR ZU
  289. 2890 RTS
  290. 2900 ;
  291. 2910 ;
  292. 2920 GROESSE LDY #3
  293. 2930 JSR BYTSEND
  294. 2940 RTS
  295. 2950 ;
  296. 2960 KLEIN LDA #"0"
  297. 2970 STA $FF
  298. 2980 JSR GROESSE
  299. 2990 RTS
  300. 3000 ;
  301. 3010 MITTEL LDA #"1"
  302. 3020 STA $FF
  303. 3030 JSR GROESSE
  304. 3040 RTS
  305. 3050 ;
  306. 3060 GROSS LDA #"2"
  307. 3070 STA $FF
  308. 3080 JSR GROESSE
  309. 3090 RTS
  310. 3100 ;
  311. 3110 SUPER LDA #"3"
  312. 3120 STA $FF
  313. 3130 JSR GROESSE
  314. 3140 RTS
  315. 3150 ;
  316. 3160 ;
  317. 3170 SIZE JSR CHKOM
  318. 3180 LDY #3
  319. 3190 JSR AUF
  320. 3200 JSR FRMEVL
  321. 3210 JSR SENDER
  322. 3220 JSR ZU
  323. 3230 RTS
  324. 3240 ;
  325. 3250 ZSATZ LDY #6
  326. 3260 JSR BYTSEND
  327. 3270 RTS
  328. 3280 ;
  329. 3290 GG LDA #"0"
  330. 3300 STA $FF
  331. 3310 JSR ZSATZ
  332. 3320 RTS
  333. 3330 ;
  334. 3340 GK LDA #"1"
  335. 3350 STA $FF
  336. 3360 JSR ZSATZ
  337. 3370 RTS
  338. 3380 ;
  339. 3390 ;
  340. 3400 RESET LDY #7
  341. 3410 LDA #0
  342. 3420 STA $FF
  343. 3430 JSR BYTSEND
  344. 3440 RTS
  345. 3450 ;
  346. 3460 ;
  347. 3470 DREH JSR CHKOM
  348. 3480 JSR FRMEVL
  349. 3490 LDY #4
  350. 3500 JSR AUF
  351. 3510 JSR SENDER
  352. 3520 JSR ZU
  353. 3530 RTS
  354. 3540 ;
  355. 3550 ;
  356. 3560 TEXT LDA #","   ; AUF KOMMA TESTEN
  357. 3570 LDY #0
  358. 3580 CMP ($7A),Y     ; LAUFENDES ZEICHEN
  359. 3590 BNE LEER
  360. 3600 JSR $0073
  361. 3610 LDY #0
  362. 3620 JSR AUF
  363. 3630 JSR PRINT
  364. 3640 JSR ZU
  365. 3650 RTS
  366. 3660 LEER LDY #0
  367. 3670 JSR AUF
  368. 3680 LDA #13      ; NUR CR AUSGEBEN
  369. 3690 JSR BSOUT
  370. 3700 JSR ZU
  371. 3710 RTS
  372. 3720 ;
  373. 3730 ;
  374. 3740 STRICH JSR CHKOM
  375. 3750 LDY #5
  376. 3760 JSR AUF
  377. 3770 JSR FRMEVL
  378. 3780 JSR SENDER
  379. 3790 JSR ZU
  380. 3800 RTS
  381. 3810 ;
  382. 3820 ;
  383. 3830 HOME LDY #1
  384. 3840 LDA #"H"
  385. 3850 STA $FF
  386. 3860 JSR BYTSEND
  387. 3870 RTS
  388. 3880 ;
  389. 3890 ;
  390. 3900 INIT LDY #1
  391. 3910 LDA #"I"
  392. 3920 STA $FF
  393. 3930 JSR BYTSEND
  394. 3940 RTS
  395. 3950 ;
  396. 3960 ;
  397. 3970 MOVE JSR CHKOM
  398. 3980 LDY #1
  399. 3990 JSR AUF
  400. 4000 LDA #"M"
  401. 4010 DBYTE JSR BSOUT
  402. 4020 LDA #" "
  403. 4030 JSR BSOUT
  404. 4040 JSR FRMEVL       ; X-KOORD.
  405. 4050 JSR FACASC
  406. 4060 JSR STROUT
  407. 4070 LDA #" "
  408. 4080 JSR BSOUT
  409. 4090 JSR CHKOM
  410. 4100 JSR FRMEVL       ; Y-KOORD.
  411. 4110 JSR FACASC
  412. 4120 JSR STROUT
  413. 4130 JSR ZU
  414. 4140 RTS
  415. 4150 ;
  416. 4160 ;
  417. 4170 DRAW JSR CHKOM
  418. 4180 LDY #1
  419. 4190 JSR AUF
  420. 4200 LDA #"D"
  421. 4210 JMP DBYTE
  422. 4220 ;
  423. 4230 ;
  424. 4240 RMOVE JSR CHKOM
  425. 4250 LDY #1
  426. 4260 JSR AUF
  427. 4270 LDA #"R"
  428. 4280 JMP DBYTE
  429. 4290 ;
  430. 4300 ;
  431. 4310 RDRAW JSR CHKOM
  432. 4320 LDY #1
  433. 4330 JSR AUF
  434. 4340 LDA #"J"
  435. 4350 JMP DBYTE
  436. 4360 ;
  437. 4370 ;
  438. 4380 LINIE JSR MOVE
  439. 4390 JSR DRAW
  440. 4400 RTS
  441. 4410 ;
  442. 4420 ;
  443. 4430 SYSTEM LDX #255
  444. 4440 L1 INX
  445. 4450 LDA MELDUNG,X
  446. 4460 JSR BSOUT
  447. 4470 CPX #81
  448. 4480 BNE L1
  449. 4490 LDA $300 : STA HILF    ; ALTE
  450. 4500 LDA $301 : STA HILF+1  ; VEKTOREN
  451. 4510 CLC                    ; RETTEN
  452. 4520 LDA #3
  453. 4530 LDA $308 : STA JUMP+1;SPRUNG NACH
  454. 4540 LDA #0               ;EVENTUELLER
  455. 4550 LDA $309 : STA JUMP+2;BEF.-ERWEIT.
  456. 4560 LDA #<WARM : STA $300    ;NEUE
  457. 4570 LDA #>WARM : STA $301    ;VEKTOREN
  458. 4580 LDA #<NEU  : STA ZEIGER  ;SETZEN
  459. 4590 LDA #>NEU  : STA ZEIGER+1
  460. 4600 LDA #$60  ; RTS BEFEHL
  461. 4610 STA $C000 ; VERHINDERT RESTART
  462. 4620 RTS
  463. 4630 ;
  464. 4640 MELDUNG .ASC "[147]"
  465. 4650 .ASC "   **** COMMODORE 1520 BASIC 1.3 ****"
  466. 4660 .BYT $0D
  467. 4670 .BYT $0D
  468. 4680 .ASC "   (P) JAN.1985 =:= (C) BY S.SCHAEFER  "
  469. 4690 .BYT $0D
  470. 4700 HILF .BYT $00  ; ZWISCHENSPEICHER
  471. 4710 .BYT $00  ; FUER WARMSTART-VEKTOR
  472. 4720 ;
  473. 4730 ;
  474. 4740 SENDER JSR FACASC  ; FAC AUF
  475. 4750 JSR STROUT         ; DRUCKER-
  476. 4760 LDA #" "           ; KANAL
  477. 4770 JSR BSOUT          ; + SPACE
  478. 4780 RTS
  479. 4790 ;
  480. 4800 ;
  481. 4810 KREIS JSR PARAM
  482. 4820 JSR KRMIT
  483. 4830 JSR MALEN
  484. 4840 RTS
  485. 4850 ;
  486. 4860 PARAM JSR CHKOM
  487. 4870 JSR FRMEVL
  488. 4880 LDX #<KX : LDY #>KX
  489. 4890 JSR FACMEM
  490. 4900 JSR CHKOM
  491. 4910 JSR FRMEVL
  492. 4920 LDX #<KY : LDY #>KY
  493. 4930 JSR FACMEM
  494. 4940 JSR CHKOM
  495. 4950 JSR FRMEVL
  496. 4960 LDX #<XRAD : LDY #>XRAD
  497. 4970 JSR FACMEM
  498. 4980 JSR CHKOM
  499. 4990 JSR FRMEVL
  500. 5000 LDX #<YRAD : LDY #>YRAD
  501. 5010 JSR FACMEM
  502. 5020 RTS
  503. 5030 ;
  504. 5040 KRMIT LDA #<KX : LDY #>KX
  505. 5050 JSR MEMFAC
  506. 5060 LDY #1
  507. 5070 JSR AUF
  508. 5080 LDA #"M" : JSR BSOUT  ; AUF KREISMITTELPUNKT
  509. 5090 JSR SENDER
  510. 5100 LDA #<KY : LDY #>KY
  511. 5110 JSR MEMFAC
  512. 5120 JSR SENDER            ; POSITIONIEREN
  513. 5130 JSR ZU
  514. 5140 JSR INIT
  515. 5150 RTS
  516. 5160 ;
  517. 5170 MALEN LDA #<XRAD : LDY #>XRAD
  518. 5180 JSR MEMFAC
  519. 5190 LDY #1
  520. 5200 JSR AUF
  521. 5210 LDA #"R"
  522. 5220 JSR BSOUT
  523. 5230 JSR SENDER
  524. 5240 LDA #"0"
  525. 5250 JSR BSOUT
  526. 5260 JSR ZU
  527. 5270 ;
  528. 5280 LDA #0
  529. 5290 STA ARGU:STA ARGU+1
  530. 5300 STA ARGU+2:STA ARGU+3:STA ARGU+4
  531. 5310 JMP PL     ; ARGUMENT ERHOEHEN
  532. 5320 LOOP LDY #1 : JSR AUF
  533. 5330 JSR COS
  534. 5340 LDA #<XRAD : LDY #>XRAD
  535. 5350 JSR MEMMULT
  536. 5360 LDA #"J"
  537. 5370 JSR BSOUT
  538. 5380 JSR SENDER
  539. 5390 ;
  540. 5400 LDA #<ARGU : LDY #>ARGU
  541. 5410 JSR MEMFAC
  542. 5420 JSR SIN
  543. 5430 LDA #<YRAD : LDY #>YRAD
  544. 5440 JSR MEMMULT
  545. 5450 JSR SENDER
  546. 5460 JSR ZU
  547. 5470 ;
  548. 5480 PL LDA #$6C
  549. 5490 LDY #$E3    ; FLP 0.19=STEP
  550. 5500 JSR MEMFAC
  551. 5510 LDA #<ARGU : LDY #>ARGU
  552. 5520 JSR MEMPLUS
  553. 5530 LDX #<ARGU : LDY #>ARGU
  554. 5540 JSR FACMEM
  555. 5550 LDA #<GRENZE : LDY #>GRENZE
  556. 5560 CLC
  557. 5570 JSR VERGLCH
  558. 5580 BCS LOOP
  559. 5590 JSR ZU
  560. 5600 RTS
  561. 5610 ;
  562. 5620 ;
  563. 5630 PROG LDA #","   ; AUF KOMMA TESTEN
  564. 5640 LDY #0
  565. 5650 CMP ($7A),Y     ; AKTUELLES ZEICHEN
  566. 5660 BNE ALLES
  567. 5670 JSR $0073
  568. 5680 ALLES LDY #0
  569. 5690 JSR AUF
  570. 5700 DEC $7A  ; TEXTPOINTER ERNIEDRIGEN
  571. 5710 LDA #$9B ; LIST-CODE
  572. 5720 LDX #99 : STX FLAG  ;LIST-FLAG SETZEN
  573. 5730 JSR $A7F7
  574. 5740 JSR ZU
  575. 5750 RTS
  576. 5760 ;
  577. 5770 ;
  578. 5780 WARM LDA FLAG  ; WARMSTART ROUTINE
  579. 5790 CMP #99        ; UM NACH LIST DEN
  580. 5800 BEQ CH         ; DRUCKERKANAL ZU
  581. 5810 JMP (HILF)     ; SCHLIESSEN UND
  582. 5820 CH LDA #0      ; DIE READY-MELDUNG
  583. 5830 STA FLAG       ; ZU UNTERDRUECKEN
  584. 5840 LDA #13  ;CR
  585. 5850 JSR BSOUT
  586. 5860 JSR ZU
  587. 5870 JMP $A474      ; READY-MODUS
  588. 5880 ;
  589. 5890 ;
  590. 5900 RAHMEN JSR PARAM
  591. 5910 ;
  592. 5920 LDY #1
  593. 5930 JSR AUF
  594. 5940 LDA #"M"
  595. 5950 JSR BSOUT
  596. 5960 LDA #" "
  597. 5970 JSR BSOUT
  598. 5980 LDA #<KX : LDY #>KX  ; BEWEGUNG
  599. 5990 JSR MEMFAC           ; NACH
  600. 6000 JSR SENDER           ; X1/Y1
  601. 6010 LDA #<KY : LDY #>KY
  602. 6020 JSR MEMFAC
  603. 6030 JSR SENDER
  604. 6040 JSR ZU
  605. 6050 ;
  606. 6060 JSR DRAUF
  607. 6070 LDA #<XRAD : LDY #>XRAD
  608. 6080 JSR MEMFAC
  609. 6090 JSR SENDER
  610. 6100 LDA #<KY   : LDY #>KY
  611. 6110 JSR MEMFAC
  612. 6120 JSR SENDER
  613. 6130 JSR ZU
  614. 6140 JSR DRAUF
  615. 6150 LDA #<XRAD : LDY #>XRAD
  616. 6160 JSR MEMFAC
  617. 6170 JSR SENDER
  618. 6180 LDA #<YRAD : LDY #>YRAD
  619. 6190 JSR MEMFAC
  620. 6200 JSR SENDER
  621. 6210 JSR ZU
  622. 6220 JSR DRAUF
  623. 6230 LDA #<KX   : LDY #>KX
  624. 6240 JSR MEMFAC
  625. 6250 JSR SENDER
  626. 6260 LDA #<YRAD : LDY #>YRAD
  627. 6270 JSR MEMFAC
  628. 6280 JSR SENDER
  629. 6290 JSR ZU
  630. 6300 JSR DRAUF
  631. 6310 LDA #<KX   : LDY #>KX
  632. 6320 JSR MEMFAC
  633. 6330 JSR SENDER
  634. 6340 LDA #<KY   : LDY #>KY
  635. 6350 JSR MEMFAC
  636. 6360 JSR SENDER
  637. 6370 JSR ZU
  638. 6380 RTS
  639. 6390 ;
  640. 6400 ;
  641. 6410 DRAUF LDY #1   ;OPEN + DRAW-BEFEHL
  642. 6420 JSR AUF
  643. 6430 LDA #"D"
  644. 6440 JSR BSOUT
  645. 6450 LDA #" "
  646. 6460 JSR BSOUT
  647. 6470 RTS
  648. 6480 ;
  649. 6490 ;
  650. 6500 GRENZE .BYT $83  ; 2*(null)
  651. 6510 .BYT $55
  652. 6520 .BYT $DC
  653. 6530 .BYT $A7
  654. 6540 .BYT $6E
  655. 6550 FLAG .BYT $00    ; LIST-FLAG FUER WARMSTART-ROUTINE
  656. 6560 FAKTOR .BYT $7B  ; (null)/180
  657. 6570 .BYT $0E
  658. 6580 .BYT $FA
  659. 6590 .BYT $35
  660. 6600 .BYT $12
  661. 6610 ;
  662. 6620 RADIUS JSR PARAM
  663. 6630 JSR CHKOM
  664. 6640 JSR FRMEVL
  665. 6650 LDA #<FAKTOR : LDY #>FAKTOR
  666. 6660 JSR MEMMULT
  667. 6670 LDX #<ARGU : LDY #>ARGU
  668. 6680 JSR FACMEM
  669. 6690 ;
  670. 6700 JSR KRMIT
  671. 6710 ;
  672. 6720 LDY #1
  673. 6730 JSR AUF
  674. 6740 LDA #"J"
  675. 6750 JSR BSOUT
  676. 6760 LDA #" "
  677. 6770 JSR BSOUT
  678. 6780 LDA #<ARGU : LDY #>ARGU
  679. 6790 JSR MEMFAC
  680. 6800 JSR COS
  681. 6810 LDA #<XRAD : LDY #>XRAD
  682. 6820 JSR MEMMULT
  683. 6830 JSR SENDER
  684. 6840 LDA #<ARGU : LDY #>ARGU
  685. 6850 JSR MEMFAC
  686. 6860 JSR SIN
  687. 6870 LDA #<YRAD : LDY #>YRAD
  688. 6880 JSR MEMMULT
  689. 6890 JSR SENDER
  690. 6900 JSR ZU
  691. 6910 RTS
  692. 6920 ;
  693. 6930 ;
  694. 6940 TRANSM JSR ALLPARAM ; 7 PARAMETER
  695. 6950 TRM LDY #1
  696. 6960 JSR AUF
  697. 6970 LDA #"M"
  698. 6980 REST JSR BSOUT
  699. 6990 LDA #" "
  700. 7000 JSR BSOUT
  701. 7010 JSR UMRECHNG
  702. 7020 RTS
  703. 7030 ;
  704. 7040 ;
  705. 7050 TRANSD JSR ALLPARAM ; 7 PARAMETER
  706. 7060 TRD LDY #1
  707. 7070 JSR AUF
  708. 7080 LDA #"D"
  709. 7090 JMP REST
  710. 7100 ;
  711. 7110 ;
  712. 7120 TRANSL JSR ALLPARAM
  713. 7130 JSR TRM
  714. 7140 JSR CHKOM
  715. 7150 JSR FRMEVL
  716. 7160 LDX #<XR : LDY #>XR
  717. 7170 JSR FACMEM
  718. 7180 JSR CHKOM
  719. 7190 JSR FRMEVL
  720. 7200 LDX #<YR : LDY #>YR
  721. 7210 JSR FACMEM
  722. 7220 JSR CHKOM
  723. 7230 JSR FRMEVL
  724. 7240 LDX #<ZR : LDY #>ZR
  725. 7250 JSR FACMEM
  726. 7260 JMP TRD
  727. 7270 ;
  728. 7280 ;
  729. 7290 ALLPARAM JSR CHKOM
  730. 7300 JSR FRMEVL
  731. 7310 LDX #<XR : LDY #>XR
  732. 7320 JSR FACMEM
  733. 7330 JSR CHKOM
  734. 7340 JSR FRMEVL
  735. 7350 LDX #<YR : LDY #>YR
  736. 7360 JSR FACMEM
  737. 7370 JSR CHKOM
  738. 7380 JSR FRMEVL
  739. 7390 LDX #<ZR : LDY #>ZR
  740. 7400 JSR FACMEM
  741. 7410 JSR CHKOM
  742. 7420 JSR FRMEVL
  743. 7430 LDX #<XV : LDY #>XV
  744. 7440 JSR FACMEM
  745. 7450 JSR CHKOM
  746. 7460 JSR FRMEVL
  747. 7470 LDX #<YV : LDY #>YV
  748. 7480 JSR FACMEM
  749. 7490 JSR CHKOM
  750. 7500 JSR FRMEVL
  751. 7510 LDX #<KOEF : LDY #>KOEF
  752. 7520 JSR FACMEM
  753. 7530 JSR CHKOM
  754. 7540 JSR FRMEVL
  755. 7550 LDX #<WINK : LDY #>WINK
  756. 7560 JSR FACMEM
  757. 7570 RTS
  758. 7580 ;
  759. 7590 ;
  760. 7600 UMRECHNG LDA #<WINK : LDY #>WINK
  761. 7610 JSR MEMFAC
  762. 7620 LDA #<FAKTOR : LDY #>FAKTOR
  763. 7630 JSR MEMMULT ; FAC NACH RADIANT
  764. 7640 JSR COS
  765. 7650 LDA #<YR : LDY #>YR
  766. 7660 JSR MEMMULT
  767. 7670 LDA #<XR : LDY #>XR
  768. 7680 JSR MEMPLUS
  769. 7690 LDA #<KOEF : LDY #>KOEF
  770. 7700 JSR MEMMULT
  771. 7710 LDA #<XV : LDY #>XV
  772. 7720 JSR MEMPLUS
  773. 7730 JSR SENDER
  774. 7740 ;
  775. 7750 LDA #<WINK : LDY #>WINK
  776. 7760 JSR MEMFAC
  777. 7770 LDA #<FAKTOR : LDY #>FAKTOR
  778. 7780 JSR MEMMULT ; FAC NACH RADIANT
  779. 7790 JSR SIN
  780. 7800 LDA #<YR : LDY #>YR
  781. 7810 JSR MEMMULT
  782. 7820 LDA #<ZR : LDY #>ZR
  783. 7830 JSR MEMPLUS
  784. 7840 LDA #<KOEF : LDY #>KOEF
  785. 7850 JSR MEMMULT
  786. 7860 LDA #<YV : LDY #>YV
  787. 7870 JSR MEMPLUS
  788. 7880 JSR SENDER
  789. 7890 JSR ZU
  790. 7900 RTS
  791. 7910 ;
  792. 7920 ;
  793. 7930 PAR3 JSR CHKOM
  794. 7940 JSR VARSUCH
  795. 7950 STA YRAD : STY YRAD+1 ;ZEIGER AUF ERSTE VARIABLE
  796. 7960 JSR CHKOM
  797. 7970 JSR VARSUCH
  798. 7980 STA YRAD+2 : STY YRAD+3 ;ZEIGER AUF ZWEITE VARIABLE
  799. 7990 JSR CHKOM
  800. 8000 JSR FRMEVL
  801. 8010 LDX #<WINK : LDY #>WINK
  802. 8020 JSR FACMEM
  803. 8030 RTS
  804. 8040 ;
  805. 8050 RADIANT LDA #<WINK : LDY #>WINK
  806. 8060 JSR MEMFAC
  807. 8070 LDA #<FAKTOR : LDY #>FAKTOR
  808. 8080 JSR MEMMULT
  809. 8090 JSR COS
  810. 8100 LDX #<STEP   : LDY #>STEP
  811. 8110 JSR FACMEM ; STEP=COS(W)
  812. 8120 LDA #<WINK : LDY #>WINK
  813. 8130 JSR MEMFAC
  814. 8140 LDA #<FAKTOR : LDY #>FAKTOR
  815. 8150 JSR MEMMULT
  816. 8160 JSR SIN
  817. 8170 LDX #<ARGU   : LDY #>ARGU
  818. 8180 JSR FACMEM ; ARGU=SIN(W)
  819. 8190 RTS
  820. 8200 ;
  821. 8210 ;
  822. 8220 TURN JSR PAR3
  823. 8230 JSR RADIANT
  824. 8240 LDA YRAD : LDY YRAD+1
  825. 8250 JSR MEMFAC
  826. 8260 LDA #<STEP : LDY #>STEP ;COS(W)
  827. 8270 JSR MEMMULT
  828. 8280 LDX #<ZR : LDY #>ZR
  829. 8290 JSR FACMEM                ;MERKEN
  830. 8300 LDA YRAD+2 : LDY YRAD+3
  831. 8310 JSR MEMFAC
  832. 8320 LDA #<ARGU : LDY #>ARGU ;SIN(W)
  833. 8330 JSR MEMMULT
  834. 8340 LDA #<ZR : LDY #>ZR
  835. 8350 JSR MEMPLUS
  836. 8360 LDX #<PARK : LDY #>PARK
  837. 8370 JSR FACMEM                ;MERKEN
  838. 8380 ;
  839. 8390 LDA YRAD : LDY YRAD+1
  840. 8400 JSR MEMFAC
  841. 8410 JSR CHSGN        ; FAC=-FAC
  842. 8420 LDA #<ARGU : LDY #>ARGU ;SIN(W)
  843. 8430 JSR MEMMULT
  844. 8440 LDX #<ZR : LDY #>ZR
  845. 8450 JSR FACMEM                ;MERKEN
  846. 8460 LDA YRAD+2 : LDY YRAD+3
  847. 8470 JSR MEMFAC
  848. 8480 LDA #<STEP : LDY #>STEP ;COS(W)
  849. 8490 JSR MEMMULT
  850. 8500 LDA #<ZR : LDY #>ZR
  851. 8510 JSR MEMPLUS
  852. 8520 LDA YRAD+2 : LDY YRAD+3
  853. 8530 STA $49  : STY $4A ;ZEIGER SETZEN
  854. 8540 JSR FACVAR
  855. 8550 LDA #<PARK : LDY #>PARK
  856. 8560 JSR MEMFAC
  857. 8570 LDA YRAD  : LDY YRAD+1
  858. 8580 STA $49  : STY $4A ;ZEIGER SETZEN
  859. 8590 JSR FACVAR
  860. 8600 RTS
  861. 8610 ;
  862. 8620 ;
  863. 8630 ERRJUMP JSR CHKOM
  864. 8640 JSR FRMNUM
  865. 8650 JSR GETADR ; ZEILENNR. NACH $14/15
  866. 8660 LDA $14
  867. 8670 LDY $15
  868. 8680 STA ZEILE
  869. 8690 STY ZEILE+1
  870. 8700 LDA #<ERTEST ; FEHLERBEHANDLUNG
  871. 8710 STA $300
  872. 8720 LDA #>ERTEST ; EINSCHALTEN
  873. 8730 STA $301
  874. 8740 LDY #0
  875. 8750 LDA #","
  876. 8760 CMP ($7A),Y  ; TEST AUF KOMMA
  877. 8770 BNE R1
  878. 8780 JSR CHRGET
  879. 8790 JSR FRMEVL
  880. 8800 LDA #99      ; ALLE FEHLER
  881. 8810 STA ERRFLAG  ; UNTERDRUECKEN
  882. 8820 RTS
  883. 8830 R1 LDA #0   ;NUR ARITHMETHISCHE
  884. 8840 STA ERRFLAG ;FEHLER UNTERDRUECKEN
  885. 8850 RTS
  886. 8860 ZEILE .BYT $00
  887. 8870 .BYT $00
  888. 8880 ;
  889. 8890 ;
  890. 8900 ERROUT LDA #<WARM ; ERRJUMP AB-
  891. 8910 LDY #>WARM       ; SCHALTEN
  892. 8920 STA $300
  893. 8930 STY $301
  894. 8940 RTS
  895. 8950 ;
  896. 8960 ERTEST CMP #$81  ; TEST AUF
  897. 8970 BNE NOEND
  898. 8980 CPY #$A3         ; PROGRAMMENDE
  899. 8990 BNE NOEND
  900. 9000 JSR ERROUT ;FEHLERMELDUNG ERMOEGL.
  901. 9010 JMP OKAY  ;READY-MODUS
  902. 9020 NOEND LDA ERRFLAG
  903. 9030 BNE NOERR
  904. 9040 STX $02   ; FEHLERNUMMER MERKEN
  905. 9050 TXA
  906. 9060 BMI OKAY   ; KEIN FEHLER
  907. 9070 CPX #14    ; ILL. QUANTITY
  908. 9080 BEQ NOERR
  909. 9090 CPX #15    ; OVERFLOW
  910. 9100 BEQ NOERR
  911. 9110 CPX #16    ; OUT OF MEMORY
  912. 9120 BEQ MEMORY
  913. 9130 CPX #20    ; DIVISION BY ZERO
  914. 9140 BEQ NOERR
  915. 9150 TAX
  916. 9160 JMP (HILF)  ; ZUM ECHTEN WARMSTART
  917. 9170 OKAY JMP READY  ; READY-MODUS
  918. 9180 NOERR STX $02 ;FEHLERNUMMER MERKEN
  919. 9190 LDA ZEILE
  920. 9200 LDY ZEILE+1
  921. 9210 STA $14
  922. 9220 STY $15
  923. 9230 JSR GOTO   ;PROGRAMMZAEHLER-INCR.
  924. 9240 JMP INTPRT
  925. 9250 ;
  926. 9260 ERRFLAG .BYT $00
  927. 9270 ;
  928. 9280 MEMORY PLA
  929. 9290 TAY
  930. 9300 PLA
  931. 9310 LDX #$FA ; STACKPOINTER
  932. 9320 TXS      ; INITIALISIEREN
  933. 9330 PHA
  934. 9340 TYA
  935. 9350 PHA
  936. 9360 JMP NOERR
  937. 9370 ;
  938. 9380 ;
  939. 9390 ERRNUM JSR CHKOM
  940. 9400 JSR VARSUCH  ; BASICVARIABLE BEST.
  941. 9410 STA YRAD : STY YRAD+1
  942. 9420 LDY $02     ; FEHLERNUMMER HOLEN
  943. 9430 JSR BYTFAC  ; UND UMWANDELN
  944. 9440 LDA YRAD : LDY YRAD+1
  945. 9450 STA $49  : STY $4A
  946. 9460 JSR FACVAR  ; NUMMER IN BASICVAR.
  947. 9470 LDA #0
  948. 9480 STA $02
  949. 9490 RTS
  950.