lst off
	rel

	xc
	xc
	cas se
	tbx on ; qasm

	use apple2gs.equ
	use vt.equ
	use debug


* alternate character set
* $00-$1f = upper inverse ( asci value - $40)
* $20-$3f = special inverse (ascii value)
* $40-$4f = mouse text 
* $60-$7f = lower inverse (= ascii value)
* $80-$9f = upper [redundant]
* $a0-$bf = special (high ascii)
* $c0-$df = upper (high ascii)
* $e0-$ff = lower (high ascii)


* 40-column control panel
* TODO - if 80 column set in preferences, draw centered in 80-column mode


	dum 0
* cda direct page variables
ptr	ds 2
	dend


init_cda ent
	php
	rep #$30
	psl #handle
	_InstallCDA
	plp
	rts

handle	adrl Header ; can use a fake handle for now, until we need to _RemoveCDA
Header
	str 'Virtual Terminal'
	adrl start
	adrl shutdown
* variables.
page	ds 2


pages	dw variables
	dw hexdump
	dw ssc_registers

shutdown
	mx %00
	rtl

start
	mx %00

	phb
	phd

	phk
	plb

	sep #$30
	sta TXTSET
	sta CLR80VID
	sta SETALTCHAR
	rep #$30

	stz page
	jsr clear
	jsr box

main

	jsr clear_inner
	ldx page
	jsr (pages,x)
*	jsr variables
*	jsr hexdump


:keyloop
	lda KBD
	bpl :keyloop
	sta KEYSTROBE

	and #$7f

	cmp #$1b
	beq :exit

	cmp #$08 ; left
	beq :left
	cmp #$15
	beq :right
	bra :keyloop

:exit
	pld
	plb
	rtl

:left	lda page
	dec
	dec
	bpl :lok
	lda #$04
:lok	sta page
	bra main

:right	lda page
	inc
	inc
	cmp #$04+1
	bcc :rok
	lda #0
:rok	sta page
	bra main



clear
	ldx #23*2
	lda #"  "
:loop
	ldy text,x

]offset	equ 0
	lup 20
	sta |0+]offset,y
]offset	equ ]offset+2
	--^

	dex
	dex
	bpl :loop
	rts

clear_inner
* clear the inner contents.
	ldx #16*2
	lda #"  "
:loop	ldy text+8,x

]offset	equ 4
	lup 16
	sta |0+]offset,y
]offset	equ ]offset+2
	--^

	dex
	dex
	bpl :loop
	rts


box
	php

* top line
	lda #"_ "
	sta |line_0+38

	lda #" _"
	sta |line_0

	lda #"__"
	ldx #34

]loop	sta |line_0+2,x
	dex
	dex
	bpl ]loop

* bottom line.
* 'L' = $4c = _ but high 
	lda #'L '!$8000 ; keep ' ' high ascii.
	sta |line_23+38

	lda #' L'!$0080 ; keep ' ' high ascii.
	sta |line_23

	lda #'LL'
	ldx #34

]loop	sta |line_23+2,x
	dex
	dex
	bpl ]loop


* sides
	sep #$20
	lda #'Z'
	ldx #21*2 ; skip top/bottom lines.
]loop	ldy text+2,x
	sta |$0,y
	dex
	dex
	bpl ]loop

	sep #$20
	lda #'_'
	ldx #21*2 ; skip top/bottom lines.
]loop	ldy text+2,x
	sta |$0+39,y
	dex
	dex
	bpl ]loop


	rep #$20

* title
	ldx #36
]loop	lda :title,x
	sta |line_1+1,x
	dex
	dex
	bpl ]loop

	lda #'LL'
	ldx #36
]loop	sta |line_2+1,x
	dex
	dex
	bpl ]loop

* bottom instructions
	ldx #:instr_len-2
]loop	lda :instr,x
	sta |line_22+1,x
	dex
	dex
	bpl ]loop



	plp
	rts

:instr
	asc " Select: ",'H'," ",'U'," ",'J'," ",'K'
	asc "  Cancel:Esc  Save: ",'M'," "
:instr_len equ *-:instr
	err :instr_len&1


:title
	asc " Virtual Terminal "
	ds 38-18,' ' 


* print variables.
variables
	php
	sep #$20
	jsr decanm
	jsr dectm
	jsr decbm
	jsr decom
	jsr deckpam
	jsr decckm
	jsr decawm
	jsr decscnm
	jsr lnm
	jsr sgr
	plp
	rts


