itty-bitty-vtty/vt100.cda.S
Kelvin Sherlock 80edada6e9 DECCOLM 132 support (partial).
I still don't support 132 mode but switching clears the screen, homes the cursor,
and clears any scrolling regions, so it's necessary for passing the vttest suite.
2022-01-30 15:52:32 -05:00

1016 lines
9.9 KiB
ArmAsm

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
*
* rom 1 IIgs InstallCDA clobbers $3c-$43 on the direct page
*
phd
pea #0
pld
psl #handle
_InstallCDA
pld
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
MAX_PAGE equ 8
pages dw variables
dw hexdump_r
dw hexdump_w
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)
: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 #MAX_PAGE-2
:lok sta page
bra main
:right lda page
inc
inc
cmp #MAX_PAGE
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 local
jsr decanm
jsr decom
jsr deckpam
jsr decckm
jsr decawm
jsr decarm
jsr decscnm
jsr deccolm
jsr lnm
jsr sgr
jsr dectm
jsr decbm
jsr decx
jsr decy
plp
rts
local
mx %10
ldy #line_4+4
ldx #:str
jsr print_xy_str
lda DPAGE+LOCAL
jmp print_on_off
:str asc "LOCAL: ",00
decanm
mx %10
ldy #line_5+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
decom
mx %10
ldy #line_6+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECOM
jmp print_on_off
:str asc "DECOM: ",00
deckpam
mx %10
ldy #line_7+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECKPAM
jmp print_on_off
:str asc "DECKPAM: ",00
decckm
mx %10
ldy #line_8+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECCKM
jmp print_on_off
:str asc "DECCKM: ",00
decawm
mx %10
ldy #line_9+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECAWM
jmp print_on_off
:str asc "DECAWM: ",00
decarm
mx %10
ldy #line_10+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECARM
jmp print_on_off
:str asc "DECARM: ",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
deccolm
mx %10
ldy #line_12+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECCOLM
jmp print_on_off
:str asc "DECCOLM: ",00
lnm
mx %10
ldy #line_13+4
ldx #:str
jsr print_xy_str
lda DPAGE+LNM
jmp print_on_off
:str asc "LNM: ",00
sgr
mx %10
ldy #line_14+4
ldx #:str
jsr print_xy_str
lda DPAGE+SGR
jmp print_binary
:str asc "SGR: ",00
dectm
mx %10
ldy #line_15+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECTM
inc
jmp print_number
:str asc "DECTM: ",00
decbm
mx %10
ldy #line_16+4
ldx #:str
jsr print_xy_str
lda DPAGE+DECBM
inc
jmp print_number
:str asc "DECBM: ",00
decx
mx %10
ldy #line_17+4
ldx #:str
jsr print_xy_str
lda DPAGE+x
and #$7f
inc
jmp print_number
:str asc "X: ",00
decy
mx %10
ldy #line_18+4
ldx #:str
jsr print_xy_str
lda DPAGE+y
inc
jmp print_number
:str asc "Y: ",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_r
*
* $1e00 buffer
*
mx %00
lda DPAGE+read_q_tail
sec
sbc #8*16
and #$00ff
ora #$1e00
jmp hexdump_common
hexdump_w
*
* $1d00 buffer
*
mx %00
lda DPAGE+write_q_tail
sec
sbc #8*16
and #$00ff
ora #$1d00
jmp hexdump_common
hexdump_common
*
* a = address to start.
: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
sta :ptr
lda #0
* stz :offset
sep #$20
ldx #4*2
stx :row
:one_row
ldx :row
ldy text,x
sty :screen
sty :screen2
lda #8
sta :count
:one_byte
lda (:ptr)
inc :ptr
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
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