GroupZork chat

gzchat-jbevren.asm

{asm}
{undef:basic}
	; gzchat

	; scratch above screen
ox	= $07e8	; x pos for output
ix	= $07e9	; x pos for input line
inlen	= $07ea	; # chars in input buf
inpos	= $07eb	; char pos in input buf
kbflag	= $07ec	; input flags:
		; bit 7 = insert on
kblen	= 198	; chars in kb buf

	; kernal routines
setlfs	= $ffba
setnam	= $ffbd
open	= $ffc0
chkin	= $ffc6
chkout	= $ffc9
chrout	= $ffd2
getin	= $ffe4
plot	= $fff0

{ifdef:basic}
; pina: no basic stub while debugging
	orig $0801
	.word eob
	.word 0      ; version here
	.byte $9e
	ascii "2061"
	.byte 0
eob:
	.word 0
{else}
	orig $2000
{endif}

init:
	jmp start

	; scroll upper 23 lines
scroll:
	ldy #39
loop23:
	lda $0428,y
	sta $0400,y
	lda $0450,y
	sta $0428,y
	lda $0478,y
	sta $0450,y
	lda $04a0,y
	sta $0478,y
	lda $04c8,y
	sta $04a0,y
	lda $04f0,y
	sta $04c8,y
	lda $0518,y
	sta $04f0,y
	lda $0540,y
	sta $0518,y
	lda $0568,y
	sta $0540,y
	lda $0590,y
	sta $0568,y
	lda $05b8,y
	sta $0590,y
	lda $05e0,y
	sta $05b8,y
	lda $0608,y
	sta $05e0,y
	lda $0630,y
	sta $0608,y
	lda $0658,y
	sta $0630,y
	lda $0680,y
	sta $0658,y
	lda $06a8,y
	sta $0680,y
	lda $06d0,y
	sta $06a8,y
	lda $06f8,y
	sta $06d0,y
	dey
	bpl loop23 ; new loop for
	ldy #39    ; short branch range
loop23a:
	lda $0720,y
	sta $06f8,y
	lda $0748,y
	sta $0720,y
	lda $0770,y
	sta $0748,y
	lda #$20
	sta $0770,y ; erase line 23.
	dey
	bpl loop23a
rtsz:
	rts

cls:
	lda #147	; clear screen
	jsr chrout
	ldx inlen
	ldy inpos
	jmp bufok

conout:
	ldx #7		; assumed
	stx 217+23	; set line links
	stx 217+24	; to avoid messes
	cmp #13		; cr?
	bne pob		; no.
	lda #0
	sta ox
	jsr scroll
	jmp poskip
pob:
	jsr txtfilt	; bad char?
	beq poskip	; yes.
	ldy ox
	cpy #40		; eol?
	bne poz		; no.
pos:
	pha
	jsr scroll
	pla
	ldy #0
	sty ox
poz:
	pha
	ldx #0
	stx $d4		; quotes off
	ldx #22
	ldy ox
	clc
	jsr plot
	pla
	jsr chrout
	inc ox
poskip:
	rts

txtfilt:
	cmp #128	; high bit
	bpl highbit
	cmp #31		; ctrl?
	bmi txtbad	; ignore
	jmp txtok
highbit:
	cmp #159	; cyan
	bmi txtbad
	jmp txtok
txtbad:
	lda #0		; also sets .z
	sec
	rts
txtok:
	clc
	rts

	; scroll input left
sinl:
	ldy #0
sinll:
	lda $07c1,y
	sta $07c0,y
	iny
	cpy #39
	bne sinll
	rts

	; scroll input right
sinr:
	ldy #39
sinrl:
	lda $07bf,y
	sta $07c0,y
	dey
	bne sinrl
	rts

kbget:
;	sec
;	lda kblen
;	beq kbskip	; no text

	; attempt to add cursor
irq9:
	jsr $ffea
	lda $cc
	bne irq9f
	dec $cd
	bne irq9f
	lda #$14
	sta $cd
	ldy $d3
	lsr $cf
	ldx $0287
	lda ($d1),y
	bcs irq9e
	inc $cf
	sta $ce
	jsr $ea24
	lda ($f3),y
	sta $0287
	ldx $0286
	lda $ce
irq9e:
	eor #$80
	jsr $ea1c
irq9f:
;	jmp $ea87 ; this locks up

	sec
	lda kblen
	beq kbskip
	jsr getin	; non-blocking kb read
	clc
kbskip:
	rts

       ; pina: trying to fix delete behavior: output something
       ; jbev: placed here for proximity to beq