decanm
	mx %10
	ldy #line_4+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECANM
	bmi :100
	ldx #:vt52
	jmp print_xy_str

:100	ldx #:vt100
	jmp print_xy_str

:str	asc "DECANM:  ",00
:vt100	asc "vt100",00
:vt52	asc "vt52",00


dectm
	mx %10
	ldy #line_5+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECTM
	inc
	jmp print_number

:str	asc "DECTM:   ",00

decbm
	mx %10
	ldy #line_6+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECBM
	inc
	jmp print_number

:str	asc "DECBM:   ",00


decom
	mx %10
	ldy #line_7+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECOM
	jmp print_on_off

:str	asc "DECOM:   ",00

deckpam
	mx %10
	ldy #line_8+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECKPAM
	jmp print_on_off

:str	asc "DECKPAM: ",00

decckm
	mx %10
	ldy #line_9+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECCKM
	jmp print_on_off

:str	asc "DECCKM:  ",00


decawm
	mx %10
	ldy #line_10+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECAWM
	jmp print_on_off

:str	asc "DECAWM:  ",00


decscnm
	mx %10
	ldy #line_11+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+DECSCNM
	jmp print_on_off

:str	asc "DECSCNM: ",00


lnm
	mx %10
	ldy #line_12+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+LNM
	jmp print_on_off

:str	asc "LNM:     ",00


sgr
	mx %10
	ldy #line_13+4
	ldx #:str
	jsr print_xy_str
	lda DPAGE+SGR
	jmp print_binary


:str	asc "SGR:     ",00


print_xy_str
	mx %10
:loop	lda |$0,x
	beq :end
	sta |$0,y
	inx
	iny
	bra :loop
:end	
	rts

print_on_off
	mx %10
	bmi :set
	ldx #:off
	jmp print_xy_str
:set	ldx #:on
	jmp print_xy_str

:on	asc "on",00
:off	asc "off",00

print_number
	debug print_number
*
* print a base-10 number, 0-255
* a = #
	mx %10


	ldx #0

:100
	cmp #100
	bcc :10x
	inx
*	sec
	sbc #100
	bra :100

:10x
	cpx #0
	beq :10

	pha
	txa
*	clc
*	adc #"0"
	ora #"0"
	sta |$0,y
	iny
	pla
	ldx #0

:10
	cmp #10
	bcc :1x
	inx
	sbc #10
	bra :10

:1x
	cpx #0
	beq :1
	pha
	txa
*	clc
*	adc #"0"
	ora #"0"
	sta |$0,y
	iny
	pla

:1
*	clc
*	adc #"0"
	ora #"0"
	sta |$0,y
	iny
	rts

print_binary
	mx %10
*	pha
*	lda #"%"
*	sta |$0,y
*	iny
*	pla
	lup 8
	asl
	pha
	lda #0
	adc #"0"
	sta |$0,y
	iny
	pla
	--^
	rts

print_hex
	mx %10

	xba
	lda #0
	xba
	pha
	lsr
	lsr
	lsr
	lsr
	tax
	lda hex,x
	sta |$0,y
	iny
	pla
	and #$0f
	tax
	lda hex,x
	sta |$0,y
	iny
	rts

hexdump
*
* $1e00 buffer
*

:screen	equ 0
:screen2	equ 2
:offset	equ 4
:ptr	equ 6
:count	equ 8
:row	equ 10
:c	equ 12


	mx %00
	debug hexdump

	php
	lda #0
	sep #$20

	ldx #4*2
	stx :row

	ldy #0
	sty :offset

:one_row

	ldx :row
	ldy text,x
	sty :screen
	sty :screen2



	lda #8
	sta :count

:one_byte

	ldx :offset
	lda $1e00,x

	sta :c
	lsr
	lsr
	lsr
	lsr
	tax
	lda hex,x
	ldy :screen
	sta |$04,y
	iny
	lda :c
	and #$0f
	tax
	lda hex,x
	sta |$04,y
	iny
	lda #" "
	sta |$04,y
	iny
	sty :screen


* ascii
	ldx #"."
	lda :c
	cmp #$20
	blt :dot
	cmp #$80
	bcs :dot
	ora #$80
	tax
:dot
	txa
	ldy :screen2
	sta |8*3+4,y
	iny
	sty :screen2


	inc :offset
	dec :count
	bne :one_byte


	ldx :row
	inx
	inx
	stx :row
	cpx #20*2
	bcc :one_row

	plp
	rts

