Apple-2-SW/prog8
1
0
Fork 0
mirror of https://github.com/irmen/prog8.git synced 2024-11-26 11:49:22 +00:00
Code Issues Projects Releases Wiki Activity
dca31b2ca3
prog8/compiler/res/prog8lib/cx16/textio.p8
Irmen de Jong 8f6eaeac2c half width katakana conversion
2024-08-21 18:51:34 +02:00

672 lines
17 KiB
Lua
Raw Blame History

; Prog8 definitions for the Text I/O and Screen routines for the CommanderX16
; All routines work with Screencode character encoding, except `print`, `chrout` and `input_chars`,
; these work with PETSCII encoding instead.
%import syslib
%import conv
%import shared_cbm_textio_functions
txt {
%option no_symbol_prefixing, ignore_unused
const ubyte DEFAULT_WIDTH = 80
const ubyte DEFAULT_HEIGHT = 60
const ubyte VERA_TEXTMATRIX_BANK = 1
const uword VERA_TEXTMATRIX_ADDR = $b000
romsub $FFD2 = chrout(ubyte character @ A) ; for consistency. You can also use cbm.CHROUT directly ofcourse. Note: takes a PETSCII encoded character.
sub clear_screen() {
chrout(147)
}
sub cls() {
chrout(147)
}
sub home() {
chrout(19)
}
sub nl() {
chrout('\n')
}
sub spc() {
chrout(' ')
}
sub bell() {
chrout(7)
}
asmsub column(ubyte col @A) clobbers(A, X, Y) {
; ---- set the cursor on the given column (starting with 0) on the current line
%asm {{
pha
sec
jsr cbm.PLOT
pla
tay
clc
jmp cbm.PLOT
}}
}
asmsub get_column() -> ubyte @Y {
%asm {{
sec
jmp cbm.PLOT
}}
}
asmsub row(ubyte rownum @A) clobbers(A, X, Y) {
; ---- set the cursor on the given row (starting with 0) on the current line
%asm {{
pha
sec
jsr cbm.PLOT
pla
tax
clc
jmp cbm.PLOT
}}
}
asmsub get_row() -> ubyte @X {
%asm {{
sec
jmp cbm.PLOT
}}
}
sub get_cursor(uword colptr, uword rowptr) {
%asm {{
sec
jsr cbm.PLOT
tya
ldy #$00
sta (colptr),y
txa
sta (rowptr),y
}}
}
asmsub fill_screen (ubyte character @ A, ubyte color @ Y) clobbers(A, X) {
; ---- fill the character screen with the given fill character and character color.
%asm {{
sty _ly+1
pha
jsr cbm.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
lda #%00010000
jsr set_vera_textmatrix_addresses
pla
_lx ldx #0 ; modified
phy
_ly ldy #1 ; modified
- sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
sta cx16.VERA_DATA0
sty cx16.VERA_DATA0
dex
bne -
ply
dey
beq +
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M ; next line
bra _lx
+ rts
set_vera_textmatrix_addresses:
stz cx16.VERA_CTRL
ora #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
stz cx16.VERA_ADDR_L ; start at (0,0)
lda #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
rts
}}
}
asmsub clear_screenchars (ubyte character @ A) clobbers(X, Y) {
; ---- clear the character screen with the given fill character (leaves colors)
; (assumes screen matrix is at the default address)
%asm {{
pha
jsr cbm.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
lda #%00100000
jsr fill_screen.set_vera_textmatrix_addresses
pla
_lx ldx #0 ; modified
- sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
dex
bne -
dey
beq +
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M ; next line
bra _lx
+ rts
}}
}
asmsub clear_screencolors (ubyte color @ A) clobbers(X, Y) {
; ---- clear the character screen colors with the given color (leaves characters).
; (assumes color matrix is at the default address)
%asm {{
sta _la+1
jsr cbm.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
stz cx16.VERA_CTRL
lda #%00100000
jsr fill_screen.set_vera_textmatrix_addresses
inc cx16.VERA_ADDR_L ; start at (1,0) - the color attribute byte
_lx ldx #0 ; modified
_la lda #0 ; modified
- sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
sta cx16.VERA_DATA0
dex
bne -
dey
beq +
lda #1
sta cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M ; next line
bra _lx
+ rts
}}
}
ubyte[16] color_to_charcode = [$90,$05,$1c,$9f,$9c,$1e,$1f,$9e,$81,$95,$96,$97,$98,$99,$9a,$9b]
sub color (ubyte txtcol) {
txtcol &= 15
cbm.CHROUT(color_to_charcode[txtcol])
}
sub color2 (ubyte txtcol, ubyte bgcol) {
txtcol &= 15
bgcol &= 15
cbm.CHROUT(color_to_charcode[bgcol])
cbm.CHROUT(1) ; switch fg and bg colors
cbm.CHROUT(color_to_charcode[txtcol])
}
sub lowercase() {
cbm.CHROUT($0e)
; this is not 100% compatible: cx16.screen_set_charset(3, 0) ; lowercase petscii charset
}
sub uppercase() {
cbm.CHROUT($8e)
; this is not 100% compatible: cx16.screen_set_charset(2, 0) ; uppercase petscii charset
}
sub iso() {
; -- switch to iso-8859-15 character set
cbm.CHROUT($0f)
}
sub iso_off() {
; -- you have to call this first when switching back from iso charset to regular charset.
cbm.CHROUT($8f)
}
sub cp437() {
; -- switch to CP-437 (ibm PC) character set
cbm.CHROUT($0f) ; iso mode
cx16.screen_set_charset(7, 0) ; charset
%asm {{
clc
ldx #95 ; underscore
lda #cx16.EXTAPI_iso_cursor_char
jsr cx16.extapi
}}
}
sub iso5() {
; -- switch to iso-8859-5 character set (Cyrillic)
cbm.CHROUT($0f) ; iso mode
cx16.screen_set_charset(8, 0) ; charset
}
sub iso16() {
; -- switch to iso-8859-16 character set (Eastern Europe)
cbm.CHROUT($0f) ; iso mode
cx16.screen_set_charset(10, 0) ; charset
}
sub kata() {
; -- switch to katakana character set (requires rom 48+)
cbm.CHROUT($0f) ; iso mode
cx16.screen_set_charset(12, 0) ; charset
}
asmsub scroll_left() clobbers(A, X, Y) {
; ---- scroll the whole screen 1 character to the left
; contents of the rightmost column are unchanged, you should clear/refill this yourself
%asm {{
jsr cbm.SCREEN
dex
stx _lx+1
dey
sty P8ZP_SCRATCH_B1 ; number of rows to scroll
_nextline
stz cx16.VERA_CTRL ; data port 0: source column
lda #%00010000 | VERA_TEXTMATRIX_BANK ; auto increment 1
sta cx16.VERA_ADDR_H
lda #2
sta cx16.VERA_ADDR_L ; begin in column 1
lda P8ZP_SCRATCH_B1
clc
adc #>VERA_TEXTMATRIX_ADDR
tay
sty cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1: destination column
lda #%00010000 | VERA_TEXTMATRIX_BANK ; auto increment 1
sta cx16.VERA_ADDR_H
stz cx16.VERA_ADDR_L
sty cx16.VERA_ADDR_M
_lx ldx #0 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
bpl _nextline
lda #0
sta cx16.VERA_CTRL
rts
}}
}
asmsub scroll_right() clobbers(A,X,Y) {
; ---- scroll the whole screen 1 character to the right
; contents of the leftmost column are unchanged, you should clear/refill this yourself
%asm {{
jsr cbm.SCREEN
dex
stx _lx+1
txa
asl a
dea
sta _rcol+1
ina
ina
sta _rcol2+1
dey
sty P8ZP_SCRATCH_B1 ; number of rows to scroll
_nextline
stz cx16.VERA_CTRL ; data port 0: source column
lda #%00011000 | VERA_TEXTMATRIX_BANK ; auto decrement 1
sta cx16.VERA_ADDR_H
_rcol lda #79*2-1 ; modified
sta cx16.VERA_ADDR_L ; begin in rightmost column minus one
lda P8ZP_SCRATCH_B1
clc
adc #>VERA_TEXTMATRIX_ADDR
tay
sty cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1: destination column
lda #%00011000 | VERA_TEXTMATRIX_BANK ; auto decrement 1
sta cx16.VERA_ADDR_H
_rcol2 lda #79*2+1 ; modified
sta cx16.VERA_ADDR_L
sty cx16.VERA_ADDR_M
_lx ldx #0 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
bpl _nextline
lda #0
sta cx16.VERA_CTRL
rts
}}
}
asmsub scroll_up() clobbers(A, X, Y) {
; ---- scroll the whole screen 1 character up
; contents of the bottom row are unchanged, you should refill/clear this yourself
%asm {{
jsr cbm.SCREEN
stx _nextline+1
dey
sty P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL ; data port 0 is source
lda #1 | (>VERA_TEXTMATRIX_ADDR)
sta cx16.VERA_ADDR_M ; start at second line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
lda #1
sta cx16.VERA_CTRL ; data port 1 is destination
lda #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M ; start at top line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
_nextline
ldx #80 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
beq +
stz cx16.VERA_CTRL ; data port 0
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1
stz cx16.VERA_ADDR_L
inc cx16.VERA_ADDR_M
bra _nextline
+ lda #0
sta cx16.VERA_CTRL
rts
}}
}
asmsub scroll_down() clobbers(A, X, Y) {
; ---- scroll the whole screen 1 character down
; contents of the top row are unchanged, you should refill/clear this yourself
%asm {{
jsr cbm.SCREEN
stx _nextline+1
dey
sty P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL ; data port 0 is source
dey
tya
clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M ; start at line before bottom line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
lda #1
sta cx16.VERA_CTRL ; data port 1 is destination
iny
tya
clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M ; start at bottom line
stz cx16.VERA_ADDR_L
lda #%00010000 | VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
_nextline
ldx #80 ; modified
- lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy char
lda cx16.VERA_DATA0
sta cx16.VERA_DATA1 ; copy color
dex
bne -
dec P8ZP_SCRATCH_B1
beq +
stz cx16.VERA_CTRL ; data port 0
stz cx16.VERA_ADDR_L
dec cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1
stz cx16.VERA_ADDR_L
dec cx16.VERA_ADDR_M
bra _nextline
+ lda #0
sta cx16.VERA_CTRL
rts
}}
}
asmsub setchr (ubyte col @X, ubyte row @Y, ubyte character @A) clobbers(A) {
; ---- sets the character in the screen matrix at the given position
%asm {{
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
txa
asl a
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
pla
sta cx16.VERA_DATA0
rts
}}
}
asmsub getchr (ubyte col @A, ubyte row @Y) -> ubyte @ A {
; ---- get the character in the screen matrix at the given location
%asm {{
asl a
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
pla
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
lda cx16.VERA_DATA0
rts
}}
}
asmsub setclr (ubyte col @X, ubyte row @Y, ubyte color @A) clobbers(A) {
; ---- set the color in A on the screen matrix at the given position
; note: on the CommanderX16 this allows you to set both Fg and Bg colors;
; use the high nybble in A to set the Bg color!
%asm {{
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
txa
asl a
ina
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
pla
sta cx16.VERA_DATA0
rts
}}
}
asmsub getclr (ubyte col @A, ubyte row @Y) -> ubyte @ A {
; ---- get the color in the screen color matrix at the given location
%asm {{
asl a
ina
pha
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
pla
sta cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
lda cx16.VERA_DATA0
rts
}}
}
sub setcc (ubyte col, ubyte row, ubyte character, ubyte charcolor) {
; ---- set char+color at the given position on the screen
; note: color handling is the same as on the C64: it only sets the foreground color and leaves the background color as is.
; Use setcc2 if you want Cx-16 specific feature of setting both Bg+Fg colors (is faster as well).
%asm {{
lda col
asl a
tax
ldy row
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
stx cx16.VERA_ADDR_L
tya
;clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
lda character
sta cx16.VERA_DATA0
inc cx16.VERA_ADDR_L
lda charcolor
and #$0f
sta P8ZP_SCRATCH_B1
lda cx16.VERA_DATA0
and #$f0
ora P8ZP_SCRATCH_B1
sta cx16.VERA_DATA0
rts
}}
}
sub setcc2 (ubyte col, ubyte row, ubyte character, ubyte colors) {
; ---- set char+color at the given position on the screen
; note: on the CommanderX16 this allows you to set both Fg and Bg colors;
; use the high nybble in A to set the Bg color! Is a bit faster than setcc() too.
%asm {{
lda col
asl a
tax
ldy row
stz cx16.VERA_CTRL
lda #VERA_TEXTMATRIX_BANK
sta cx16.VERA_ADDR_H
stx cx16.VERA_ADDR_L
tya
; clc
adc #>VERA_TEXTMATRIX_ADDR
sta cx16.VERA_ADDR_M
lda character
sta cx16.VERA_DATA0
inc cx16.VERA_ADDR_L
lda colors
sta cx16.VERA_DATA0
rts
}}
}
asmsub plot (ubyte col @ Y, ubyte row @ X) {
%asm {{
clc
jmp cbm.PLOT
}}
}
asmsub width() clobbers(X,Y) -> ubyte @A {
; -- returns the text screen width (number of columns)
%asm {{
jsr cbm.SCREEN
txa
rts
}}
}
asmsub height() clobbers(X, Y) -> ubyte @A {
; -- returns the text screen height (number of rows)
%asm {{
jsr cbm.SCREEN
tya
rts
}}
}
asmsub waitkey() -> ubyte @A {
%asm {{
- jsr cbm.GETIN
beq -
rts
}}
}
asmsub chrout_lit(ubyte character @A) {
; -- print the character always as a literal character, not as possible control code.
%asm {{
tax
lda #128
jsr cbm.CHROUT
txa
jmp cbm.CHROUT
}}
}
asmsub print_lit(str text @ AY) clobbers(A,Y) {
; -- print zero terminated string, from A/Y, as all literal characters (no control codes)
%asm {{
sta P8ZP_SCRATCH_W2
sty P8ZP_SCRATCH_W2+1
ldy #0
- lda (P8ZP_SCRATCH_W2),y
beq +
tax
lda #128
jsr cbm.CHROUT
txa
jsr cbm.CHROUT
iny
bne -
+ rts
}}
}
}
Reference in New Issue View Git Blame Copy Permalink