;:poke56,140:clr ;:ifpeek(776)<>228then:!kill:run ;:sys36864 ;.opt oo *= $c000 getx =$b79e bank =56576 vic =$d000 screen =648 tmp =253 clrscr =$e544 hires =$a000 getcor =$b7eb komma =$aefd konf =1 tmp2 =251 mw =360 sp =3 stack =$e000 stend =$fffe endg =48960 jmp run gv jmp $b08b ang =17 sgn =7 kart =12 rad =15 kx =247 ky =249 sx =189 sy =190 dx =87 ; auch temp dy =89 y2 =169 xwert =164 rest =94 xadd =91 yadd =93 mode =171 lin =255 ywert =168 x2 =166 patt =170 dir =2 trenn =159 wide =178 pola =180 count =37 temp =182 bas =34 nr =36 ta =155 tx =150 ty =146 reto =158 grcol =176 error =177 rebit .byt $80,$40,$20,$10,8,4,2,1 dbank .byt 151,149 dgraf .byt 27,59 dfind .byt 21,61 mult .word $a000,$a140,$a280,$a3c0 .word $a500,$a640,$a780,$a8c0 .word $aa00,$ab40,$ac80,$adc0 .word $af00,$b040,$b180,$b2c0 .word $b400,$b540,$b680,$b7c0 .word $b900,$ba40,$bb80,$bcc0 .word $be00 sin .byt 0,4,9,13,18,22,27,31,36,40,44,49,53,58 .byt 62,66,71,75,79,83,88,92,96,100,104,108,112 .byt 116,120,124,128,132,136,139,143,147,150 .byt 154,158,161,165,168,171,175,178,181,184 .byt 187,190,193,196,199,202,204,207,210,212 .byt 215,217,219,222,224,226,228,230,232,234 .byt 236,237,239,241,242,243,245,246,247,248 .byt 249,250,251,252,253,254,254,255,255,255 .byt 0,0,0,0 greet .byt 13 .byte "\x8eturtle-graphics ver.1 11.91" .byt 13 .byte "\x11author: nikolaus heusler" .byt 13 .byte " zwengauerweg 18" .byt 13 .byte " 8000 muenchen 71" .byt 13,13,0 cmd .byte "kilLmovEturNhomEcleaRgraphicStexTwalKanglE" .byte "modEpeNpulLpusHiniTraYpatterNresumEbacK" .byte "polYfinisHscreeNdiscarDfetcHmergEinverS" .byte "windoW" brk fn .byte "headinGturTkarTmodEstacK" brk befadr .word kill,move,turn,home,clr,graphics,text .word walk,angle,setmode,pen,pull,push,init,ray,setpat .word resume,back,poly,finish,bild,discard,fetch .word merge,invery,window fnadr .word heading,turt,karts,moout,readst err1 .byte "unknown statemenT" err2 .byte "stack underfloW" err3 .byte "stack overfloW" err4 .byte "out of screeN" err5 .byte "unknown argumenT" run lda #nbas sta $308 sty $309 lda #neudi sta $302 sty $303 lda #neufe sta $300 sty $301 lda #neueva sta $30a sty $30b jsr init lda #greet jmp $ab1e nbas jsr $73 cmp #"!" beq neubef jsr 121 jmp $a7e7 neubef lda 122 sta bas lda 123 sta bas+1 lda #cmd sta tmp sty tmp+1 ldy #0 sty error sty nr dey bef iny lda (tmp),y bne weiter lda #err1 errout sta 34 tya sty error jmp $a445 weiter and #127 sta tmp2 jsr 115 cmp tmp2 beq maybe inc nr lda bas sta 122 lda bas+1 sta 123 gonext lda (tmp),y bmi bef iny bne gonext maybe lda (tmp),y bpl bef lda nr asl tay lda befadr,y sta tmp lda befadr+1,y sta tmp+1 jsr $73 jsr goto jmp $a7ae goto jmp (tmp) neudi ldx error bne full ldx $3a inx beq direct full jsr text direct lda #0 sta error jmp $a483 neufe txa bmi okay inc error okay jmp $e38b kill jsr $e453 jsr irqoff jmp text getkint jsr komma getint jsr $ad8a jmp $b7f7 finish lda #0 sta 198 jsr graphics finloop jsr $a82c lda 198 beq finloop dec 198 jsr irqoff jsr text clc jmp $a834 neueva lda #0 sta $d jsr $73 cmp #"!" beq wedge jsr 121 jmp $ae8d wedge lda 122 sta bas lda 123 sta bas+1 lda #fn sta tmp sty tmp+1 ldy #0 sty nr dey funk iny lda (tmp),y bne weitfn lda #err5 jmp errout weitfn and #127 sta tmp2 jsr 115 cmp tmp2 beq meybe inc nr lda bas sta 122 lda bas+1 sta 123 gofn lda (tmp),y bmi funk iny bne gofn meybe lda (tmp),y bpl funk lda nr asl tay lda fnadr,y sta tmp lda fnadr+1,y sta tmp+1 jsr $73 jsr goto sta $63 stx $62 sec ldx #144 jmp $bc49 home lda #100 sta ty lda #160 sta tx lda #0 sta ta sta ta+1 sta tx+1 rts init jsr irqoff jsr clr jsr home ldx #1 stx mode stx grcol dex stx reto dex stx patt jmp resume angle jsr getint sty ta sta ta+1 korra lda ta+1 cmp #>mw bcc oka bne dokorr lda ta cmp #mw sta ta+1 bpl korra korrup lda ta clc adc #mw sta ta+1 jmp korra oka rts turn jsr 121 tax jsr 115 txa cmp #"l" beq turnl cmp #"r" beq turnr jmp $af08 turnl jsr getint dreh pha tya clc adc ta sta ta pla adc ta+1 sta ta+1 jmp korra turnr jsr getint lda ta sec sbc 20 sta ta lda ta+1 sbc 21 sta ta+1 jmp korra move jsr getcor lda mode cmp #3 beq setturt stx y2 lda 20 sta x2 lda 21 sta x2+1 jsr control lda tx sta xwert lda tx+1 sta xwert+1 lda ty sta ywert jmp lauf setturt stx ty lda 20 sta tx lda 21 sta tx+1 rts control lda y2 cmp #200 bcs over lda x2+1 cmp #>320 bcc fertig bne over lda x2 cmp #<320 bcc fertig over lda #err4 jmp errout pen jsr getx txa beq up lda #1 .byt $2c up lda #3 sta mode cmp #3 beq fertig ldx ty lda tx sta 20 lda tx+1 sta 21 jmp set fertig rts walk lda #1 .byt $2c back lda #0 sta dir jsr getint sty rad sta rad+1 qwalk lda ta sta ang lda ta+1 sta ang+1 jsr polar lda ty sta ywert ldx ky beq isy ldx sy bne suby clc adc ky jmp isy suby sec sbc ky isy sta y2 lda tx ldy tx+1 sta xwert sty xwert+1 ldx sx bne subx clc adc kx tax tya adc kx+1 jmp isx subx sec sbc kx tax tya sbc kx+1 isx stx x2 sta x2+1 jsr control lauf jsr linie lda reto bne heim lda xwert sta tx lda xwert+1 sta tx+1 lda ywert sta ty heim rts ray jsr getx txa and #1 sta reto rts setpat jsr getx stx patt rts setmode jsr getx txa and #3 sta mode rts poly jsr getx cpx #2 bcs frei illq jmp $b248 frei stx nr dex stx temp jsr getkint sty wide sta wide+1 jsr getkint sty pola sta pola+1 ldx #0 stx count inx stx dir poly1 lda wide sta rad lda wide+1 sta rad+1 lda count bne poly2 lsr rad+1 ror rad jmp poly3 poly2 cmp temp bne poly3 lsr rad+1 ror rad bcc poly3 inc rad bne poly3 inc rad+1 poly3 jsr qwalk ldy pola lda pola+1 jsr dreh inc count lda count cmp nr bcc poly1 rts heading lda ta ldx ta+1 rts turt cmp #"x" beq turtx cmp #"y" beq turty jmp $af08 turtx jsr 115 lda tx ldx tx+1 rts turty jsr 115 lda ty ldx #0 rts karts cmp #"x" beq kartx cmp #"y" beq karty jmp $af08 kartx lda #1 .byt $2c karty lda #0 pha jsr 115 jsr getint sty rad sta rad+1 jsr komma jsr getint sty ang sta ang+1 jsr polar pla beq uepsilon lda sx ldx kx ldy kx+1 jmp setxy uepsilon lda sy ldx ky ldy ky+1 setxy pha stx $63 sty $62 sec ldx #144 jsr $bc49 pla beq nuja jsr $bfb4 nuja pla pla rts readst lda sp+1 sec sbc #>stack tax lda sp ldy #0 sty tmp sty tmp+1 div5 tay bne madiv cpx #0 bne madiv lda tmp ldx tmp+1 rts madiv sec sbc #5 bcs deflt dex bmi oha deflt inc tmp bne div5 inc tmp+1 bne div5 oha jmp $b4d0 moout lda vic+17 and #32 lsr lsr ora reto asl asl ora mode ldx #0 rts resume lda #stack sta sp sty sp+1 rts push jsr $ad8a ldx sp ldy sp+1 cpy #>stend bcc dopush cpx #err3 jmp errout dopush jsr $bbd4 lda sp clc adc #5 sta sp bcc pushed inc sp+1 pushed jsr 121 beq stackend jsr komma jmp push stackend rts pull jsr gv sta $49 sty $4a lda $d beq okreal noreal jmp $ad99 okreal lda $e bne noreal lda sp ldy sp+1 cmp #stack bne getit lda #err2 jmp errout getit sec sbc #5 sta sp sta $22 tya sbc #0 sta sp+1 sta $23 sei lda #48 sta konf ldy #4 lda ($22),y sta $65 dey lda ($22),y sta $64 dey lda ($22),y sta $63 dey lda ($22),y sta $66 ora #$80 sta $62 dey lda ($22),y sta $61 sty $70 lda #55 sta konf cli jsr $bbd0 jsr 121 beq stackend jsr komma jmp pull ; polar -> karthes. polar0 lda dir sta sgn sinu lda ang+1 bne mor2 lda ang cmp #91 bcc mor3 cmp #181 bcs mor2 sbc #180 eor #-1 jmp mor3 mor2 lda ang sec sbc #180 sta ang bcs nodec dec ang+1 nodec lda sgn eor #1 sta sgn bpl sinu mor3 tay lda #0 sta kart sta kart+1 sta kart+2 lda sin,y tax tya beq null mor4 lda kart clc adc rad sta kart lda kart+1 adc rad+1 sta kart+1 bcc mor5 inc kart+2 mor5 dex bne mor4 lda kart bpl null inc kart+1 bne null inc kart+2 null ldx sgn lda kart+1 ldy kart+2 rts polar lda ang sta tmp lda ang+1 sta tmp+1 jsr polar0 sta kx sty kx+1 stx sx lda tmp clc adc #90 sta ang lda tmp+1 adc #0 sta ang+1 jsr polar0 sta ky sty ky+1 stx sy rts graphics ldx #1 .byt $2c text ldx #0 setg lda dbank,x sta bank lda dgraf,x sta vic+17 lda dfind,x sta vic+24 txa beq ill ldy #140 sty tmp+1 ldy #0 sty tmp ldx #4 lda grcol fill sta (tmp),y iny bne fill inc tmp+1 dex bne fill ill rts clr ldy #0 tya sty tmp ldx #>hires stx tmp+1 ldx #32 bne fill set lda mode cmp #3 bcs ill txa lsr lsr lsr asl tay lda mult+1,y sta tmp+1 txa and #7 clc adc mult,y sta tmp lda 20 and #$f8 adc tmp sta tmp lda tmp+1 adc 21 sta tmp+1 lda 20 and #7 tax lda rebit,x ldx #54 stx konf ldy #0 ldx mode beq reset cpx #2 beq invers ora (tmp),y bne sqd reset eor #-1 and (tmp),y .byt $2c invers eor (tmp),y sqd sta (tmp),y inc konf rts bild jsr getx stx grcol lda vic+17 and #32 beq ill jmp graphics linie sei sec lda x2 sbc xwert sta dx lda x2+1 sbc xwert+1 sta dx+1 bpl line1 eor #-1 sta dx+1 lda dx eor #-1 clc adc #1 sta dx bcc noinc1 inc dx+1 noinc1 lda #-1 sta xadd sta xadd+1 jmp line2 line1 lda #1 sta xadd lda #0 sta xadd+1 line2 lda dx+1 bne line3 lda dx bne line3 lda #0 .byt $2c line3 lda #-1 sta rest sta rest+1 sec lda y2 sbc ywert sta dy lda #0 sbc #0 sta dy+1 bpl line5 eor #-1 sta dy+1 lda dy eor #-1 clc adc #1 sta dy bcc noinc2 inc dy+1 noinc2 lda #-1 .byt $2c line5 lda #1 sta yadd lda dy+1 cmp dx+1 bcc line7 lda dy cmp dx bcc line7 lda #-1 .byt $2c line7 lda #1 sta lin line8 lda patt asl adc #0 sta patt and #1 beq line9 line8b lda xwert sta 20 lda xwert+1 sta 21 ldx ywert jsr set line9 lda ywert cmp y2 bne line10 lda xwert cmp x2 bne line10 lda xwert+1 cmp x2+1 bne line10 cli rts line10 lda rest+1 bmi zweig1 sec lda rest sbc dx sta rest lda rest+1 sbc dx+1 sta rest+1 clc lda ywert adc yadd sta ywert lda lin bmi line8 bpl line9 zweig1 clc lda rest adc dy sta rest lda rest+1 adc dy+1 sta rest+1 clc lda xwert adc xadd sta xwert lda xwert+1 adc xadd+1 sta xwert+1 lda lin bmi line9 jmp line8 discard jsr $e1d4 ldx #endg lda #hires sta tmp+1 lda #54 sei sta 1 lda #tmp sta $b9 jsr $ffd8 inc 1 cli bcs boese gutl rts merge jsr resume lda #>hires ldy #>stack ldx #0 jsr copy jsr fetch ldx #-1 lda #>stack ldy #>hires copy sta tmp+1 sty tmp2+1 ldy #0 sty tmp sty tmp2 lda #48 sei sta 1 stx dx ldx #32 copy0 lda (tmp2),y and dx ora (tmp),y sta (tmp2),y iny bne copy0 inc tmp+1 inc tmp2+1 dex bne copy0 lda #55 sta 1 cli rts fetch jsr $e1d4 ldx #0 txa stx $b9 ldy #>hires jsr $ffd5 bcc gutl boese jmp $e0f9 invery lda #54 sei sta 1 ldy #hires sta tmp+1 ldx #32 inv lda (tmp),y eor #-1 sta (tmp),y iny bne inv inc tmp+1 dex bne inv inc 1 cli rts window jsr getx cpx #2 bcs rirq txa pha jsr irqoff pla tax jmp setg rirq stx trenn sei lda #rast sta 788 sty 789 stx $d012 lda #$81 sta $d01a cli rts rast lda $d019 sta $d019 lsr bcs ok lda $dc0d cli jmp $ea31 ok lda $d012 cmp trenn bcc unten ldy #1 lda dbank sta bank lda dgraf ldx dfind bne ran unten ldy trenn lda dbank+1 sta bank lda dgraf+1 ldx dgraf+1 ran sta vic+17 stx vic+24 sty $d012 jmp $ea81 irqoff sei lda #0 sta $d01a jsr 65418 cli rts