hex	asc "0123456789abcdef"



ssc_registers
	debug ssc_registers
*
* print SSC read registers.  read reg 8 (incoming data byte) is skipped.
*
*

*SCCBREG		equ $c038
*SCCAREG		equ $c039
*SCCBDATA	equ $c03a
*SCCADATA	equ $c03b

* read everything at once.

	php
	sep #$34 ; short m/x, ints off
	lda #0
	xba
*	sei
	ldx #0
	lda SCCAREG ; sync
	lda SCCBREG ; sync

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+0
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+1

	inx ;1

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+2
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+3

	inx ;2

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+4
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+5

	inx ;3

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+6
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+7


	ldx #10 ; 10

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+8
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+9


	ldx #12 ; 12

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+10
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+11

	inx ; 13

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+12
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+13

	ldx #15 ; 15

	stx SCCAREG
	lda SCCAREG
	sta ssc_data+14
	stx SCCBREG
	lda SCCBREG
	sta ssc_data+15


	cli
	rep #$10 ; long x
	mx %10
	jsr rr0
	jsr rr1
	jsr rr2
	jsr rr3 ; only exists in channel A.
	jsr rr10
	jsr rr12 ; baud low
*	jsr rr13 ; baud high
	jsr rr15
	plp
	rts

ssc_data	ds 16

rr0
	mx %10
	ldy #line_5+4
	ldx #:str
	jsr print_xy_str
	lda ssc_data+0
	jsr print_binary
	iny
	iny
	lda ssc_data+1
	jmp print_binary

:str	asc "RR 0:  ",00

rr1
	mx %10
	ldy #line_6+4
	ldx #:str
	jsr print_xy_str
	lda ssc_data+2
	jsr print_binary
	iny
	iny
	lda ssc_data+3
	jmp print_binary

:str	asc "RR 1:  ",00

rr2
	mx %10
	ldy #line_7+4
	ldx #:str
	jsr print_xy_str
	lda ssc_data+4
	jsr print_binary
	iny
	iny
	lda ssc_data+5
	jmp print_binary

:str	asc "RR 2:  ",00

rr3
	mx %10
	ldy #line_8+4
	ldx #:str
	jsr print_xy_str
	lda ssc_data+6
	jsr print_binary
	iny
	iny
	lda ssc_data+7
	jmp print_binary

:str	asc "RR 3:  ",00

rr10
	mx %10
	ldy #line_9+4
	ldx #:str
	jsr print_xy_str
	lda ssc_data+8
	jsr print_binary
	iny
	iny
	lda ssc_data+9
	jmp print_binary

:str	asc "RR 10: ",00

* 12/13 are baud

rr12
	mx %10
	ldy #line_10+4
	ldx #:str
	jsr print_xy_str

	iny
	iny
	iny
	iny

	lda ssc_data+12
	jsr print_hex
	lda ssc_data+10
	jsr print_hex

	iny
	iny
	iny
	iny
	iny
	iny

	lda ssc_data+13
	jsr print_hex
	lda ssc_data+11
	jmp print_hex


:str	asc "RR 12: ",00


rr15
	mx %10
	ldy #line_11+4
	ldx #:str
	jsr print_xy_str

	lda ssc_data+14
	jsr print_binary
	iny
	iny
	lda ssc_data+15
	jmp print_binary

:str	asc "RR 15: ",00





text
	dw $0400
	dw $0480
	dw $0500
	dw $0580
	dw $0600
	dw $0680
	dw $0700
	dw $0780
	dw $0428
	dw $04a8
	dw $0528
	dw $05a8
	dw $0628
	dw $06a8
	dw $0728
	dw $07a8
	dw $0450
	dw $04d0
	dw $0550
	dw $05d0
	dw $0650
	dw $06d0
	dw $0750
	dw $07d0



line_0	equ $0400
line_1	equ $0480
line_2	equ $0500
line_3	equ $0580
line_4	equ $0600
line_5	equ $0680
line_6	equ $0700
line_7	equ $0780
line_8	equ $0428
line_9	equ $04a8
line_10	equ $0528
line_11	equ $05a8
line_12	equ $0628
line_13	equ $06a8
line_14	equ $0728
line_15	equ $07a8
line_16	equ $0450
line_17	equ $04d0
line_18	equ $0550
line_19	equ $05d0
line_20	equ $0650
line_21	equ $06d0
line_22	equ $0750
line_23	equ $07d0


	sav vt100.cda.L