home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1987 December
/
64er_Magazin_87-12_1987_Markt__Technik_de_Side_B.d64
/
source.teil2
< prev
Wrap
Text File
|
2022-10-26
|
29KB
|
1,344 lines
init jsr initsub
clr #move $37,$33 ;clr
lda $2d
sta $2f
sta $31
lda $2e
sta $30
sta $32
rts
initsub .blck
jsr gran
ldx #$69 ;lineflag:=0
stx algo1+34
stx algo2+34
ldx #1
stx costab
lda #0
ldy #$ff
l1 sta costab,y
dey
bne l1
ldx #[vartabend-vartab]
l2 lda vartab,x ;variablen auf
sta vb,x :defaultwerte
dex
bpl l2
#movei $8700,$283 ;speicher-
;ende
#movei befehle,$308
rts
.bend
warte jsr ende
jmp $a483
warmstart jsr ende
jmp $e38b ;weiter warmstart
ende lda #$37 ;memoff
sta 1
lda #$ff ;ausgang
sta $dc02 ;port a
cli
;alter outputvektor :
#movei $f1ca,$326
;alter interpr.-vek.:
#movei befehle,$308
;alter warmstart:
#movei $e38b,$300
;alte warteschleife:
#movei $a483,$302
;alter nmi-vektor:
#movei $fe47,$318
jsr graus
lda #0
sta $c6 ;puffer leer
lda puff
sta $68
rts
btest .blck
jsr xtest
bcs error
jsr ytest
bcs error
jsr ztest
bcs error
rts
error lda #<text
ldy #>text
jmp fehler
text .byte 'verschiebung zu gross'
.byte 0
.bend
dreh lda dimflag
bne hschleif
jmp dimerror
hschleif .blck
;neuer outputvektor:
#movei output,$326
;neuer interpr.vek.:
#movei l6,$308
;neuer warmstart:
#movei warmstart,$300
;neue warteschleife:
#movei warte,$302
;neuer nmi-vektor:
#movei nmi,$318
l1 jsr memon
lda $68 ;fac retten
sta puff
jsr clrscreen
jsr drehen
jsr bild
jsr anzeigen
jsr joy
lda puff
sta $68 ;wiederherstellen
lda #0
sta $c6 ;puffer leer
jsr $ea87 ;tastaturabfrage
lda autoflg
beq l1
jsr memoff
rts ;zur interpreterschl.
l6 jsr $0073
bne l2 ;kein zeilenende
l3 jmp $a7ae
l2 cmp #'\'
beq l7
jmp befehlesub ;weiter
l7 jsr l1
jmp l6
.bend
output .blck
pha
lda $9a
cmp #3
bne l1
lda #7
sta $dd00
lda #$9b
sta $d011
lda #$8
sta $d016
lda #$14
sta $d018
pla
jmp $e716
l1 jmp $f1d5
.bend
out .segment a
lda &a&+1
ldx &a&
jsr $bdcd
jsr $ab3b
.mend
getvarsub .blck ;holt variable
lda 1 ; nach x/y
pha
lda #$37 ;memoff
sta 1
jsr frmnum ;nach a/y
clc
lda $61
adc #3 ;*8
sta $61
cmp #3
bcc error ;overflow
jsr $b1aa ;integer
sta $15
sty $14
tax ;absolutwert
bpl l1
sec
lda #0
sbc $14
tay
lda #0
sbc $15
l1 cmp #$49 ;>$49e6 -> error
bcc l2
bne error
l3 cpy #$e7
bcc l2
error jmp illegal
l2 ldx $14
ldy $15
pla ;alter speicher
sta 1
rts
.bend
end1 ;
costab = $c400
offset1 = *+offset-$c500
* = $c500
.offs offset1
costab2 ;
.byte $00,$ff,$fb,$f5,$ec,$e1,$d4,$c4
.byte $b1,$9c,$85,$6b,$4e,$30,$0e,$eb
.byte $c4,$9c,$71,$43,$13,$e1,$ac,$74
.byte $3b,$fe,$c0,$7f,$3b,$f5,$ad,$62
.byte $15,$c5,$73,$1f,$c8,$6e,$13,$b4
.byte $54,$f1,$8c,$24,$ba,$4e,$df,$6e
.byte $fa,$84,$0c,$91,$14,$95,$13,$8f
.byte $09,$80,$f5,$68,$d9,$47,$b3,$1c
.byte $83,$e8,$4b,$ab,$0a,$66,$bf,$17
.byte $6c,$bf,$10,$5e,$aa,$f4,$3c,$82
.byte $c6,$07,$46,$83,$be,$f7,$2d,$62
.byte $94,$c4,$f2,$1e,$48,$70,$96,$ba
.byte $db,$fb,$18,$34,$4d,$65,$7a,$8e
.byte $9f,$ae,$bc,$c7,$d1,$d9,$de,$e2
.byte $e4,$e4,$e2,$de,$d8,$d1,$c7,$bc
.byte $af,$a0,$8f,$7d,$68,$52,$3a,$20
.byte $05,$e8,$c9,$a8,$86,$62,$3c,$14
.byte $eb,$c1,$94,$66,$36,$05,$d2,$9e
.byte $68,$30,$f7,$bc,$80,$42,$03,$c2
.byte $80,$3c,$f7,$b0,$68,$1f,$d4,$88
.byte $3a,$eb,$9a,$49,$f6,$a1,$4c,$f5
.byte $9c,$43,$e8,$8c,$2f,$d0,$70,$10
.byte $ad,$4a,$e6,$80,$1a,$b2,$49,$df
.byte $74,$08,$9b,$2d,$be,$4e,$dd,$6b
.byte $f8,$84,$0f,$99,$22,$aa,$32,$b9
.byte $3e,$c3,$48,$cb,$4d,$cf,$50,$d1
.byte $50,$cf,$4d,$cb,$47,$c3,$3f,$ba
.byte $34,$ae,$27,$9f,$17,$8e,$05,$7c
.byte $f1,$67,$dc,$50,$c4,$38,$ab,$1e
.byte $90,$02,$74,$e5,$56,$c7,$38,$a8
.byte $18,$87,$f7,$66,$d5,$44,$b3,$21
.byte $90,$fe,$6c,$da,$48,$b6,$24,$92
costab3 ;
.byte $00,$ff,$ff,$ff,$ff,$ff,$ff,$ff
.byte $ff,$ff,$ff,$ff,$ff,$ff,$ff,$fe
.byte $fe,$fe,$fe,$fe,$fe,$fd,$fd,$fd
.byte $fd,$fc,$fc,$fc,$fc,$fb,$fb,$fb
.byte $fb,$fa,$fa,$fa,$f9,$f9,$f9,$f8
.byte $f8,$f7,$f7,$f7,$f6,$f6,$f5,$f5
.byte $f4,$f4,$f4,$f3,$f3,$f2,$f2,$f1
.byte $f1,$f0,$ef,$ef,$ee,$ee,$ed,$ed
.byte $ec,$eb,$eb,$ea,$ea,$e9,$e8,$e8
.byte $e7,$e6,$e6,$e5,$e4,$e3,$e3,$e2
.byte $e1,$e1,$e0,$df,$de,$dd,$dd,$dc
.byte $db,$da,$d9,$d9,$d8,$d7,$d6,$d5
.byte $d4,$d3,$d3,$d2,$d1,$d0,$cf,$ce
.byte $cd,$cc,$cb,$ca,$c9,$c8,$c7,$c6
.byte $c5,$c4,$c3,$c2,$c1,$c0,$bf,$be
.byte $bd,$bc,$bb,$ba,$b9,$b8,$b7,$b6
.byte $b5,$b3,$b2,$b1,$b0,$af,$ae,$ad
.byte $ab,$aa,$a9,$a8,$a7,$a6,$a4,$a3
.byte $a2,$a1,$9f,$9e,$9d,$9c,$9b,$99
.byte $98,$97,$95,$94,$93,$92,$90,$8f
.byte $8e,$8c,$8b,$8a,$88,$87,$86,$84
.byte $83,$82,$80,$7f,$7e,$7c,$7b,$7a
.byte $78,$77,$75,$74,$73,$71,$70,$6e
.byte $6d,$6c,$6a,$69,$67,$66,$64,$63
.byte $61,$60,$5f,$5d,$5c,$5a,$59,$57
.byte $56,$54,$53,$51,$50,$4e,$4d,$4b
.byte $4a,$48,$47,$45,$44,$42,$41,$3f
.byte $3e,$3c,$3b,$39,$38,$36,$35,$33
.byte $31,$30,$2e,$2d,$2b,$2a,$28,$27
.byte $25,$24,$22,$20,$1f,$1d,$1c,$1a
.byte $19,$17,$15,$14,$12,$11,$0f,$0e
.byte $0c,$0a,$09,$07,$06,$04,$03,$01
cosend ;
vartab .word 0 ;zw
.byte $e0,0,0;ba,bi
.word 0,0 ;immer,eventl
.word $cf00 ;lanf
.word 0,0,0 ;wa,wb
.byte 5,0,0 ;dwa
.byte 5,0,0 ;dwb
.word 0,0,0 ;x,y,z
.word 80,80,80;delx,dely,delz
.byte 0 ;dimflag
.byte 0 ;autoflg
.byte 0 ;joyflg
.byte 0 ;perspflg
.word -[1000*16];aug
.word -[500*16];s
.word 500*16 ;as
.word $6000 ;xmin
.word $6000 ;ymin
.word $6000 ;zmin
.word $a000 ;xmax
.word $a000 ;ymax
.word $a000 ;zmax
vartabend ;
meldung .byte $93,$0d
.byte ' **** '
.byte 'dreher von markus'
.byte ' olbrich ****'
.byte $0d,$0d
.byte ' 64k ram system ',0
meldend ;
offset2 = *+offset1-$c800
* = $c800
.offs offset2
getnum lda 1 ;holt 16bit wert
pha
lda #$37 ;memoff
sta 1
jsr frmnum ;nach $14/$15
jsr $b1aa ;integer
sta $15
sty $14
pla
sta 1 ;alter speicher
rts
getvar .segment a ;holt variable
jsr getvarsub
stx &a&
sty &a&+1
.mend
getpar .macro par ;holt parameter
jsr getparsub ;nach &par&
sta &par&
.mend
getparsub .blck
jsr getnum
lda $15
beq l1
error jmp illegal
l1 lda $14
and #1
cmp $14
bne error
rts
.bend
ptest .blck
lda pmax+1
cmp $15
bcc l2 ;>pmax
bne l3
lda pmax
cmp $14
bcs l3 ;<=pmax
l2 jmp illegal
l3 rts
.bend
pumrech .blck ;in :nummer $14/$15
jsr ptest ;out:pvek
#move $14,pvek
#ashl pvek ;*16
#ashl pvek
#ashl pvek
#ashl pvek
#add panf,pvek,pvek
ldx #$87
cpx panf+1
bcc l1 ;>$87
cmp #$87
bcc l1 ;<$87
clc
lda pvek+1
adc #>dend+1-$87
sta pvek+1
l1 rts
.bend
ltest .blck
lda lmax+1
cmp $15
bcc l2 ;>lmax
bne l3
lda lmax
cmp $14
bcs l3
l2 jmp illegal
l3 rts
.bend
lumrech .blck ;in :nummer $14/$15
jsr ltest ;out:lvek
#move $14,lvek
#ashl lvek ;*4
#ashl lvek
#add lanf,lvek,lvek
ldx #$87
cpx lanf+1
bcc l1 ;>$87
cmp #$87
bcc l1 ;<$87
clc
lda lvek+1
adc #>dend+1-$87
sta lvek+1
l1 rts
.bend
;anfang par
obj .blck ;obj pmax,lmax
jsr getnum
#move $14,pmax
cmp #$0d
bcc l1 ;<$0d00
l2 jmp $a435 ;out of memory
l1 jsr komma
jsr getnum
#move $14,lmax
cmp #$27
bcs l2 ;>=$2700
.bend
dim2 .blck
lsr $15 ;/4
ror $14
lsr $15
ror $14
l5 #add $14,pmax,$14
#addi 3,$14,$14
#ashl $14 ;*16
#ashl $14
#ashl $14
#ashl $14
lda #$e0->dend-2
cmp $15
bcc l10 ;$14>$e0-dend-2
#movei $8700,$14
jmp l6
l10 sec
lda #[$87+[$e0-[>dend+3]]]
sbc $15
sta $15
bcc l8 ;unterlauf
l6 lda $2e ;cmp varanf
cmp $15
bcc l7
bne l8
lda $2d
cmp $14
bcc l7
l8 jmp $a435 ;<=varanf -> error
l7 #move $14,panf
#move pmax,$14
inc $14
bne l9
inc $15
l9 jsr pumrech+3 ;ohne ptest
#move pvek,lanf
lda #1 ;dimensioniert
sta dimflag
jsr memon
#move lmax,zw
l11 #move zw,$14
jsr lumrech+3
ldy #1
lda #$ff ;unbelegt
sta (lvek),y
ldx zw
dec zw
txa
bne l11
dec zw+1
bpl l11
#move pmax,zw
l12 #move zw,$14
jsr pumrech+3
ldy #1
lda #$80 ;unbelegt
sta (pvek),y
ldx zw
dec zw
txa
bne l12
dec zw+1
bpl l12
jsr memoff
jmp clr
.bend
dwset ; dwset dwa,dwb
jsr getnum
#move $14,dwa
jsr komma
jsr getnum
#move $14,dwb
rts
delset ; delset delx,dely,delz
#getvar delx
jsr komma
#getvar dely
jsr komma
#getvar delz
rts
perspset ;perspset aug,s
.blck
#getvar aug
jsr komma
#getvar s
#sub s,aug,as
bvc l2
bmi l1 ;v=1 und n=1
l3 lda #<text ;error
ldy #>text
jmp fehler
l2 bmi l3 ;v=0 und n=1
l1 rts
text .byte 'aug>s',0
.bend
dimtext .byte 'objekt nicht '
.byte 'dimensioniert',0
dimerror lda #<dimtext
ldy #>dimtext
fehler sta zw
sty zw+1
jsr $ffcc
lda #0
sta $13
jsr $aad7
jsr $ab45
lda zw
ldy zw+1
jsr $ab1e
jmp $a462
modset ; modset joyflg,autoflg,
; perspflg
#getpar joyflg
jsr komma
#getpar autoflg
jsr komma
#getpar perspflg
rts
ver .macro a,b,c
lda &a&
cmp &b&
lda &a&+1
sbc &b&+1
bvs lver1
bpl &c&
bmi lver2
lver1 bmi &c&
lver2 .mend
pset ; pset nummer,x,y,z
lda dimflag
bne *+5
jmp dimerror
jsr getnum
jsr komma
jsr pumrech
#move pvek,$fe
#getvar fac
jsr komma
jsr memon
#movenin fac,0,$fe
#getvar fac
jsr komma
#movenin fac,2,$fe
#getvar fac
#movenin fac,4,$fe
jsr memoff
jsr minimax
jmp btest
minimax .blck
jsr memon
#movevin $fe,0,fac
#ver xmax,fac,l1
#move fac,xmax
l1 #ver fac,xmin,l2
#move fac,xmin
l2 #movevin $fe,2,fac
#ver ymax,fac,l3
#move fac,ymax
l3 #ver fac,ymin,l4
#move fac,ymin
l4 #movevin $fe,4,fac
#ver zmax,fac,l5
#move fac,zmax
l5 #ver fac,zmin,l6
#move fac,zmin
l6 jmp memoff
.bend
lset ; lset lnum,pnum,pnum
lda dimflag
bne *+5
jmp dimerror
jsr getnum
jsr lumrech
jsr komma
jsr getnum
jsr pumrech
jsr memon
#move lvek,$fe
#movenin pvek,0,$fe
jsr memoff
jsr komma
jsr getnum
jsr pumrech
jsr memon
#movenin pvek,2,$fe
jsr memoff
rts
video ;video hinten,obj,lineflag
.blck
jsr getnum
lda $15
bne l2
lda $14
sta zw
and #$f0
beq l1
l2 jmp illegal
l1 jsr komma
jsr getnum
lda $15
bne l2
lda $14
tay
and #$f0
bne l2
tya
asl
asl
asl
asl
ora zw
jsr farben
jsr komma
jsr getparsub ;lineflag
lda $14
beq l3
lda #$91 ;=1
.byte $ec
l3 lda #$69 ;=0
sta algo1+34
sta algo2+34
rts
.bend
joy .blck
lda #$37 ;i/o einblenden
sta 1
lda #$e0 ;eingang
sta $dc02
lda $dc00 ;joystick lesen
tax
and #16
bne l5
pla ;button -> ende
pla
jmp ende
l5 lda joyflg
beq l12
jsr lwa
jsr lwb
jsr lxa
jsr lya
jsr lza
rts
l12 ldy #0
txa
and #1
bne l1
iny
jsr lwb ;oben
l1 txa
and #2
bne l2
iny
#sub wb,dwb,wb ;unten
l2 txa
and #4
bne l3
iny
#sub wa,dwa,wa ;links
l3 txa
and #8
bne l4
iny
jsr lwa ;rechts
l4 lda #$ff ;ausgang
sta $dc02 ;port a
ldx #$ef
stx $dc00 ;spalte waehlen
ldx $dc01 ;port b
txa
and #$02
bne l6
iny
jsr lza ;i
l6 txa
and #$04
bne l7
iny
jsr lxs ;j
l7 txa
and #$10
bne l8
iny
jsr lzs ;m
l8 txa
and #$20
bne l9
iny
jsr lxa ;k
l9 txa
and #$80
bne l10
iny
jsr lys ;n
l10 ldx #$f7
stx $dc00
lda $dc01
and #$40
bne l11
iny
jsr lya ;u
l11 lda autoflg
bne l13
tya
bne l13
jmp joy
l13 rts
lwa #add wa,dwa,wa
rts
lwb #add wb,dwb,wb
rts
lxa #add x,delx,x
jsr xtest
bcs lxs
rts
lya #add y,dely,y
jsr ytest
bcs lys
rts
lza #add z,delz,z
jsr ztest
bcs lzs
rts
lxs #sub x,delx,x
jsr xtest
bcs lxa
rts
lys #sub y,dely,y
jsr ytest
bcs lya
rts
lzs #sub z,delz,z
jsr ztest
bcs lza
rts
.bend
xtest .blck
#add x,xmax,$14
jsr gtest
bcs l18
#add xmin,x,$14
jsr ktest
l18 rts
.bend
ytest .blck
#add y,ymax,$14
jsr gtest
bcs l19
#add ymin,y,$14
jsr ktest
l19 rts
.bend
ztest .blck
#add z,zmax,$14
jsr gtest
bcs l20
#add zmin,z,$14
jsr ktest
l20 rts
.bend
gtest .blck
bmi ktest ;test auf bereichs-
cmp #$49 ;ueberschreitung
bcc l1 ;<$49
bne cset ;>$49
lda $14
cmp #$e7
l1 rts
.bend
ktest .blck
bpl gtest
cmp #$b6
bcc cset ;<$b6
bne l1 ;>$b6
lda $14
cmp #$1a
bcc cset ;<$1a
l1 clc
rts
.bend
cset sec ;ausserhalb
rts
anfset ;anfset wa,wb,x,y,z
jsr getnum
#move $14,wa
jsr komma
jsr getnum
#move $14,wb
jsr komma
#getvar x
jsr komma
#getvar y
jsr komma
#getvar z
jmp btest
bliste .byte 'init',0 ;befehlsliste
.byte 'obj',0
.byte 'pset',0
.byte 'lset',0
.byte 'delset',0
.byte 'dwset',0
.byte 'modset',0
.byte 'perspset',0
.byte 'video',0
.byte 'dreh',0
.byte 'anfset',0
.byte 'giga',0
badr .word init,obj,pset,lset,delset
.word dwset,modset,perspset
.word video,dreh,anfset,giga
dend ;
offset3 = *+offset2-$8700
* = $8700
.offs offset3
giga .blck
fz = $c7e0
pz = fz+2
fp = pz+2 ;flaechenpointer
fpf = fp+2 ;folgender fp
pbis = fpf+2
lbis = pbis+2
ep = lbis+2
fanz = ep+1
panz = fanz+2
q = panz+2
qa = q+2
qv = qa+2
lda $9d
ora #$40
sta $9d
#movei closer,$300
jsr $ffe7 ;clall
jsr $ad9e ;frmevl
jsr $b6a3 ;frestr
cmp #14
bcc l3 ;<14
ldx #23 ;string too long error
jmp $a437
l3 pha
tay
l1 lda ($22),y ;name in puffer
sta textpuff+3,y
dey
bpl l1
pla
clc
adc #[3+4]
pha ;gesamtlaenge
tay
lda #0
sta textpuff,y
ldx #4
l2 lda text2-1,x ;text2 anhaengen
sta textpuff-1,y
dey
dex
bne l2
pla ;gesamtlaenge
ldx #<textpuff
ldy #>textpuff
jsr $ffbd ;filenamenparameter
lda #1 ;log. filenr.
ldx #8 ;geraete nr.
ldy #2 ;sek. adresse
jsr $ffba ;parameter setzen
jsr open
lda #2 ;log. filenr.
ldx #8 ;geraete nr.
ldy #3 ;sek. adresse
jsr $ffba ;parameter setzen
jsr open
ldx #1 ;log. filenr.
jsr chkin
jsr wertin ;fanz holen
sta fanz
sty fanz+1
jsr wertin ;panz holen
sta panz
sty panz+1
jsr wertin ;ueberlesen
jsr init
lda panz
sta pmax ;pmax:=panz
sta lmax ;lmax:=panz
sta $14 ;$14 :=panz
ldy panz+1
sty pmax+1
sty lmax+1
sty $15
jsr dim2 ;dimensionieren
#move fanz,$fe ;fanz mal 3bytes
l4 jsr basin ;ueberlesen
jsr basin
jsr basin
sec
lda $fe
sbc #1
sta $fe
bcs l4.1
dec $ff
l4.1 lda $fe
bne l4
lda $ff
bne l4
ldx #2 ;auf file 2 gehen
jsr chkin
jsr wertin ;3 werte ueberlesen
jsr wertin
jsr wertin
.blck
lda #0
sta fz ;fz:=0
sta fz+1
sta pz ;pz:=0
sta pz+1
sta pbis ;pbis:=0
sta pbis+1
sta lbis ;lbis:=0
sta lbis+1
ldx #2 ;file 2
jsr chkin
jsr basin ;fp lesen
sta fp
jsr basin
sta fp+1
jsr basin
l1 lda #0 ;ep:=0
sta ep
ldx fz ;fanz=fz+1?
ldy fz+1
inx
bne l22
iny
l22 cpx fanz
bne l23
cpy fanz+1
bne l23
;fanz=fz+1 ->
#move panz,fpf;fpf:=panz+1
inc fpf
bne l2
inc fpf+1
jmp l2
l23 ldx #2 ;file 2
jsr chkin
jsr basin ;fpf lesen
sta fpf
jsr basin
sta fpf+1
jsr basin
l2 ldx #1 ;punkt lesen
jsr chkin ;file 1
ldx #5
l3 txa
pha
jsr basin ;low
sta fac
jsr basin ;high
eor #$80
sta fac+1
jsr zerr ;*1.25
lda fac+1
asl ;vorzeichen in c
pla
tax
lda fac+1 ;high
ror
sta puffer,x ;in puffer
dex
lda fac ;low
ror
sta puffer,x
dex
bpl l3
sec
lda #0
sbc puffer+4
sta puffer+4
lda #0
sbc puffer+5
sta puffer+5
#move puffer,fac
#move puffer+2,puffer
sec
lda #0
sbc fac
sta puffer+2
lda #0
sbc fac+1
sta puffer+3
inc pz ;pz+=1
bne l4
inc pz+1
l4 ldx fp ;fpf=fp+1?
ldy fp+1
inx
bne l5
iny
l5 cpx fpf
bne l6 ;<>
cpy fpf+1
bne l6 ;<>
jmp l7 ;fpf=fp+1
l6 lda #0 ;stelle q finden
sta $14
sta $15
l8 jsr memoff
jsr pumrech
jsr memon
lda $14
cmp pbis
bne l9
lda $15
cmp pbis+1
bne l9
inc pbis ;$14=pbis -> pbis+=1
bne l10
inc pbis+1
jmp l10
l9 ldy #5
l11 lda (pvek),y
cmp puffer,y
bne l12
dey
bpl l11
l10 lda pvek ;gefunden
sta q
sta $fe
lda pvek+1
sta q+1
sta $ff
jmp l13
l12 inc $14 ;$14+=1
bne l8
inc $15
jmp l8
l13 ldy #5 ;puffer nach q
l14 lda puffer,y
sta (pvek),y
dey
bpl l14
jsr minimax
lda ep ;ep=0?
bne l15 ;ep=1
inc ep ;ep:=1
lda pvek ;qa:=q :qv:=q
sta qa
sta qv
lda pvek+1
sta qa+1
sta qv+1
jmp l2 ;naechsten punkt
l15 jsr l17 ;linie von q
lda qv ; nach qv
sta (lvek),y
iny
lda qv+1
sta (lvek),y
jsr memoff
lda fpf
cmp pz
bne l16 ;fpf<>pz
lda fpf+1
cmp pz+1
bne l16 ;fpf<>pz
jsr l17 ;linie von q
lda qa ; nach qa
sta (lvek),y
iny
lda qa+1
sta (lvek),y
jsr memoff
jmp l7
l17 #move lbis,$14
inc lbis
bne l21
inc lbis+1
l21 jsr lumrech
jsr memon
ldy #0 ;linie von q
lda q
sta (lvek),y
iny
lda q+1
sta (lvek),y
iny
rts
l16 #move q,qv
jmp l2
l7 inc fz ;fz+=1
bne l18
inc fz+1
l18 #move fpf,fp ;fp:=fpf
lda fanz+1
cmp fz+1
bne l19
lda fanz
cmp fz
beq l20
l19 jmp l1 ;fz<>fanz -> l1
l20 lda #0 ;aufraeumen
sta $fe
sta $ff
l24 #move $fe,$14
jsr memoff
jsr lumrech
jsr memon
ldy #3
l25 lda (lvek),y
sta puffer,y
dey
bpl l25
inc $14
bne l26
inc $15
l26 jsr memoff
jsr lumrech
jsr memon
ldy #3
l27 lda (lvek),y
cmp puffer,y
bne l28
dey
bpl l27
l30 lda #$ff ;($lvek) loeschen
ldy #1
sta (lvek),y
jmp l29
l28 ldy #0
lda (lvek),y
cmp puffer+2
bne l29
iny
lda (lvek),y
cmp puffer+3
bne l29
iny
lda (lvek),y
cmp puffer
bne l29
iny
lda (lvek),y
cmp puffer+1
beq l30
l29 lda $14
cmp lbis
bne l31
lda $15
cmp lbis+1
beq l32
l31 inc $14 ;$14<>lbis
bne l26
inc $15
jmp l26
l32 inc $fe ;$14=lbis -> $fe+=1
bne l33
inc $ff
l33 lda $fe
cmp lbis
bne l34 ;$fe<>lbis
lda $ff
cmp lbis+1
beq l35
l34 jmp l24
l35 jsr memoff
rts
.bend
wertin ;holt zahl von disk
;und wandelt nach integer
.blck
inc $13
ldx #0
l1 jsr basin
cmp #$d ;return -> ende
beq l2
sta $200,x
inx
cpx #$59
bcc l1
ldx #$17 ;zu lang
jmp $a437 ;error
l2 jsr $aaca
dec $13
#move $7a,$4b
stx $7a
sty $7b
jsr $ae83 ;ascii nach fac
jsr $b1b8 ;integer
#move $4b,$7a
lda $65 ;low
ldy $64 ;high
rts
.bend
fehler .blck
bcc l2 ;kein fehler
pha ;fehlernummer
jsr status
pla ;fehler holen
tax
jmp $a437 ;fehlerausgabe
l2 pha
lda $90 ;status
and #$3f ;eoi loeschen
bne l1
pla ;kein fehler
rts
l1 pla ;fehler
jsr status
jmp $e382 ;warmstart
.bend
close lda #1
jsr $ffc3 ;close 1
lda #2
jsr $ffc3 ;close 2
jsr clrch
sta $13
rts
closer txa ;fehler retten
pha
jsr close
#movei $e38b,$300
pla ;fehler holen
tax
jmp ($300)
basin lda $90 ;status
and #$40 ;eoi isolieren
bne close ;eoi
jsr $ffcf
jmp fehler
chkin jsr $ffc6
jmp fehler
clrch = $ffcc
open jsr $ffc0
jmp fehler
status .blck
lda #8 ;fehlermeldung
sta $ba
jsr $ffb4 ;talk
bit $90
bmi l2 ;device not present
lda #13
jsr $ffd2
lda #[15+$60]
sta $b9
jsr $ff96 ;sectalk
l1 jsr $ffa5 ;iecin
jsr $ffd2 ;print
cmp #13
bne l1
l2 jsr $ffab ;untalk
rts
.bend
text2 .byte ',s,r'
textpuff .byte 'ob.'
puffer ;
*=*+16
.bend
notbel .blck ;error bei nicht
jsr ende ;definiertem punkt
lda #<text
ldy #>text
jmp fehler
text .byte 'punkt nicht definiert',0
.bend
befehle .blck
jsr $0073
beq end ;zeilenende
jmp befehlesub
end jmp $a7ae
.bend
befehlesub .blck ;sucht in der liste
tax ;nach befehlen
bmi end ;token
ldx #0
stx $ff
l4 ldy #0
lda bliste,x
l2 cmp ($7a),y
bne l1
iny
inx
lda bliste,x
bne l2
lda $ff ;befehl gefunden
asl
tax
clc
tya
adc $7a
sta $7a
bcc l3
inc $7b
l3 lda badr,x
sta $fe
lda badr+1,x
sta $ff
jsr l6
jmp $a7ae
l6 jmp ($fe) ;befehl ausfuehren
rts
l1 inc $ff
lda $ff
cmp #12
beq end
l5 inx ;ungleich
lda bliste,x
bne l5
inx
jmp l4
end jsr $0079 ;chrgot
jmp $a7e7 ;weiter interpreter
;schleife
.bend
gigaend ;