home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er
/
64ER_CD.iso
/
s85xx
/
s8504a.d64
/
Quellprog.
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
1995-03-30
|
17KB
|
950 lines
10 REM ********************************
20 REM * PLOTTER-BASIC *
30 REM * (BEFEHLSERWEITERUNG) *
40 REM *COPYRIGHT BY:STEPHAN SCHAEFER *
50 REM * BURBACHERSTR.162 *
60 REM *JAN.1985 5300 BONN 1 *
70 REM * TEL.:0228/235567 *
80 REM ********************************
90 SYS 9*4096
100 .OPT OO
110 CHRGET = $0073 ; ZEICHEN HOLEN
120 CHR(null)T = $0079
130 ZEIGER = $0308 ; AUF ERKENNROUT.
140 INTPRT = $A7AE ; INTERPRETER
150 BSOUT = $FFD2 ; ZEICHEN AUSGEBEN
160 GA = 6 ; GERAETE-ADRESSE
170 LF = 99 ; LOG. FILENUMMER
180 PUFFER = $C8D7 ; NACH PROGR.ENDE
190 KX = PUFFER
200 KY = KX+5
210 XRAD = KY+5
220 YRAD = XRAD+5
230 STEP = YRAD+5
240 ARGU = STEP+5
250 XR = KX
260 YR = KY
270 ZR = XRAD
280 XV = YRAD
290 YV = STEP
300 KOEF = ARGU
310 WINK = ARGU+5
320 PARK = WINK+5
330 POINTER = $FB ;INHALT=PUFFERADR.
340 BEFZEIG = $FD ;AUF BEFEHLSTAB.
350 OPEN = $FFC0
360 CLOSE = $FFC3
370 SETFLS = $FFBA
380 SETNAM = $FFBD
390 CKOUT = $FFC9
400 CLRCH = $FFCC
410 CHKOM = $AEFD ; TEST AUF KOMMA
420 FRMEVL = $AD9E ; AUSDRUCK HOLEN
430 FRMNUM = $AD8A
440 GETADR = $B7F7
450 MEMFAC = $BBA2
460 FACMEM = $BBD4
470 VERGLCH = $BC5B ; FAC MIT A/Y
480 CHSGN = $BFB4 ; FAC=-FAC
490 MEMMULT = $BA28
500 MEMPLUS = $B867
510 COS = $E264
520 SIN = $E26B
530 FACASC = $BDDD
540 FACVAR = $A9D6 ; FAC NACH VAR.
550 BYTFAC = $B3A2
560 PRINT = $AAA4
570 GOTO = $A8A3
580 READY = $A474
590 VARSUCH = $B08B ; SUCHT BASICVAR.
600 STROUT = $AB1E ; STRING AUSGEBEN
610 ;
620 ;
630 *= $C000
640 NOP ; WIRD NACH START DURCH RTS ERSETZT
650 JSR SYSTEM ; TEXT AUSGEBEN/VEKTOREN AENDERN
660 RTS
670 ;
680 ;
690 AUS LDA HILF
700 STA $300 ; WARMSTART-VEKTOR
710 LDA HILF+1
720 STA $301
730 LDA JUMP+1
740 STA ZEIGER ; ALTE VEKTOREN
750 LDA JUMP+2 ; ZURUECKSETZEN
760 STA ZEIGER+1
770 LDA #$EA ; NOP-CODE
780 STA $C000 ; RESTART ERMOEGLICHEN
790 RTS
800 ;
810 ;
820 NEU JSR CHRGET
830 CMP #"."
840 BEQ FOUND
850 SEC
860 LDA $7A ;TEXTPOINTER CHRGET
870 SBC #1 ;ERNIEDRIGEN
880 STA $7A ;UM GLEICHES ZEICHEN
890 LDA $7B ;2 MAL ZU LESEN
900 SBC #0
910 STA $7B
920 JUMP JMP $0000 ; BASIC-BEFEHL AUSFUEHREN
930 FOUND LDA #<PUFFER:STA POINTER
940 LDA #>PUFFER:STA POINTER+1
950 LDA #<BEFEHLE:STA BEFZEIG
960 LDA #>BEFEHLE:STA BEFZEIG+1
970 ;
980 JSR CHRGET
990 JSR HOLEN ;BEFEHL HOLEN
1000 JSR ERKENN ;ERKENNEN+AUSFUEHREN
1010 JMP INTPRT
1020 ;
1030 ;
1040 HOLEN LDY #0
1050 STORE STA (POINTER),Y
1060 INY
1070 JSR CHRGET
1080 BEQ NULL
1090 CMP #","
1100 BEQ NULL
1110 CMP #":"
1120 BEQ NULL
1130 JMP STORE
1140 NULL LDA #0
1150 STA (POINTER),Y
1160 RTS
1170 ;
1180 ERKENN LDX #0
1190 LDY #0
1200 SCHLEIFE LDA (POINTER),Y
1210 BEQ ENDE
1220 CMP (BEFZEIG),Y
1230 BNE NEXT
1240 INY
1250 JMP SCHLEIFE
1260 ENDE JMP EXEC
1270 NEXT INX ;NAECHSTER BEFEHL
1280 CPX #35 ;BEFEHLSTAB. ENDE
1290 BEQ SYNTAX
1300 CLC
1310 LDA #7 ; LAENGE JEDES BEFEHLS
1320 ADC BEFZEIG
1330 STA BEFZEIG ; ZEIGER AUF
1340 LDA #0 ; BEFEHLSTABELLE
1350 ADC BEFZEIG+1 ; ERHOEHEN
1360 STA BEFZEIG+1
1370 LDY #0
1380 JMP SCHLEIFE
1390 SYNTAX JMP $AF08 ; SYNTAX ERROR
1400 ;
1410 ;
1420 ;
1430 EXEC TXA ; BEFEHLSNUMMER
1440 CLC ; =ZEIGER
1450 ASL ; MAL 2
1460 ADC #<SPRUNGTAB ; AUF
1470 STA POINTER ; SPRUNGTABELLE
1480 LDA #>SPRUNGTAB
1490 ADC #0
1500 STA POINTER+1
1510 LDY #0
1520 LDA (POINTER),Y ; LSB BEF.ADRESSE
1530 STA BEFZEIG
1540 INY
1550 LDA (POINTER),Y ; MSB BEF.ADRESSE
1560 STA BEFZEIG+1
1570 JMP (BEFZEIG) ; AUSFUEHRUNG
1580 ;
1590 ;
1600 ;
1610 BEFEHLE .ASC "INIT "
1620 .ASC "MOVE "
1630 .ASC "DRAW "
1640 .ASC "RMOVE "
1650 .ASC "RDRAW "
1660 .ASC "HOME "
1670 .ASC "RAHMEN "
1680 .ASC "LINIE "
1690 .ASC "KREIS "
1700 .ASC "RADIUS "
1710 .ASC "TRANSM "
1720 .ASC "TRANSD "
1730 .ASC "TRANSL "
1740 .ASC "TURN "
1750 .ASC "BLAU "
1760 .ASC "ROT "
1770 .ASC "GRUEN "
1780 .ASC "SCHWARZ"
1790 .ASC "FARBE "
1800 .ASC "KLEIN "
1810 .ASC "MITTEL "
1820 .ASC "GROSS "
1830 .ASC "SUPER "
1840 .ASC "SIZE "
1850 .ASC "DREH "
1860 .ASC "STRICH "
1870 .ASC "GG "
1880 .ASC "GK "
1890 .ASC "PROG "
1900 .ASC "TEXT "
1910 .ASC "RESET "
1920 .ASC "ERRJUMP"
1930 .ASC "ERROUT "
1940 .ASC "ERRNUM "
1950 .ASC "AUS "
1960 ;
1970 SPRUNGTAB .WORD INIT
1980 .WORD MOVE
1990 .WORD DRAW
2000 .WORD RMOVE
2010 .WORD RDRAW
2020 .WORD HOME
2030 .WORD RAHMEN
2040 .WORD LINIE
2050 .WORD KREIS
2060 .WORD RADIUS
2070 .WORD TRANSM
2080 .WORD TRANSD
2090 .WORD TRANSL
2100 .WORD TURN
2110 .WORD BLAU
2120 .WORD ROT
2130 .WORD GRUEN
2140 .WORD SCHWARZ
2150 .WORD FARBE
2160 .WORD KLEIN
2170 .WORD MITTEL
2180 .WORD GROSS
2190 .WORD SUPER
2200 .WORD SIZE
2210 .WORD DREH
2220 .WORD STRICH
2230 .WORD GG
2240 .WORD GK
2250 .WORD PROG
2260 .WORD TEXT
2270 .WORD RESET
2280 .WORD ERRJUMP
2290 .WORD ERROUT
2300 .WORD ERRNUM
2310 .WORD AUS
2320 ;
2330 ; BEFEHLE
2340 ;
2350 COLOR LDY #2 ; SEKUNDAER-ADR.
2360 BYTSEND JSR AUF ; KANAL OEFFNEN
2370 LDA $FF ; FARBE HOLEN
2380 JSR BSOUT
2390 JSR ZU ; KANAL SCHLIESSEN
2400 RTS
2410 ;
2420 ; KANAL OEFFNEN
2430 ;
2440 AUF LDX #GA ; PLOTTER-ADRESSE
2450 LDA #LF ; FILE#
2460 JSR SETFLS
2470 LDA #0 ; KEIN NAME NOETIG
2480 JSR SETNAM
2490 JSR OPEN
2500 LDX #LF
2510 JSR CKOUT ; AUSGABE NACH #LF
2520 RTS
2530 ;
2540 ; KANAL SCHLIESSEN
2550 ;
2560 ZU JSR CLRCH
2570 LDA #LF
2580 JSR CLOSE
2590 RTS
2600 ;
2610 ;
2620 BLAU LDA #"1"
2630 STA $FF
2640 JSR COLOR
2650 RTS
2660 ;
2670 ROT LDA #"3"
2680 STA $FF
2690 JSR COLOR
2700 RTS
2710 ;
2720 GRUEN LDA #"2"
2730 STA $FF
2740 JSR COLOR
2750 RTS
2760 ;
2770 SCHWARZ LDA #"0"
2780 STA $FF
2790 JSR COLOR
2800 RTS
2810 ;
2820 ;
2830 FARBE JSR CHKOM
2840 LDY #2
2850 JSR AUF
2860 JSR FRMEVL
2870 JSR SENDER
2880 JSR ZU
2890 RTS
2900 ;
2910 ;
2920 GROESSE LDY #3
2930 JSR BYTSEND
2940 RTS
2950 ;
2960 KLEIN LDA #"0"
2970 STA $FF
2980 JSR GROESSE
2990 RTS
3000 ;
3010 MITTEL LDA #"1"
3020 STA $FF
3030 JSR GROESSE
3040 RTS
3050 ;
3060 GROSS LDA #"2"
3070 STA $FF
3080 JSR GROESSE
3090 RTS
3100 ;
3110 SUPER LDA #"3"
3120 STA $FF
3130 JSR GROESSE
3140 RTS
3150 ;
3160 ;
3170 SIZE JSR CHKOM
3180 LDY #3
3190 JSR AUF
3200 JSR FRMEVL
3210 JSR SENDER
3220 JSR ZU
3230 RTS
3240 ;
3250 ZSATZ LDY #6
3260 JSR BYTSEND
3270 RTS
3280 ;
3290 GG LDA #"0"
3300 STA $FF
3310 JSR ZSATZ
3320 RTS
3330 ;
3340 GK LDA #"1"
3350 STA $FF
3360 JSR ZSATZ
3370 RTS
3380 ;
3390 ;
3400 RESET LDY #7
3410 LDA #0
3420 STA $FF
3430 JSR BYTSEND
3440 RTS
3450 ;
3460 ;
3470 DREH JSR CHKOM
3480 JSR FRMEVL
3490 LDY #4
3500 JSR AUF
3510 JSR SENDER
3520 JSR ZU
3530 RTS
3540 ;
3550 ;
3560 TEXT LDA #"," ; AUF KOMMA TESTEN
3570 LDY #0
3580 CMP ($7A),Y ; LAUFENDES ZEICHEN
3590 BNE LEER
3600 JSR $0073
3610 LDY #0
3620 JSR AUF
3630 JSR PRINT
3640 JSR ZU
3650 RTS
3660 LEER LDY #0
3670 JSR AUF
3680 LDA #13 ; NUR CR AUSGEBEN
3690 JSR BSOUT
3700 JSR ZU
3710 RTS
3720 ;
3730 ;
3740 STRICH JSR CHKOM
3750 LDY #5
3760 JSR AUF
3770 JSR FRMEVL
3780 JSR SENDER
3790 JSR ZU
3800 RTS
3810 ;
3820 ;
3830 HOME LDY #1
3840 LDA #"H"
3850 STA $FF
3860 JSR BYTSEND
3870 RTS
3880 ;
3890 ;
3900 INIT LDY #1
3910 LDA #"I"
3920 STA $FF
3930 JSR BYTSEND
3940 RTS
3950 ;
3960 ;
3970 MOVE JSR CHKOM
3980 LDY #1
3990 JSR AUF
4000 LDA #"M"
4010 DBYTE JSR BSOUT
4020 LDA #" "
4030 JSR BSOUT
4040 JSR FRMEVL ; X-KOORD.
4050 JSR FACASC
4060 JSR STROUT
4070 LDA #" "
4080 JSR BSOUT
4090 JSR CHKOM
4100 JSR FRMEVL ; Y-KOORD.
4110 JSR FACASC
4120 JSR STROUT
4130 JSR ZU
4140 RTS
4150 ;
4160 ;
4170 DRAW JSR CHKOM
4180 LDY #1
4190 JSR AUF
4200 LDA #"D"
4210 JMP DBYTE
4220 ;
4230 ;
4240 RMOVE JSR CHKOM
4250 LDY #1
4260 JSR AUF
4270 LDA #"R"
4280 JMP DBYTE
4290 ;
4300 ;
4310 RDRAW JSR CHKOM
4320 LDY #1
4330 JSR AUF
4340 LDA #"J"
4350 JMP DBYTE
4360 ;
4370 ;
4380 LINIE JSR MOVE
4390 JSR DRAW
4400 RTS
4410 ;
4420 ;
4430 SYSTEM LDX #255
4440 L1 INX
4450 LDA MELDUNG,X
4460 JSR BSOUT
4470 CPX #81
4480 BNE L1
4490 LDA $300 : STA HILF ; ALTE
4500 LDA $301 : STA HILF+1 ; VEKTOREN
4510 CLC ; RETTEN
4520 LDA #3
4530 LDA $308 : STA JUMP+1;SPRUNG NACH
4540 LDA #0 ;EVENTUELLER
4550 LDA $309 : STA JUMP+2;BEF.-ERWEIT.
4560 LDA #<WARM : STA $300 ;NEUE
4570 LDA #>WARM : STA $301 ;VEKTOREN
4580 LDA #<NEU : STA ZEIGER ;SETZEN
4590 LDA #>NEU : STA ZEIGER+1
4600 LDA #$60 ; RTS BEFEHL
4610 STA $C000 ; VERHINDERT RESTART
4620 RTS
4630 ;
4640 MELDUNG .ASC "[147]"
4650 .ASC " **** COMMODORE 1520 BASIC 1.3 ****"
4660 .BYT $0D
4670 .BYT $0D
4680 .ASC " (P) JAN.1985 =:= (C) BY S.SCHAEFER "
4690 .BYT $0D
4700 HILF .BYT $00 ; ZWISCHENSPEICHER
4710 .BYT $00 ; FUER WARMSTART-VEKTOR
4720 ;
4730 ;
4740 SENDER JSR FACASC ; FAC AUF
4750 JSR STROUT ; DRUCKER-
4760 LDA #" " ; KANAL
4770 JSR BSOUT ; + SPACE
4780 RTS
4790 ;
4800 ;
4810 KREIS JSR PARAM
4820 JSR KRMIT
4830 JSR MALEN
4840 RTS
4850 ;
4860 PARAM JSR CHKOM
4870 JSR FRMEVL
4880 LDX #<KX : LDY #>KX
4890 JSR FACMEM
4900 JSR CHKOM
4910 JSR FRMEVL
4920 LDX #<KY : LDY #>KY
4930 JSR FACMEM
4940 JSR CHKOM
4950 JSR FRMEVL
4960 LDX #<XRAD : LDY #>XRAD
4970 JSR FACMEM
4980 JSR CHKOM
4990 JSR FRMEVL
5000 LDX #<YRAD : LDY #>YRAD
5010 JSR FACMEM
5020 RTS
5030 ;
5040 KRMIT LDA #<KX : LDY #>KX
5050 JSR MEMFAC
5060 LDY #1
5070 JSR AUF
5080 LDA #"M" : JSR BSOUT ; AUF KREISMITTELPUNKT
5090 JSR SENDER
5100 LDA #<KY : LDY #>KY
5110 JSR MEMFAC
5120 JSR SENDER ; POSITIONIEREN
5130 JSR ZU
5140 JSR INIT
5150 RTS
5160 ;
5170 MALEN LDA #<XRAD : LDY #>XRAD
5180 JSR MEMFAC
5190 LDY #1
5200 JSR AUF
5210 LDA #"R"
5220 JSR BSOUT
5230 JSR SENDER
5240 LDA #"0"
5250 JSR BSOUT
5260 JSR ZU
5270 ;
5280 LDA #0
5290 STA ARGU:STA ARGU+1
5300 STA ARGU+2:STA ARGU+3:STA ARGU+4
5310 JMP PL ; ARGUMENT ERHOEHEN
5320 LOOP LDY #1 : JSR AUF
5330 JSR COS
5340 LDA #<XRAD : LDY #>XRAD
5350 JSR MEMMULT
5360 LDA #"J"
5370 JSR BSOUT
5380 JSR SENDER
5390 ;
5400 LDA #<ARGU : LDY #>ARGU
5410 JSR MEMFAC
5420 JSR SIN
5430 LDA #<YRAD : LDY #>YRAD
5440 JSR MEMMULT
5450 JSR SENDER
5460 JSR ZU
5470 ;
5480 PL LDA #$6C
5490 LDY #$E3 ; FLP 0.19=STEP
5500 JSR MEMFAC
5510 LDA #<ARGU : LDY #>ARGU
5520 JSR MEMPLUS
5530 LDX #<ARGU : LDY #>ARGU
5540 JSR FACMEM
5550 LDA #<GRENZE : LDY #>GRENZE
5560 CLC
5570 JSR VERGLCH
5580 BCS LOOP
5590 JSR ZU
5600 RTS
5610 ;
5620 ;
5630 PROG LDA #"," ; AUF KOMMA TESTEN
5640 LDY #0
5650 CMP ($7A),Y ; AKTUELLES ZEICHEN
5660 BNE ALLES
5670 JSR $0073
5680 ALLES LDY #0
5690 JSR AUF
5700 DEC $7A ; TEXTPOINTER ERNIEDRIGEN
5710 LDA #$9B ; LIST-CODE
5720 LDX #99 : STX FLAG ;LIST-FLAG SETZEN
5730 JSR $A7F7
5740 JSR ZU
5750 RTS
5760 ;
5770 ;
5780 WARM LDA FLAG ; WARMSTART ROUTINE
5790 CMP #99 ; UM NACH LIST DEN
5800 BEQ CH ; DRUCKERKANAL ZU
5810 JMP (HILF) ; SCHLIESSEN UND
5820 CH LDA #0 ; DIE READY-MELDUNG
5830 STA FLAG ; ZU UNTERDRUECKEN
5840 LDA #13 ;CR
5850 JSR BSOUT
5860 JSR ZU
5870 JMP $A474 ; READY-MODUS
5880 ;
5890 ;
5900 RAHMEN JSR PARAM
5910 ;
5920 LDY #1
5930 JSR AUF
5940 LDA #"M"
5950 JSR BSOUT
5960 LDA #" "
5970 JSR BSOUT
5980 LDA #<KX : LDY #>KX ; BEWEGUNG
5990 JSR MEMFAC ; NACH
6000 JSR SENDER ; X1/Y1
6010 LDA #<KY : LDY #>KY
6020 JSR MEMFAC
6030 JSR SENDER
6040 JSR ZU
6050 ;
6060 JSR DRAUF
6070 LDA #<XRAD : LDY #>XRAD
6080 JSR MEMFAC
6090 JSR SENDER
6100 LDA #<KY : LDY #>KY
6110 JSR MEMFAC
6120 JSR SENDER
6130 JSR ZU
6140 JSR DRAUF
6150 LDA #<XRAD : LDY #>XRAD
6160 JSR MEMFAC
6170 JSR SENDER
6180 LDA #<YRAD : LDY #>YRAD
6190 JSR MEMFAC
6200 JSR SENDER
6210 JSR ZU
6220 JSR DRAUF
6230 LDA #<KX : LDY #>KX
6240 JSR MEMFAC
6250 JSR SENDER
6260 LDA #<YRAD : LDY #>YRAD
6270 JSR MEMFAC
6280 JSR SENDER
6290 JSR ZU
6300 JSR DRAUF
6310 LDA #<KX : LDY #>KX
6320 JSR MEMFAC
6330 JSR SENDER
6340 LDA #<KY : LDY #>KY
6350 JSR MEMFAC
6360 JSR SENDER
6370 JSR ZU
6380 RTS
6390 ;
6400 ;
6410 DRAUF LDY #1 ;OPEN + DRAW-BEFEHL
6420 JSR AUF
6430 LDA #"D"
6440 JSR BSOUT
6450 LDA #" "
6460 JSR BSOUT
6470 RTS
6480 ;
6490 ;
6500 GRENZE .BYT $83 ; 2*(null)
6510 .BYT $55
6520 .BYT $DC
6530 .BYT $A7
6540 .BYT $6E
6550 FLAG .BYT $00 ; LIST-FLAG FUER WARMSTART-ROUTINE
6560 FAKTOR .BYT $7B ; (null)/180
6570 .BYT $0E
6580 .BYT $FA
6590 .BYT $35
6600 .BYT $12
6610 ;
6620 RADIUS JSR PARAM
6630 JSR CHKOM
6640 JSR FRMEVL
6650 LDA #<FAKTOR : LDY #>FAKTOR
6660 JSR MEMMULT
6670 LDX #<ARGU : LDY #>ARGU
6680 JSR FACMEM
6690 ;
6700 JSR KRMIT
6710 ;
6720 LDY #1
6730 JSR AUF
6740 LDA #"J"
6750 JSR BSOUT
6760 LDA #" "
6770 JSR BSOUT
6780 LDA #<ARGU : LDY #>ARGU
6790 JSR MEMFAC
6800 JSR COS
6810 LDA #<XRAD : LDY #>XRAD
6820 JSR MEMMULT
6830 JSR SENDER
6840 LDA #<ARGU : LDY #>ARGU
6850 JSR MEMFAC
6860 JSR SIN
6870 LDA #<YRAD : LDY #>YRAD
6880 JSR MEMMULT
6890 JSR SENDER
6900 JSR ZU
6910 RTS
6920 ;
6930 ;
6940 TRANSM JSR ALLPARAM ; 7 PARAMETER
6950 TRM LDY #1
6960 JSR AUF
6970 LDA #"M"
6980 REST JSR BSOUT
6990 LDA #" "
7000 JSR BSOUT
7010 JSR UMRECHNG
7020 RTS
7030 ;
7040 ;
7050 TRANSD JSR ALLPARAM ; 7 PARAMETER
7060 TRD LDY #1
7070 JSR AUF
7080 LDA #"D"
7090 JMP REST
7100 ;
7110 ;
7120 TRANSL JSR ALLPARAM
7130 JSR TRM
7140 JSR CHKOM
7150 JSR FRMEVL
7160 LDX #<XR : LDY #>XR
7170 JSR FACMEM
7180 JSR CHKOM
7190 JSR FRMEVL
7200 LDX #<YR : LDY #>YR
7210 JSR FACMEM
7220 JSR CHKOM
7230 JSR FRMEVL
7240 LDX #<ZR : LDY #>ZR
7250 JSR FACMEM
7260 JMP TRD
7270 ;
7280 ;
7290 ALLPARAM JSR CHKOM
7300 JSR FRMEVL
7310 LDX #<XR : LDY #>XR
7320 JSR FACMEM
7330 JSR CHKOM
7340 JSR FRMEVL
7350 LDX #<YR : LDY #>YR
7360 JSR FACMEM
7370 JSR CHKOM
7380 JSR FRMEVL
7390 LDX #<ZR : LDY #>ZR
7400 JSR FACMEM
7410 JSR CHKOM
7420 JSR FRMEVL
7430 LDX #<XV : LDY #>XV
7440 JSR FACMEM
7450 JSR CHKOM
7460 JSR FRMEVL
7470 LDX #<YV : LDY #>YV
7480 JSR FACMEM
7490 JSR CHKOM
7500 JSR FRMEVL
7510 LDX #<KOEF : LDY #>KOEF
7520 JSR FACMEM
7530 JSR CHKOM
7540 JSR FRMEVL
7550 LDX #<WINK : LDY #>WINK
7560 JSR FACMEM
7570 RTS
7580 ;
7590 ;
7600 UMRECHNG LDA #<WINK : LDY #>WINK
7610 JSR MEMFAC
7620 LDA #<FAKTOR : LDY #>FAKTOR
7630 JSR MEMMULT ; FAC NACH RADIANT
7640 JSR COS
7650 LDA #<YR : LDY #>YR
7660 JSR MEMMULT
7670 LDA #<XR : LDY #>XR
7680 JSR MEMPLUS
7690 LDA #<KOEF : LDY #>KOEF
7700 JSR MEMMULT
7710 LDA #<XV : LDY #>XV
7720 JSR MEMPLUS
7730 JSR SENDER
7740 ;
7750 LDA #<WINK : LDY #>WINK
7760 JSR MEMFAC
7770 LDA #<FAKTOR : LDY #>FAKTOR
7780 JSR MEMMULT ; FAC NACH RADIANT
7790 JSR SIN
7800 LDA #<YR : LDY #>YR
7810 JSR MEMMULT
7820 LDA #<ZR : LDY #>ZR
7830 JSR MEMPLUS
7840 LDA #<KOEF : LDY #>KOEF
7850 JSR MEMMULT
7860 LDA #<YV : LDY #>YV
7870 JSR MEMPLUS
7880 JSR SENDER
7890 JSR ZU
7900 RTS
7910 ;
7920 ;
7930 PAR3 JSR CHKOM
7940 JSR VARSUCH
7950 STA YRAD : STY YRAD+1 ;ZEIGER AUF ERSTE VARIABLE
7960 JSR CHKOM
7970 JSR VARSUCH
7980 STA YRAD+2 : STY YRAD+3 ;ZEIGER AUF ZWEITE VARIABLE
7990 JSR CHKOM
8000 JSR FRMEVL
8010 LDX #<WINK : LDY #>WINK
8020 JSR FACMEM
8030 RTS
8040 ;
8050 RADIANT LDA #<WINK : LDY #>WINK
8060 JSR MEMFAC
8070 LDA #<FAKTOR : LDY #>FAKTOR
8080 JSR MEMMULT
8090 JSR COS
8100 LDX #<STEP : LDY #>STEP
8110 JSR FACMEM ; STEP=COS(W)
8120 LDA #<WINK : LDY #>WINK
8130 JSR MEMFAC
8140 LDA #<FAKTOR : LDY #>FAKTOR
8150 JSR MEMMULT
8160 JSR SIN
8170 LDX #<ARGU : LDY #>ARGU
8180 JSR FACMEM ; ARGU=SIN(W)
8190 RTS
8200 ;
8210 ;
8220 TURN JSR PAR3
8230 JSR RADIANT
8240 LDA YRAD : LDY YRAD+1
8250 JSR MEMFAC
8260 LDA #<STEP : LDY #>STEP ;COS(W)
8270 JSR MEMMULT
8280 LDX #<ZR : LDY #>ZR
8290 JSR FACMEM ;MERKEN
8300 LDA YRAD+2 : LDY YRAD+3
8310 JSR MEMFAC
8320 LDA #<ARGU : LDY #>ARGU ;SIN(W)
8330 JSR MEMMULT
8340 LDA #<ZR : LDY #>ZR
8350 JSR MEMPLUS
8360 LDX #<PARK : LDY #>PARK
8370 JSR FACMEM ;MERKEN
8380 ;
8390 LDA YRAD : LDY YRAD+1
8400 JSR MEMFAC
8410 JSR CHSGN ; FAC=-FAC
8420 LDA #<ARGU : LDY #>ARGU ;SIN(W)
8430 JSR MEMMULT
8440 LDX #<ZR : LDY #>ZR
8450 JSR FACMEM ;MERKEN
8460 LDA YRAD+2 : LDY YRAD+3
8470 JSR MEMFAC
8480 LDA #<STEP : LDY #>STEP ;COS(W)
8490 JSR MEMMULT
8500 LDA #<ZR : LDY #>ZR
8510 JSR MEMPLUS
8520 LDA YRAD+2 : LDY YRAD+3
8530 STA $49 : STY $4A ;ZEIGER SETZEN
8540 JSR FACVAR
8550 LDA #<PARK : LDY #>PARK
8560 JSR MEMFAC
8570 LDA YRAD : LDY YRAD+1
8580 STA $49 : STY $4A ;ZEIGER SETZEN
8590 JSR FACVAR
8600 RTS
8610 ;
8620 ;
8630 ERRJUMP JSR CHKOM
8640 JSR FRMNUM
8650 JSR GETADR ; ZEILENNR. NACH $14/15
8660 LDA $14
8670 LDY $15
8680 STA ZEILE
8690 STY ZEILE+1
8700 LDA #<ERTEST ; FEHLERBEHANDLUNG
8710 STA $300
8720 LDA #>ERTEST ; EINSCHALTEN
8730 STA $301
8740 LDY #0
8750 LDA #","
8760 CMP ($7A),Y ; TEST AUF KOMMA
8770 BNE R1
8780 JSR CHRGET
8790 JSR FRMEVL
8800 LDA #99 ; ALLE FEHLER
8810 STA ERRFLAG ; UNTERDRUECKEN
8820 RTS
8830 R1 LDA #0 ;NUR ARITHMETHISCHE
8840 STA ERRFLAG ;FEHLER UNTERDRUECKEN
8850 RTS
8860 ZEILE .BYT $00
8870 .BYT $00
8880 ;
8890 ;
8900 ERROUT LDA #<WARM ; ERRJUMP AB-
8910 LDY #>WARM ; SCHALTEN
8920 STA $300
8930 STY $301
8940 RTS
8950 ;
8960 ERTEST CMP #$81 ; TEST AUF
8970 BNE NOEND
8980 CPY #$A3 ; PROGRAMMENDE
8990 BNE NOEND
9000 JSR ERROUT ;FEHLERMELDUNG ERMOEGL.
9010 JMP OKAY ;READY-MODUS
9020 NOEND LDA ERRFLAG
9030 BNE NOERR
9040 STX $02 ; FEHLERNUMMER MERKEN
9050 TXA
9060 BMI OKAY ; KEIN FEHLER
9070 CPX #14 ; ILL. QUANTITY
9080 BEQ NOERR
9090 CPX #15 ; OVERFLOW
9100 BEQ NOERR
9110 CPX #16 ; OUT OF MEMORY
9120 BEQ MEMORY
9130 CPX #20 ; DIVISION BY ZERO
9140 BEQ NOERR
9150 TAX
9160 JMP (HILF) ; ZUM ECHTEN WARMSTART
9170 OKAY JMP READY ; READY-MODUS
9180 NOERR STX $02 ;FEHLERNUMMER MERKEN
9190 LDA ZEILE
9200 LDY ZEILE+1
9210 STA $14
9220 STY $15
9230 JSR GOTO ;PROGRAMMZAEHLER-INCR.
9240 JMP INTPRT
9250 ;
9260 ERRFLAG .BYT $00
9270 ;
9280 MEMORY PLA
9290 TAY
9300 PLA
9310 LDX #$FA ; STACKPOINTER
9320 TXS ; INITIALISIEREN
9330 PHA
9340 TYA
9350 PHA
9360 JMP NOERR
9370 ;
9380 ;
9390 ERRNUM JSR CHKOM
9400 JSR VARSUCH ; BASICVARIABLE BEST.
9410 STA YRAD : STY YRAD+1
9420 LDY $02 ; FEHLERNUMMER HOLEN
9430 JSR BYTFAC ; UND UMWANDELN
9440 LDA YRAD : LDY YRAD+1
9450 STA $49 : STY $4A
9460 JSR FACVAR ; NUMMER IN BASICVAR.
9470 LDA #0
9480 STA $02
9490 RTS