;:rem ** printerblocksatz ** ;:poke56,112:sys36864 ;.opt oo *= $c000 frmevl =$ad9e stradr =$22 frestr =$b6a3 buffer =$ce00 komma =$aefd getx =$b7f1 clrchn =$ffcc chkout =$ffc9 strout =$ab1e error =$e0f9 chrget =$73 chrgot =$79 return =$aad7 syntax =$af08 toolong =$a571 integer =$b7f7 frmnum =$ad8a zahl =$14 illquan =$b248 code =23 tmp =2 bsout =$ffd2 vic =$d000 farbe =646 quote =212 spalte =211 fehler =$a445 rvs =199 jmp anfang jmp control len .byt 0 errlen .word 0 typ .byt 0 pos .byt 0 anz .byt 0 lf .byt 0 pos2 .byt 0 gewlen .word 0 pos4 .byt 0 pos5 .byt 0 mode .byt 0 ; bit 0 -> 1=center ; 1 -> 1=control ; sys (adr),lf,len,mode,text( ;) grap .byt 8,128,15,0 cet .byt 8,26,0,128,15 ill .byte "chaR" text .byte "\x13\x12\x95 printer blocksatz funktion \x9ekontrolle\x95 \x96\x92" .byt 0 parameter jsr getx stx lf jsr komma jsr frmnum jsr integer sty gewlen sta gewlen+1 tax beq gut cpy #$e0 bcc gut jmp illquan gut jsr getx txa and #3 sta mode jmp getstr output ldx lf jsr chkout bcc nerror jmp error nerror lda #buffer jsr striout jsr chrgot beq ok cmp #";" beq nixwei jmp syntax ok jsr return nixweiter jmp clrchn nixwei jsr chrget jmp clrchn clrbuf ldy #0 tya cl sta buffer,y iny bne cl rts getstr jsr komma jsr frmevl jsr frestr ldy #0 sta len holstr lda (stradr),y cmp #code beq e1 sta buffer,y iny cpy len bcc holstr lda #0 sta buffer,y rts e1 lda #ill jmp fehler calclen ldy #0 sty errlen sty errlen+1 sty typ cacloop cpy len bcs cacende lda buffer,y cmp #code beq plus1 bit typ bmi bitmap bvs doublr cmp #14 bne nodoub lda #64 settyp sta typ bne goon plus1 lda #-1 bne bitmap nodoub cmp #8 bne nobitmap lda #128 bne settyp nobitmap jsr testdruck bcc goon lda #6 jsr add bcc goon doublr cmp #15 beq aus jsr testdruck bcc goon lda #12 jsr add bcc goon aus lda #0 sta typ goon iny bne cacloop cacende rts bitmap tax bpl steu lda #1 jsr add bcc goon steu cmp #9 beq aus cmp #15 beq aus bne goon testdruck cmp #32 bcc cacende cmp #160 bcs cacende tax bmi nicht sec rts nicht clc rts add clc adc errlen sta errlen lda errlen+1 adc #0 sta errlen+1 clc rts ; insxy schafft an pos. x platz fuer y zeichen (x = 0 - [len-1]) insxy sty anz stx pos ldx len txa clc adc anz tay insloop cpx pos bcc rady lda pos bne cht cpx #-1 beq rady cht lda buffer,x sta buffer,y dex dey bne insloop rady clc lda len adc anz sta len bcc rt jmp toolong rt rts ; such sucht ab pos. x nach code such stx pos2 ni lda buffer,x cmp #code beq found inx cpx len bcc kurz ldx #0 kurz cpx pos2 bne ni clc rts found inx lda buffer,x cmp #code beq found dex sec rts insone ldy #1 jsr insxy ldx pos lda #code sta buffer,x rts halflen jsr calclen lda errlen+1 beq gut2 lda errlen cmp #$e0 bcc gut2 jmp toolong gut2 lda errlen lsr sta pos4 lda errlen+1 beq fn lda #128 clc adc pos4 sta pos4 fn lda len lsr sta pos5 rts replace ldx #0 rep lda buffer,x cmp #" " bne re lda #code sta buffer,x re inx bne rep rts fill jsr replace jsr halflen fill2 jsr calclen lda errlen+1 cmp gewlen+1 bcc auffill bne tolong lda errlen cmp gewlen bcc auffill beq fertig tolong jmp toolong fertig rts auffill ldx pos5 jsr such bcs gefunden jmp illquan gefunden inx jsr insone inx stx pos5 lda mode and #2 beq nixctrl jsr control nixctrl jmp fill2 center jsr halflen lda gewlen lsr pha lda gewlen+1 beq fn2 pla clc adc #128 pha fn2 pla sec sbc pos4 bcc tolong beq null pha ldx #0 ldy #5 jsr insxy ldx #4 cent lda cet,x sta buffer,x dex bpl cent pla sta buffer+2 null lda mode and #2 beq null2 jsr control null2 rts make lda mode and #1 bne center jmp fill striout sta tmp sty tmp+1 lp ldy #0 lda (tmp),y beq fintext cmp #code beq minispace jsr bsout bcc hoch fintext rts minispace lda #grap jsr strout hoch inc tmp bne lp inc tmp+1 bne lp control lda #0 sta vic+32 sta vic+33 lda #text jsr strout ldx #0 cloop lda #1 sta quote lda buffer,x jsr out tay beq ausrast inx bne cloop beq ecnde ausrast inx beq ecnde lda #0 jsr out jmp ausrast out jsr bsout2 lda spalte beq change cmp #40 bne zurueck change lda farbe eor #4 sta farbe zurueck rts ecnde jsr faerb jmp return faerb ldx pos5 lda #1 sta $d828,x lda $428,x cmp #32 bne nixan lda #160 sta $428,x nixan rts bsout2 cmp #13 beq ret1 cmp #141 beq ret2 cmp #20 beq ins jmp bsout r pha lda #1 .byt $2c o lda #0 sta rvs pla rts ret1 jsr r lda #"m" i jsr bsout pha bcc o ret2 jsr r lda #"M" bne i ins jsr r lda #"t" bne i anfang jsr clrbuf jsr parameter jsr make jmp output