;:poke56,117
;:sys65418
sys36864
	;.opt oo
outvec	=$326
ga	=$9a
old	=166
buff	=$8f00
cr	=13
esc	=27	; rvs [
sid	=$d400
sid2	=sid+14
tmp	=253
chrgot	=121
getx	=$b7f1
xt	=$8e00
return	=$aad7
frage	=$ab45
write	=$ffd2
vic	=$d000
konf	=1
mem	=$8df0
tmp2	=251
high	=648
muster	=$8d00
sonder	=$8c00
himem	=55
	*= 30000
base	jmp main
strout	jmp qstrout
kill	jmp qkill
init	jmp qinit
get	jmp qget
error	jmp qerror
escape	jmp qesc
hcopy	jmp hardcopy
main	lda #<tit
	ldy #>tit
	jsr strout
	lda #<base
	ldy #>base
	sta himem
	lda #4
	sta drucker
	sty himem+1
	jsr clr
	jsr chrgot
	cmp #","
	bne init
	jsr getx
	stx drucker
	clc
	bcc init
qinit	lda #1
	sta mode
	sta anz
	sta cbmbreit
	sta mbr
	lda #0
	sta xstp
	sta pffz
	sta leftr
	tax
	sta abst
	sta mart
clrsond	sta sonder,x
	inx
	bne clrsond
	lda #" "
	sta randc
	lda #6
	sta zlen
	sta spacea
	jmp initvek
zahlcod	.byt 126,48,109,121,51,91,95,112,127,123
mode	.byt 0      	;modus
leftr	.byt 0     	;rand links
mbr	.byt 0       	;breite minisch.
mart	.byt 0      	;hoehe minisch.
drucker	.byt 0   	;ga
char	.byt 0      	;zeichen
pffz	.byt 0      	;pufferzeiger
inpz	.byt 0      	;lesezeiger
anz	.byt 0       	;fuer esc n
chr	.byt 0       	;zeichen
xstp	.byt 0      	;x-stack pointer
stc	.byt 0       	;stackpointer
errn	.byt 0      	;fehlernr
randc	.byt 0     	;randzeichen
anzz	.byt 0      	;anz. zahlen
zlen	.byt 0      	;min. zahlenlaen.
abst	.byt 0      	;buchst. abstand
spacea	.byt 0    	;spacegroesse
cbmbreit	.byt 0  	;breite cbm satz
quot	.byt 0      	;quotefl. (hcopy)
rflg	.byt 0      	;rvsflag (hcopy)
grokle	.byt 0    	;schriftwahl (hc)
laenge	.byt 0    	;erwuenschte laenge (esc -)
esccod	.byte "pkno[lges&%j!'+?bw=dc*^qa-himr"
	.byt 0
tit	.byt cr
	.byte "nss druckerinterface bereit."
	.byt cr,0
qutx	.byt 8,128,135,128,135,128,128,15,0
escadr	.word init,kill,oft,aat,randz,setrand,bell
	.word errset,zahlmod,setlen,init,ncrlf,kill,qumo
	.word abstset,test,grafikb,breit,spaceb,cbm,cbmform
	.word grafikb,hcopy,zahlen,tab,pattern
	.word define,call,micro,miniform
etta	.word er0,er1,er2,er3,er4,er5,er6,er7
er0	.byte "zeile zu lang"
	.byt 0
er1	.byte "parameter falsch"
	.byt 0
er2	.byte "code unbekannt"
	.byt 0
er3	.byte "text zu komplex"
	.byt 0
er4	.byte "unvollstaendig"
	.byt 0
er5	.byte "muster fehlt"
	.byt 0
er6	.byte "sonderzeichenfehler"
	.byt 0
er7	.byte "zeichenbereichsfehler"
	.byt 0
testtext	.byt cr,cr
	.byte "\x12nss druckerinterface mps 803"
	.byt cr
	.byte "\x1bw1interface- und druckertest\x1bw0"
	.byt cr,cr
	.byte "abstand 0"
	.byt cr,esc,"+",1
	.byte "abstand 1"
	.byt cr,esc,"+",2
	.byte "abstand 2"
	.byt esc,"+","\x19"
	.byt cr,esc,"l",5,esc
	.byte "[.alles nun mit einem rand von 5 punkten:"
	.byt esc,"j",4
	.byte "das waren 3 leerzeilen"
	.byt cr
	.byte "die folgenden beiden zeile"
	.byte "n sind gleich lang:"
	.byt cr,cr,esc,"b",6,62,65,93,85,65,62
	.byte "nss \x12\xa9"
	.byt cr,esc,"b",36,255,1,3,7,15,31,63,255,254,252,248
	.byt 240,224,192,224,240,248,252,254,255,254,252,121
	.byt 115,103,79,31,63,127,62,28,8,8,28,62,255,cr,cr
	.byte "\x11klein GROSS\x1bo1 KLEIN gross\x1bo0 klein\x1bo1 gross"
	.byt esc,"%",cr
	.byte "jedes zeichen dreimal: (rand aus)"
	.byt cr,esc,"n",3
	.byte "nss \x12interface-\x0etest\x92\x0f\x1b%"
	.byt cr
	.byte "\x1bdcommodore's\xa0- zeichensatz \xb0\xae\xad\xbd $%#\xa6\x19"
	.byt cr
	.byte "\x1bc1"
	.byt 1
	.byte "\x1bdcommodore invers \x8e\x8f\x92"
	.byt 141
	.byte "\x81\x8c\x19"
	.byt cr,esc
	.byte "c0"
	.byt 3
	.byte "\x1bdcommodore 3-fach !\x19"
	.byt cr
	.byte "\x1bq01 23 45 67 89 0 (siebensegmentzahlen)"
	.byt cr
	.byte "musterdruck:\x1b-"
	.byt 255,1,3,7,3,1,3,7,15,31
	.byt 63,127,126,252,248,240,224,192,224,240,224,192,"\x19"
	.byt cr
	.byte "\x1bmdies ist die \x19\x1br0\x020\x1bmminischrift \x19\x1br1\x010\x1bmrevers"
	.byte " + mini\x19"
	.byt cr
	.byte "\x1br0\x010\x1bmeinstein entdeckte:\x19"
	.byte "\x1br0\x032\x1bm e = mc\x19\x1br0\x031\x1bm2\x19\x1br0\x010\x1bm.\x19"
	.byt cr,0
mini	=*
	.byt $80,$80,$80,$80,$ae,$80 	; !
	.byt $86,$80,$86,$94,$be,$94 	;"#"
	.byt $ae,$be,$ba,$b2,$88,$a6 	;$%
	.byt $94,$be,$b4,$80,$86,$80 	;&'
	.byt $80,$9c,$a2,$a2,$9c,$80 	;()
	.byt $94,$88,$94,$88,$9c,$88 	;*+
	.byt $a0,$90,$80,$88,$88,$88 	;,-
	.byt $80,$a0,$80,$b0,$88,$86 	;./
	.byt $9c,$a2,$9c,$80,$84,$be 	;01
	.byt $a4,$b2,$ac,$a2,$aa,$be 	;23
	.byt $8e,$88,$be,$ae,$aa,$92 	;45
	.byt $bc,$aa,$ba,$86,$b2,$8e 	;67
	.byt $9c,$aa,$9c,$ae,$aa,$9e 	;89
	.byt $80,$94,$80,$a0,$94,$80 	; 	;
	.byt $88,$94,$a2,$94,$94,$94 	;<=
	.byt $a2,$94,$88,$82,$aa,$86 	;>
	.byt $be,$aa,$ae,$bc,$8a,$bc 	;@a
	.byt $be,$aa,$94,$be,$a2,$94 	;bc
	.byt $be,$a2,$9c,$be,$aa,$a2 	;de
	.byt $be,$8a,$82,$be,$a2,$ba 	;fg
	.byt $be,$88,$be,$a2,$be,$a2 	;hi
	.byt $b0,$a0,$be,$be,$88,$b6 	;jk
	.byt $be,$a0,$b0,$be,$84,$be 	;lm
	.byt $be,$84,$b8,$be,$a2,$be 	;no
	.byt $be,$8a,$8e,$9e,$9a,$be 	;pq
	.byt $be,$9a,$ae,$a6,$aa,$b2 	;rs
	.byt $82,$be,$82,$be,$a0,$be 	;tu
	.byt $8e,$b0,$8e,$be,$90,$be 	;vw
	.byt $b6,$88,$b6,$86,$b8,$86 	;xy
	.byt $b2,$aa,$a6,$be,$a2,$a2 	;z[
	.byt $bc,$aa,$a2,$a2,$a2,$be 	;\]
	.byt $84,$be,$84,$88,$9c,$aa 	;^_
qget	jsr xput
	ldx inpz
	cpx pffz
	bcc guno
	jsr xhol
	ldx #4
	jmp error
guno	inc inpz
	lda buff,x
	jmp xhol
para10	jsr get
	and #1
	rts
qerror	stx errn
	lda #240
	jsr bella
	jsr bell
	lda #240
	jsr bella
	lda mode
	and #1
	beq nixerr
	jsr kill
	lda #15
	jsr old
	jsr return
	jsr frage
	lda errn
	asl
	tax
	lda etta+1,x
	tay
	lda etta,x
	jsr strout
	jsr return
	jsr initvek
nixerr	ldx stc
	txs
	lda #0
	sta pffz
	jmp sos
oft	jsr paran0
	sta anz
	rts
aat	jsr para10
	beq aus
	lda mode
	ora #$40
	bne setm
aus	lda mode
	and #$bf
setm	sta mode
	rts
randz	jsr get
	sta randc
	rts
setrand	jsr get
	sta leftr
	rts
paran0	jsr get
	beq nullf
	rts
nullf	ldx #1
	jmp error
errset	jsr para10
	beq aus1
	lda mode
	ora #1
	bne setm
aus1	lda mode
	and #$fe
	jmp setm
zahlmod	jsr para10
	beq aus2
	lda mode
	ora #2
	bne setm
aus2	lda mode
	and #$fd
	jmp setm
ncrlf	jsr paran0
	tax
	lda #cr
ccc	jsr ausgabe
	dex
	bne ccc
	rts
setlen	jsr get
	sta zlen
	rts
breit	jsr para10
	beq aus4
	lda #"\x0e"
	.byt $2c
aus4	lda #"\x0f"
	jmp old
qumo	jsr para10
	beq aus3
	lda mode
	ora #4
	bne setm
aus3	lda mode
	and #$fb
	jmp setm
abstset	jsr get
	sta abst
	rts
spaceb	jsr get
	sta spacea
	rts
bella	pha
	ldx #9
	lda #0
l1	sta sid2,x
	dex
	bpl l1
	lda #15
	sta sid+24
	lda #9
	sta sid2+5
	lda #240
	sta sid2+6
	pla
	sta sid2+1
	lda #17
	sta sid2+4
	ldy #0
	inx
l2	dex
	bne l2
	dey
	bne l2
	lda #16
	sta sid2+4
	lda #0
	sta sid+24
	ldy #30
	ldx #0
wa	dex
	bne wa
	dey
	bne wa
	rts
bell	lda #100
	bne bella
cbmform	jsr para10
	beq aus5
	lda mode
	ora #8
	bne cb1
aus5	lda mode
	and #247
cb1	sta mode
	jsr paran0
	sta cbmbreit
	rts
initvek	lda outvec+1
	cmp #>new
	beq schonan
	sta old+2
	lda outvec
	sta old+1
	lda #<new
	ldy #>new
	sta outvec
	sty outvec+1
schonan	lda #76
	sta old
	rts
test	jsr init
	lda #<testtext
	ldy #>testtext
	jsr strout
	jmp return
qstrout	tax
	lda tmp2
	pha
	lda tmp2+1
	pha
	txa
	sta tmp2
	sty tmp2+1
	ldy #0
lop	lda (tmp2),y
	beq sende
	cmp #"\x19"
	bne x12
	lda #0
x12	jsr write
	inc tmp2
	bne lop
	inc tmp2+1
	bne lop
sende	pla
	sta tmp2+1
	pla
	sta tmp2
	rts
grafikb	jsr get
	tax
	inx
	lda #8
	jsr old
gloop	dex
	beq gend
	jsr get
	ora #128
	jsr old
	bcc gloop
gend	lda #15
	jmp old
cbm	jsr kill
	lda #8
	jsr old
cbmloop	jsr get
	tax
	bne cbmcont
old15	lda #15
	jsr old
	jmp initvek
cbmcont	cmp #128
	bcs gr127
	cmp #" "
	bcc kl32
	cmp #$60
	bcc kl96
	and #$df
	bne ag
kl96	and #$3f
	jmp ag
kl32	ora #$80
	jmp ag
gr127	and #$7f
	cmp #$7f
	bne nopi
	lda #$5e
nopi	cmp #$20
	bcc kl32a
	ora #$40
	jmp ag
kl32a	ora #$40
	jmp kl32
ag	pha
	lda #0
	sta tmp
	lda vic+24
	and #2
	beq grogra
	lda #216
	.byt $2c
grogra	lda #208
	sta tmp+1
	pla
	tay
mal8	cpy #0
	beq mal8ende
	lda tmp
	clc
	adc #8
	sta tmp
	lda tmp+1
	adc #0
	sta tmp+1
	dey
	jmp mal8
mal8ende	sei
	lda konf
	pha
	lda #51
	sta konf
	ldy #6
holch	lda (tmp),y
	sta mem,y
	dey
	bpl holch
	pla
	sta konf
	cli
	ldy #8
ausw	lda #0
	tax
dreh	asl mem,x
	ror
	inx
	cpx #8
	bne dreh
	ora #$80
	jsr cbmaus
	dey
	bne ausw
	jmp cbmloop
cbmaus	tax
	lda mode
	and #8
	beq rvaus
	txa
	eor #127
	tax
rvaus	txa
	ldx cbmbreit
cbmauslp	beq fnsh
	jsr old
	dex
	bne cbmauslp
fnsh	rts
new	pha
	lda ga
	cmp drucker
	beq prnt
	pla
	jmp old
prnt	pla
	sta char
	pha
	txa
	pha
	tya
	pha
	tsx
	stx stc
	lda char
	jsr neu
sos	pla
	tay
	pla
	tax
	pla
	clc
	rts
neu	cmp #cr
	beq leeren
	ldx pffz
	sta buff,x
	inx
	bne platz
	jmp error
platz	stx pffz
	rts
fehl	rts
leeren	jsr zahlt
	ldx #0
	stx inpz
a1	lda inpz
	cmp pffz
	bcs end
	jsr get
	cmp #esc
	bne car
	jmp escape
qesc	jsr get
	sta char
	ldx #-1
a2	inx
	lda esccod,x
	bne a3
	ldx #2
	jmp error
a3	cmp char
	bne a2
	txa
	asl
	tax
	lda escadr,x
	sta goesc+1
	lda escadr+1,x
	sta goesc+2
goesc	jsr 0
	jmp a1
end	lda #0
	sta pffz
	lda #cr
	jmp ausgabe
car	jsr ausgabe
	jmp a1
ausgabe	jsr xput
	ldx anz
z2202	cpx #0
	beq fert
	jsr xput
	pha
	jsr chrout
	jsr trenn
	jsr xhol
	pla
	dex
	jmp z2202
fert	jmp xhol
qkill	lda old+1
	ldy old+2
	sta outvec
	sty outvec+1
	rts
trenn	ldx abst
	bne abu
	rts
abu	lda #8
	jsr old
	ldx abst
	lda #128
hux	cpx #0
	beq schaha
	jsr old
	dex
	jmp hux
schaha	lda #15
	jmp old
chrout	sta chr
	lda mode
	and #64
	beq noaa
	lda chr
	cmp #65
	bcc noaa
	cmp #91
	bcc aa1
	cmp #97
	bcc noaa
	cmp #123
	bcc aa2
	cmp #193
	bcc noaa
	cmp #219
	bcs noaa
aa2	cmp #123
	bcs sub2
	sec
	sbc #96
	bne sub
sub2	sec
	sbc #192
sub	clc
	adc #32
aa1	clc
	adc #32
z2420	sta chr
noaa	nop
	lda chr
	cmp #cr
	bne nocr
crlf	jsr old
	ldx leftr
	lda randc
lira	cpx #0
	bne wei
	rts
wei	jsr ausgabe
	dex
	jmp lira
nocr	cmp #cr+128
	beq crlf
	cmp #10
	bne no10
	ldx ga
	cpx #3
	bne no10
	rts
no10	cmp #34
	bne no34
	lda mode
	and #4
	bne gra
	lda #34
	bne no34
gra	jsr kill
	lda #<qutx
	ldy #>qutx
	jsr strout
	jmp initvek
no34	cmp #" "
	bne no32
o32	ldx spacea
	beq ret
	cpx #6
	beq no32
aendert	jsr kill
	lda #8
	jsr old
	lda #128
sploop	jsr old
	dex
	bne sploop
	jmp old15
ret	rts
no32	cmp #160
	beq o32
	jmp old
zahlt	lda mode
	and #2
	bne jaz
	rts
jaz	lda buff
	cmp #"0"
	bcs tatz
nixz	rts
tatz	cmp #"9"+1
	bcs nixz
	ldx #1
suchzw	lda buff,x
	cmp #"0"
	bcc endz
	cmp #"9"+1
	bcs endz
	inx
	cpx zlen
	bcc suchzw
	rts
endz	stx anzz
	ldx zlen
rueck	cpx anzz
	bne weiz
	rts
weiz	inc pffz
	ldy pffz
ru	dey
	lda buff,y
	iny
	sta buff,y
	dey
	cpy #-1
	bne ru
	lda randc
	sta buff
	dex
	jmp rueck
xput	pha
	txa
	pha
	ldx xstp
	sta xt,x
	inc xstp
	bne xok
	ldx #3
	jmp error
xok	pla
	tax
	pla
	rts
xhol	pha
	dec xstp
	ldx xstp
	lda xt,x
	tax
	pla
	rts
hardcopy	jsr para10
	beq null16
	lda mode
	ora #16
	bne smd
null16	lda mode
	and #239
smd	sta mode
	lda vic+24
	and #2
	asl
	asl
	asl
	asl
	asl
	asl
	eor #128
	clc
	adc #"\x11"
	sta grokle
	jsr kill
	lda #15
	jsr old
	lda #0
	ldy high
	sta tmp
	sty tmp+1
	ldx #25
h1	lda mode
	and #16
	bne h2
	lda #8
	jsr old
h2	jsr return
	lda #15
	jsr old
	lda grokle
	jsr old
	ldy #0
	sty quot
	sty rflg
h3	lda (tmp),y
	cmp #34
	bne h4
	lda quot
	eor #-1
	sta quot
	lda #34
h4	cmp #34+128
	bne h5
	lda #"'"+128
h5	cmp #$80
	bcc h6
	and #$7f
	bit quot
	bmi h8
	pha
	lda #"\x12"
	jsr chrout
	pla
	inc rflg
h6	cmp #32
	bcc h7
	cmp #96
	bcc h9
h7	clc
	adc #64
	bne h8
h9	cmp #64
	bcc h8
	clc
	adc #32
h8	jsr old
	lda rflg
	beq ha
	lda #"\x92"
	jsr old
	dec rflg
ha	iny
	cpy #40
	bcc h3
	tya
	clc
	adc tmp
	sta tmp
	bcc hb
	inc tmp+1
hb	lda quot
	beq hc
	lda #34
	jsr old
hc	dex
	bne goh1
	jsr return
	pla
	sta tmp+1
	pla
	sta tmp
	jmp init
goh1	jmp h1
zahlen	lda #8
	jsr old
zaloop	jsr get
	cmp #" "
	beq zasp
	cmp #"0"
	bcc zaend
	cmp #"9"+1
	bcc zahlwe
zaend	dec inpz
	lda #15
	jmp old
zasp	jmp zasp2
zahlwe	sec
	sbc #"0"
	tax
	lda zahlcod,x
	sta tmp
	lda #128
	jsr old
	lda #128
	pha
	lda tmp
	and #2
	beq zan2
	pla
	ora #6
	pha
zan2	lda tmp
	and #4
	beq zan4
	pla
	ora #48
	pha
zan4	pla
	jsr old
	lda #128
	pha
	lda tmp
	and #64
	beq zan64
	pla
	ora #1
	pha
zan64	lda tmp
	and #1
	beq zan1
	pla
	ora #8
	pha
zan1	lda tmp
	and #8
	beq zan8
	pla
	ora #64
	pha
zan8	pla
	jsr old
	jsr old
	lda #128
	pha
	lda tmp
	and #32
	beq zan32
	pla
	ora #6
	pha
zan32	lda tmp
	and #16
	beq zan16
	pla
	ora #48
	pha
zan16	pla
	jsr old
	lda #128
	jsr old
	jmp zaloop
zasp2	ldx #6
	lda #128
zastep	jsr old
	dex
	bne zastep
	jmp zaloop
tab	jsr get
	clc
	adc leftr
	cmp #80
	bcc gutso
	jmp nullf
gutso	jsr hexdez
	pha
	lda #"\x10}"
	jsr old
	txa
	jsr old
	pla
	jmp old
hexdez	ldx #0
hdloop	cmp #10
	bcc hdfert
	inx
	sec
	sbc #10
	jmp hdloop
hdfert	pha
	txa
	clc
	adc #"0"
	tax
	pla
	clc
	adc #"0"
	rts
pattern	jsr get
	sta laenge
	ldx #0
getpat	jsr get
	beq endpat
	sta muster,x
	inx
	bne getpat
endpat	cpx #0
	bne gr0
	ldx #5
	jmp error
gr0	lda #0
	sta muster,x
	ldy #0
	lda #8
	jsr old
paloop	lda laenge
	beq paend
pahol	lda muster,y
	bne pacont
	ldy #0
	beq pahol
pacont	ora #128
	jsr old
	iny
	dec laenge
	bne paloop
paend	lda #15
	jmp old
calc	jsr get
	cmp #32
	bcc k32
sonderr	ldx #6
	jmp error
k32	asl
	asl
	asl
	rts
define	jsr calc
	tax
	ldy #0
getsond	cpy #8
	bcs sonderr
	jsr get
	sta sonder,x
	cmp #0
	beq sondend
	inx
	iny
	bne getsond
sondend	rts
call	jsr calc
	tax
	lda #8
	jsr old
calson	lda sonder,x
	beq clend
	ora #128
	jsr old
	inx
	bne calson
clend	lda #15
	jmp old
miniform	jsr para10
	beq aus6
	lda mode
	ora #32
	bne cb2
aus6	lda mode
	and #$df
cb2	sta mode
	jsr paran0
	sta mbr
	jsr get
	and #3
	cmp #3
	bcc k3
	jmp nullf
k3	asl
	asl
	asl
	asl
	asl
	asl
	sta mart
	rts
micro	lda #8
	jsr old
microloop	jsr get
	cmp #0
	beq mend
	cmp #" "
	bcs mok
merr	ldx #7
	jmp error
mok	cmp #"_"+1
	bcs merr
	sec
	sbc #" "
	sta tmp
	asl
	clc
	adc tmp
	tax
	lda mini,x
	jsr mout
	lda mini+1,x
	jsr mout
	lda mini+2,x
	jsr mout
	lda #$80
	jsr mout
	jmp microloop
mend	lda #15
	jmp old
mout	pha
	lda mode
	and #32
	beq nmrvs
	pla
	eor #$3e
	pha
nmrvs	lda mart
	bmi down
	beq nup
	pla
	lsr
	and #$1f
	ora #128
	pha
	jmp nup
down	pla
	asl
	ora #128
	pha
nup	pla
	ldy mbr
mlp	jsr old
	dey
	bne mlp
	rts
clr	jsr $ffe7
	lda $37
	ldy $38
	sta $33
	sty $34
	lda $2d
	ldy $2e
	sta $2f
	sty $30
	sta $31
	sty $32
	jsr $a81d
	ldx #$19
	stx $16
	jmp $a687