del:
	ldy inpos
	lda #$ff
       ; pina: actually delete char
	sta 400,y
	cpy #0
	beq nodel
	pha
       ; pina: this dels from start of string :(
dell:
	lda inbuf+1,y
	sta inbuf,y
	iny
	cpy inlen
	bne dell
	ldy inpos
	dex
	dey ; pina: dec buf len?
	pla
nodel:
	jmp bufok

	; handle console input
	; pina: "inc $d020" shows prg is alive
conin:
	inc $d020
	jsr kbget
	ldx inlen
	ldy inpos
	bcc key
	jmp nokey
key:
	cmp #13	; return?
	bne notcr
	jmp pcmd
notcr:
	cmp #3		; stop
	bne notstop
{ifndef:basic}
	; pina: while debugging don't return to basic...
	pla	; pop return address
	pla	; so we can return
	rts	; to basic.
	; ...jump back to tmp instead
{else}
	jmp $8000
{endif}
notstop:
	cmp #20		; delete
	beq del
	cmp #148	; insert
	bne ninst
; toggle insert mode
	pha
	lda #128
	eor kbflag
	sta kbflag
	pla
	jsr upstat ; pina: show ins/ovr status
	jmp bufok

ninst:
	cmp #157	; left?
	bne notleft
	cpy #0
	beq bufok
	dey
	jmp bufok
notleft:
	cmp #29		; right?
	bne notright
	cpy #255
	beq bufok
	iny
	jmp bufok
	bne notright
notright:
	clc
	jsr txtfilt
	bcs nokey
	bit kbflag
	bpl ovrtype

; handle insert mode
	ldx inlen
	cpx #254
	bne insok
	jmp nokey
insok:
	pha
	inc inlen
	ldy inpos
insl:
	lda inbuf,y
	sta inbuf+1,y
	lda ox,y	; was $0400,y
	sta ox+1,y	; was $0400+1,y
	iny
	cpy inlen
	bne insl
	ldy inpos	; recall after move
	pla
; fall to overtype to set buf
ovrtype:
	ldx inlen
	ldy inpos
	sta inbuf,y
	sta ox,y	; was $0400,y
	iny
	cpy inlen	; room to enlarge buffer?
	bmi bufok	; nope
	inx
	cpy #0		; overflow?
	bne ovrok	; no.
	ldy #255
	ldx #255
ovrok:
	sty inpos	; set inlen to inpos
	ldx inpos	; to fix buffer size
bufok:
	stx inlen
	sty inpos
; update input line here
	ldx #24
	ldy #0
	clc
	jsr plot
	ldx #40
	ldy inpos
conl:
	lda inbuf,y
	cpy inlen	; past end of buf?
	bmi conz	; no.
	lda #32		; yes, clear to eol
conz:
	jsr chrout
	iny
	dex
	bne conl

nokey:	; process network next
	; conout was here but its now
	; a function.

netin:	; handle network
	; drr do stuff here
	rts

upstat:
; update status line: for now just do 40 spc
; pina: preserve regs:
	sta savea
	stx savex
	sty savey

; pina: this could also be rewritten as:
; sta 0798,y (2nd from bottom row on screen)

;	ldx #23
;	ldy #0
;	clc
;	jsr plot
;	lda #18	; reverse
;	jsr chrout
;	lda #32	; spaces
;	ldx #40	; 40 of them.
	ldy #40
upstatl:
;	jsr chrout
	sta $0798,y
	dey
	bne upstatl
;	lda #18+128	; reverse off
;	jsr chrout

; pina: display Ins/Ovr status
	ldx #2		; # of chars to output
	ldy #2		; where to start
	bit kbflag
	bne statovr
	ldy #5
statovr:
	lda kbflagmsg,y
	sta $07a6,x	; store to screen
	dey		; work backwards thru string
	dex
	cmp #$ff	; wrap around?
	bne statovr
	ldy savey
	ldx savex
	lda savea
	rts

pcmd:
	; process buffer after cr
	; process here

	;fall through to demo below.

	lda #13
	jsr conout
	lda #13
	jsr conout

prbuf:
	ldy inlen
	beq prskip
	ldy #0
pbloop:
	tya
	pha
	lda inbuf,y
	jsr conout
	pla
	tay
	iny
	cpy inlen
	bne pbloop
	jsr upstat
prskip:
	ldx #0
	ldy #0
	jmp bufok

start:
	lda #0
	sta ix
	sta ox
	sta inpos
	sta kbflag
	lda #255
	sta inlen
	jsr upstat

	jsr cls

	jsr prbuf

demol:
	jsr conin
	ldx inlen
	stx $0798 ; 1st char
	ldx inpos
	stx $0799 ; 2nd char
	jmp demol

	;will have program loop here.
	jmp *	;spin forever

inbuf:	ascii "GREETS GOOG AGEN"
	ascii "TFRIDAY FUNGUS M"
	ascii "ECH DMACKEY ERIK"
	ascii " F15SIM JBRAIN S"
	ascii "IX _DW BHZ SLOOP"
	ascii "Y MHONEY VANESSA"
	ascii "E WIZARDNJ ELWIX"
	ascii " FUZZ JPPBM FRIT"
	ascii "SKE ZAP SLAYGON "
	ascii "DEEKAY AND ANYON"
	ascii "E STILL DOING C6"
	ascii "4 TODAY!"        
	.byte $0d,$0d

	ascii "STOP TO EXIT.."
	.byte $0d,$0d

	ascii "STILL HUGELY BUGGY!!"
	.byte $0d,$0d

	ascii "DEBUG VERSION. " 
	ascii "GZCHAT RC1 DEMO!"

kbflagmsg:
; these must be screen codes
; +64 = uppercase, +128 = reverse
	.byte	9+64+128  ; I c9
	.byte 14   +128  ; n 8e
	.byte 19   +128  ; s 93
	.byte 15+64+128  ; O cf
	.byte 22   +128  ; v 96
	.byte 18   +128  ; r 92

savea:	.byte $00
savex:	.byte $00
savey:	.byte $00
{endasm}