;:sys58451 sys36864 ;.opt oo *= $c000 basvect =$300 eingabe =$a483 strout =$ab1e cr =13 clr =$a65e fehler =$e38b dirmod =$3a zeilnr =$32e byte =$14 suchline =$a613 startptr =$a68e goto =$a8a0 cinter =$a7ae initst =$a67a hochko =$f ptr =$7a line =$200 flag2 =8 tprint =$99 pointer =$b oldinter =$a609 namen =$a09e oldif1 =$ada6 chrgot =$79 chrget =115 rem =$a93b mem =$71 erg =$61 tif =$8b tthen =$a7 tokend =$cc normal =$a7e7 tfunkt =224 weiter =$a7ae typ =$d funktold =$ae8d listt =$a6f3 normlist =$a724 listptr =$49 giveout =$ab47 listend =$a6ef port0 =0 port1 =1 getadb =$b7eb abmp =$f9 kauf =$aefa kzu =$aef7 sgn =$bc3e auswert =$ada6 setptr =$b7e6 crunch =$a579 strpar =$b782 getklam =$aef1 nodir =$b3a6 toolong =$a571 fac0 =$b8f7 getline =$a96b unlist =$ffae listen =$ffb1 seclist =$ff93 sa =$b9 ga =$ba stradr =$22 frmevl =$ad9e frestr =$b6a3 iecout =$ffa8 clrchn =$ffcc talk =$ffb4 sectalk =$ff96 iecin =$ffa5 bsout =$ffd2 untalk =$ffab floppy =8 bank =$dd00 satz =$d018 ctrl1 =$d011 para =$e1d4 loadr =$f49e saver =$f5dd tmp =$f7 closeiec =$f642 iecopen =$f3d5 basout =$e10c basin =$e112 naxout =$bdd1 status =$90 namadr =$bb namlen =$b7 return =$aad7 stop =$ffe1 space =$ab3f ieccmdin =$f237 errorausw =$e0f9 basst =$2b basend =$2d link =$a533 off =$e453 getbyt =$b79e getkx =$b7f1 spalte =211 tto =$a4 ckcom =$aefd jmp gogo errfl .byt 0 lxkoo .word 0 lykoo .byt 0 errnum .byt 0 mask .byt 0 axkoo .word 0 aykoo .byt 0 f1 .byt 0 latch .word 0 f2 .byt 0 bsvct .word wrmstrt,eingabe,inter,list,beferk,fkterk message .byte "\x93\x9a\x11 ** erweiterte graphic-basic version **" .byt cr .byte "\x11 (c) 1985 by b. smith & n. heusler" .byt cr,0 see .byt cr .byte "\x12\x11siehe 'run' 6/86 s.52ff\x11" .byt 0 bef .byte "draWploTclScoLolDswaPcopYtexTgroNgrofFgloaDgsavE" .byte "caTdisKdsTerrgOerrofFofFhelP\Q\Q\Q\Q\Q\Q\QtesT" .byte "evL" .byt 0 tab2 .word plot,plot,cls,col,old,swap,copy,text,grin,grof .word glod,gsav,dir,disk,dst,errgo,erroff,off,help .word rem,rem,rem,rem,rem,rem,rem tab4 .word test-1,evl-1 map2 .byt 128,64,32,16,8,4,2,1 map1 .word $e000,$e140,$e280,$e3c0 .word $e500,$e640,$e780,$e8c0 .word $ea00,$eb40,$ec80,$edc0 .word $ef00,$f040,$f180,$f2c0 .word $f400,$f540,$f680,$f7c0 .word $f900,$fa40,$fb80,$fcc0 .word $fe00 map3 .word up,down,left,right,retur map4 .byt 128,0,192,224,64,192,128,128 gogo ldx #11 lolo lda bsvct,x sta basvect,x dex bpl lolo inx stx lxkoo stx lxkoo+1 stx lykoo stx errfl lda #message jsr strout jsr clr ldx #$80 .byt $2c err1 lda #$b wrmstrt txa bmi errut ldy errfl beq errout sta errnum ldy dirmod iny bne onerr errout jsr grof errut ldy #0 sty errfl jmp fehler onerr jsr initst lda zeilnr sta byte lda zeilnr+1 sta byte+1 jsr suchline ldx errnum bcc errout jsr startptr jsr goto+3 jsr cinter rti inter ldx ptr ldy #4 sty hochko l37 lda line,x bpl l43 cmp #-1 beq l7e inx bne l37 l43 cmp #$20 beq l7e sta flag2 cmp #34 beq la3 bit hochko bvs l7e cmp #"?" bne l59 lda #tprint bne l7e l59 cmp #"0" bcc l61 cmp #"<" bcc l7e l61 sty mem ldy #0 sty pointer dey stx ptr dex l6b iny inx l6d lda line,x sec sbc namen,y beq l6b cmp #$80 bne laa l7a ora pointer l7c ldy mem l7e inx iny sta line-5,y and #-1 beq le1 sec sbc #$3a beq l91 cmp #"i" bne l93 l91 sta hochko l93 sec sbc #"u" bne l37 sta flag2 l9a lda line,x beq l7e cmp flag2 beq l7e la3 iny sta line-5,y inx bne l9a laa ldx ptr inc pointer lae iny lda namen-1,y bpl lae lda namen,y bne l6d ldy #-1 dex lbc inx iny lbe lda line,x sec sbc bef,y beq lbc cmp #$80 beq l7a ldx ptr inc pointer ld1 iny lda bef-1,y bpl ld1 lda bef,y bne lbe lda line,x bpl l7c le1 jmp oldinter if jsr oldif1 jsr chrgot cmp #tthen bne gotof jsr chrget gotof lda erg bne wahr jsr rem jmp cinter wahr jsr chrgot bcs fromif jsr goto jmp cinter beferk jsr chrget fromif cmp #tif beq if cmp #tokend bcs anfu errb jsr chrgot jmp normal anfu cmp #tfunkt bcs errb sbc #tokend-1 asl tax lda tab2,x sta bexe+1 lda tab2+1,x sta bexe+2 jsr chrget bexe jsr 0 nbef jmp weiter fkterk lda #0 sta typ jsr chrget cmp #230 bcs ausr pii jsr chrgot jmp funktold ausr cmp #-1 beq pii sec sbc #230 asl tax lda tab4+1,x pha lda tab4,x pha jmp chrget pout jmp listt list bpl pout cmp #-1 beq pout bit hochko bmi pout cmp #204 bcs lister jmp normlist lister sty listptr sec sbc #tokend-1 tax ldy #-1 lop dex beq out lopp iny lda bef,y bpl lopp bmi lop out iny lda bef,y bmi endp jsr giveout bne out endp jmp listend romof sei lda #$25 .byt $2c basof lda #$36 ldy #$2f sty port0 sta port1 rts romin lda #$37 ldy #$2f sty port0 sta port1 cli rts getkoo jsr getadb cpx #200 bcs ilgl1 ldy byte lda byte+1 cmp #1 bcc ok1 bne ilgl1 cpy #64 bcs ilgl1 ok1 rts getpara1 jsr getkoo stx lykoo sta lxkoo+1 sty lxkoo rts ilgl1 ldx #$e jmp wrmstrt getpara2 jsr getkoo stx aykoo sta axkoo+1 sty axkoo rts berpoint ldx lykoo txa and #7 sta abmp txa lsr and #%1111100 lsr tay lda lxkoo and #$f8 ora abmp adc map1,y sta abmp lda lxkoo+1 adc map1+1,y sta abmp+1 lda lxkoo and #7 tay lda map2,y sta mask rts getcol jsr getbyt txa lsr ror ror sta f1 rts setmask ldy #0 lda (abmp),y bit f1 bmi opt1 ora mask bit f1 bvs opt2 opt1 bvs opt3 eor mask opt2 sta (abmp),y opt3 rts errgo jsr getline lda byte sta zeilnr lda byte+1 sta zeilnr+1 lda #-1 .byt $2c erroff lda #0 sta errfl rts disk jsr frmevl jsr frestr sta latch lda #floppy sta ga jsr listen lda #$6f sta sa jsr seclist ldy #0 pol ldx latch beq close lda (stradr),y jsr iecout iny dec latch bpl pol close jmp unlist dst jsr clrchn lda #floppy sta ga jsr talk lda #$6f sta sa jsr sectalk lol jsr iecin jsr bsout cmp #cr bne lol jmp untalk grof lda #$97 sta bank lda #$9b sta ctrl1 lda #$15 sta satz rts grin lda #$94 sta bank lda #$3b sta ctrl1 lda #$38 sta satz rts glod jsr para lda #1 sta sa lda #0 jmp loadr gsav jsr para jsr basof ldx #0 ldy #$c0 lda #$a0 stx tmp sta tmp+1 lda #tmp sta sa jsr saver jmp romin dir lda #"$" sta 2 ldx #2 stx namadr dex stx namlen dex stx namadr+1 lda #floppy sta ga lda #$60 sta sa jsr iecopen lda ga jsr ieccmdin bcc dir1 jmp errorausw dir1 ldx #6 dir2 lda $62 sta $63 jsr basin sta $62 lda status bne lo4 dex bne dir2 lda #"\xa0" jsr basout jsr naxout jsr space lo2 jsr basin tax beq lo3 jsr basout bcc lo2 lo3 jsr return jsr stop beq lo4 ldx #4 bne dir2 lo4 jsr clrchn jmp closeiec old lda #1 tay sta (basst),y jsr link lda stradr adc #2 sta basend lda stradr+1 adc #0 sta basend+1 jsr clr+1 jmp wrmstrt plot jsr getcol plo jsr chrgot cmp #"," beq point cmp #tto bne explot jsr chrget jsr getpara2 jsr romof jsr draw jsr romin lda axkoo sta lxkoo lda axkoo+1 sta lxkoo+1 lda aykoo sta lykoo jmp plo point jsr chrget jsr getpara1 jsr romof jsr berpoint jsr setmask jsr romin jmp plo explot rts draw sec lda axkoo sbc lxkoo sta $60 lda axkoo+1 sbc lxkoo+1 sta $61 bcs df1pl lda #1 sbc $60 sta $60 lda #0 sbc $61 sta $61 df1ok ldx #4 bne eodif1 df1pl bne df1ne lda $60 bne df1ne ldx #8 .byt $2c df1ne ldx #6 eodif1 lda map3,x sta u1+1 lda map3+1,x sta u1+2 sec lda aykoo sbc lykoo sta $63 bcs df2pl eor #-1 sta $63 inc $63 ldx #0 beq eodif2 df2pl bne df2ne ldx #8 .byt $2c df2ne ldx #2 eodif2 lda map3,x sta v1+1 lda map3+1,x sta v1+2 lda $61 bne mgr lda $60 cmp $63 bcs mgr lda $60 ldx $63 sta $63 stx $60 bcc sets mgr lda u1+1 ldx v1+1 sta v1+1 stx u1+1 lda u1+2 ldx v1+2 sta v1+2 stx u1+2 sets lda $61 lsr sta $6a lda $60 ror adc #0 sta $69 lda $60 sta $67 lda $61 sta $68 jsr berpoint repeat clc lda $63 adc $69 sta $69 bcc vergsm inc $6a vergsm lda $6a cmp $61 bcc v1 bne sgrm lda $69 cmp $60 bcc v1 beq v1 sgrm sec lda $69 sbc $60 sta $69 lda $6a sbc $61 sta $6a u1 jsr 0 v1 jsr 0 lda $67 bne linz lda $68 bne hinz rts hinz dec $68 linz dec $67 jsr setmask jmp repeat help jsr return ldy #-1 bb iny lda bef,y cmp #"\" beq fnsh pha and #$7f jsr bsout pla bpl bb jsr tab jmp bb fnsh lda #see jmp strout tab lda spalte sec sub sbc #10 bcs sub eor #-1 adc #1 adc spalte cmp #40 bcc fs jmp return fs sta spalte rts cls ldx #$1e ldy #$e0 sty erg-1 ldy #0 sty erg-2 tya lp1 sta (erg-2),y iny bne lp1 inc erg-1 dex bpl lp1 ldx #64 lp2 sta $ff00,x dex bpl lp2 col jsr getbyt stx f1 jsr getkx txa and #$f sta f2 lda f1 ldy #0 asl asl asl asl ora f2 lp3 sta $cc00,y sta $ce00,y sta $cf00,y sta $cd00,y iny bne lp3 rts up lda abmp bne upok dec abmp+1 upok dec abmp and #7 bne retur dec abmp+1 lda abmp sec sbc #$38 sta abmp bcs retur dec abmp+1 retur rts down inc abmp bne downok inc abmp+1 downok lda abmp tax and #7 bne retur txa inc abmp+1 clc adc #$38 sta abmp bcc retur inc abmp+1 rts left asl mask bcc retur rol mask sec lda abmp sbc #8 sta abmp bcs retur dec abmp+1 rts right lsr mask bcc retur ror mask clc lda abmp adc #8 sta abmp bcc retur inc abmp+1 rts swap lda #$80 .byt $2c copy lda #0 sta f2 jsr romof ldx #$1e ldy #$e0 sty erg-1 ldy #$a0 sty erg+1 ldy #0 sty erg sty erg-2 lp6 lda (erg),y sta f1 lda (erg-2),y sta (erg),y bit f2 bpl ex1 lda f1 sta (erg-2),y ex1 iny bne lp6 inc erg-1 inc erg+1 dex bpl lp6 ldx #64 lp7 lda $bf00,x tay lda $ff00,x sta $bf00,x bit f2 bpl ex2 tya sta $ff00,x ex2 dex bpl lp7 jmp romin test jsr kauf jsr getpara1 jsr kzu jsr romof jsr berpoint ldy #0 and (abmp),y beq notset dey notset sty erg+1 jsr romin jmp sgn evl jsr getklam jsr nodir ldx ptr ldy ptr+1 stx latch sty latch+1 jsr strpar cmp #$50 bcc ev1 jmp toolong ev1 tax bne evl2 jmp fac0 evl2 ldy #0 evllp lda ($22),y sta line,y iny dex bne evllp txa sta line,y sta ptr ldx #>line stx ptr+1 jsr crunch jsr auswert ldx latch ldy latch+1 jmp setptr text jsr getbyt stx $a8 jsr getkx txa lsr ror ror sta f1 jsr getkx stx byte cpx #40 bcs error jsr getkx stx $a7 cpx #25 bcs error jsr ckcom jsr frmevl jsr frestr sta stradr+2 lda #0 sta stradr+3 next ldx stradr+2 beq emd ldy stradr+3 lda (stradr),y jsr print inc stradr+3 dec stradr+2 inc byte ldx byte cpx #40 bcc next emd rts error ldx #$e jmp wrmstrt print sei sta $b5 ldx #0 stx $b6 stx $b7 lda $a7 asl tay lda map1,y sta $60 lda map1+1,y sta $61 lda byte asl rol $b7 asl rol $b7 asl rol $b7 clc adc $60 sta $60 lda $b7 adc $61 sta $61 lda $b5 cmp #-1 beq pi tay lsr lsr lsr lsr lsr tax tya clc adc map4,x .byt $2c pi lda #94 cmp #$80 bcs end asl rol $b6 asl rol $b6 asl rol $b6 sta $b5 lda $a8 and #3 asl asl clc adc #$d0 adc $b6 sta $b6 ldx port1 stx latch lda #$31 sta port1 ldy #7 npt lda ($b5),y bit f1 bmi sop5 bvs sop1 eor #-1 and ($60),y .byt $2c sop1 ora ($60),y .byt $2c sop2 eor ($60),y sop3 sta ($60),y dey bpl npt ldx latch stx port1 end cli rts sop5 bvc sop2 bvs sop3