Apple-2-SW/prog8
1
0
Fork 0
mirror of https://github.com/irmen/prog8.git synced 2024-12-28 12:32:34 +00:00
Code Issues Projects Releases Wiki Activity
c62ff16f8b
prog8/compiler/res/prog8lib/cx16/textio.p8

696 lines
16 KiB
Lua
Raw Blame History

; Prog8 definitions for the Text I/O and Screen routines for the CommanderX16
;
; Written by Irmen de Jong (irmen@razorvine.net) - license: GNU GPL 3.0
;
; indent format: TABS, size=8
%target cx16
%import syslib
%import conv
txt {
const ubyte DEFAULT_WIDTH = 80
const ubyte DEFAULT_HEIGHT = 60
sub clear_screen() {
txt.chrout(147)
}
asmsub fill_screen (ubyte char @ A, ubyte color @ Y) clobbers(A) {
; ---- fill the character screen with the given fill character and character color.
%asm {{
sty _ly+1
phx
pha
jsr c64.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
stz cx16.VERA_CTRL
lda #%00010000
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
stz cx16.VERA_ADDR_L ; start at (0,0)
stz cx16.VERA_ADDR_M
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
+ plx
rts
}}
}
asmsub clear_screenchars (ubyte char @ A) clobbers(Y) {
; ---- clear the character screen with the given fill character (leaves colors)
; (assumes screen matrix is at the default address)
%asm {{
phx
pha
jsr c64.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
stz cx16.VERA_CTRL
lda #%00100000
sta cx16.VERA_ADDR_H ; enable auto increment by 2, bank 0.
stz cx16.VERA_ADDR_L ; start at (0,0)
stz cx16.VERA_ADDR_M
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
+ plx
rts
}}
}
asmsub clear_screencolors (ubyte color @ A) clobbers(Y) {
; ---- clear the character screen colors with the given color (leaves characters).
; (assumes color matrix is at the default address)
%asm {{
phx
sta _la+1
jsr c64.SCREEN ; get dimensions in X/Y
txa
lsr a
lsr a
sta _lx+1
stz cx16.VERA_CTRL
lda #%00100000
sta cx16.VERA_ADDR_H ; enable auto increment by 2, bank 0.
lda #1
sta cx16.VERA_ADDR_L ; start at (1,0)
stz cx16.VERA_ADDR_M
_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
+ plx
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
c64.CHROUT(color_to_charcode[txtcol])
}
sub color2 (ubyte txtcol, ubyte bgcol) {
txtcol &= 15
bgcol &= 15
c64.CHROUT(color_to_charcode[bgcol])
c64.CHROUT(1) ; switch fg and bg colors
c64.CHROUT(color_to_charcode[txtcol])
}
sub lowercase() {
cx16.screen_set_charset(3, 0) ; lowercase charset
}
sub uppercase() {
cx16.screen_set_charset(2, 0) ; uppercase charset
}
asmsub scroll_left() clobbers(A, Y) {
; ---- scroll the whole screen 1 character to the left
; contents of the rightmost column are unchanged, you should clear/refill this yourself
%asm {{
phx
jsr c64.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 ; auto increment 1
sta cx16.VERA_ADDR_H
lda #2
sta cx16.VERA_ADDR_L ; begin in column 1
ldy P8ZP_SCRATCH_B1
sty cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1: destination column
lda #%00010000 ; 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
plx
rts
}}
}
asmsub scroll_right() clobbers(A) {
; ---- scroll the whole screen 1 character to the right
; contents of the leftmost column are unchanged, you should clear/refill this yourself
%asm {{
phx
jsr c64.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 ; 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
ldy P8ZP_SCRATCH_B1
sty cx16.VERA_ADDR_M
lda #1
sta cx16.VERA_CTRL ; data port 1: destination column
lda #%00011000 ; 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
plx
rts
}}
}
asmsub scroll_up() clobbers(A, Y) {
; ---- scroll the whole screen 1 character up
; contents of the bottom row are unchanged, you should refill/clear this yourself
%asm {{
phx
jsr c64.SCREEN
stx _nextline+1
dey
sty P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL ; data port 0 is source
lda #1
sta cx16.VERA_ADDR_M ; start at second line
stz cx16.VERA_ADDR_L
lda #%00010000
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
lda #1
sta cx16.VERA_CTRL ; data port 1 is destination
stz cx16.VERA_ADDR_M ; start at top line
stz cx16.VERA_ADDR_L
lda #%00010000
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
plx
rts
}}
}
asmsub scroll_down() clobbers(A, Y) {
; ---- scroll the whole screen 1 character down
; contents of the top row are unchanged, you should refill/clear this yourself
%asm {{
phx
jsr c64.SCREEN
stx _nextline+1
dey
sty P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL ; data port 0 is source
dey
sty cx16.VERA_ADDR_M ; start at line before bottom line
stz cx16.VERA_ADDR_L
lda #%00010000
sta cx16.VERA_ADDR_H ; enable auto increment by 1, bank 0.
lda #1
sta cx16.VERA_CTRL ; data port 1 is destination
iny
sty cx16.VERA_ADDR_M ; start at bottom line
stz cx16.VERA_ADDR_L
lda #%00010000
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
plx
rts
}}
}
romsub $FFD2 = chrout(ubyte char @ A) ; for consistency. You can also use c64.CHROUT directly ofcourse.
asmsub print (str text @ AY) clobbers(A,Y) {
; ---- print null terminated string from A/Y
; note: the compiler contains an optimization that will replace
; a call to this subroutine with a string argument of just one char,
; by just one call to c64.CHROUT of that single char.
%asm {{
sta P8ZP_SCRATCH_B1
sty P8ZP_SCRATCH_REG
ldy #0
- lda (P8ZP_SCRATCH_B1),y
beq +
jsr c64.CHROUT
iny
bne -
+ rts
}}
}
asmsub print_ub0 (ubyte value @ A) clobbers(A,Y) {
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
phx
jsr conv.ubyte2decimal
pha
tya
jsr c64.CHROUT
pla
jsr c64.CHROUT
txa
jsr c64.CHROUT
plx
rts
}}
}
asmsub print_ub (ubyte value @ A) clobbers(A,Y) {
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
phx
jsr conv.ubyte2decimal
_print_byte_digits
pha
cpy #'0'
beq +
tya
jsr c64.CHROUT
pla
jsr c64.CHROUT
jmp _ones
+ pla
cmp #'0'
beq _ones
jsr c64.CHROUT
_ones txa
jsr c64.CHROUT
plx
rts
}}
}
asmsub print_b (byte value @ A) clobbers(A,Y) {
; ---- print the byte in A in decimal form, without left padding 0s
%asm {{
phx
pha
cmp #0
bpl +
lda #'-'
jsr c64.CHROUT
+ pla
jsr conv.byte2decimal
jmp print_ub._print_byte_digits
}}
}
asmsub print_ubhex (ubyte value @ A, ubyte prefix @ Pc) clobbers(A,Y) {
; ---- print the ubyte in A in hex form (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
phx
bcc +
pha
lda #'$'
jsr c64.CHROUT
pla
+ jsr conv.ubyte2hex
jsr c64.CHROUT
tya
jsr c64.CHROUT
plx
rts
}}
}
asmsub print_ubbin (ubyte value @ A, ubyte prefix @ Pc) clobbers(A,Y) {
; ---- print the ubyte in A in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
phx
sta P8ZP_SCRATCH_B1
bcc +
lda #'%'
jsr c64.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
bcc +
lda #'1'
+ jsr c64.CHROUT
dey
bne -
plx
rts
}}
}
asmsub print_uwbin (uword value @ AY, ubyte prefix @ Pc) clobbers(A,Y) {
; ---- print the uword in A/Y in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
pha
tya
jsr print_ubbin
pla
clc
jmp print_ubbin
}}
}
asmsub print_uwhex (uword value @ AY, ubyte prefix @ Pc) clobbers(A,Y) {
; ---- print the uword in A/Y in hexadecimal form (4 digits)
; (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
pha
tya
jsr print_ubhex
pla
clc
jmp print_ubhex
}}
}
asmsub print_uw0 (uword value @ AY) clobbers(A,Y) {
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
phx
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq +
jsr c64.CHROUT
iny
bne -
+ plx
rts
}}
}
asmsub print_uw (uword value @ AY) clobbers(A,Y) {
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
phx
jsr conv.uword2decimal
plx
ldy #0
- lda conv.uword2decimal.decTenThousands,y
beq _allzero
cmp #'0'
bne _gotdigit
iny
bne -
_gotdigit
jsr c64.CHROUT
iny
lda conv.uword2decimal.decTenThousands,y
bne _gotdigit
rts
_allzero
lda #'0'
jmp c64.CHROUT
}}
}
asmsub print_w (word value @ AY) clobbers(A,Y) {
; ---- print the (signed) word in A/Y in decimal form, without left padding 0's
%asm {{
cpy #0
bpl +
pha
lda #'-'
jsr c64.CHROUT
tya
eor #255
tay
pla
eor #255
clc
adc #1
bcc +
iny
+ jmp print_uw
}}
}
asmsub input_chars (uword buffer @ AY) clobbers(A) -> ubyte @ Y {
; ---- Input a string (max. 80 chars) from the keyboard. Returns length in Y. (string is terminated with a 0 byte as well)
; It assumes the keyboard is selected as I/O channel!
%asm {{
sta P8ZP_SCRATCH_W1
sty P8ZP_SCRATCH_W1+1
ldy #0 ; char counter = 0
- jsr c64.CHRIN
cmp #$0d ; return (ascii 13) pressed?
beq + ; yes, end.
sta (P8ZP_SCRATCH_W1),y ; else store char in buffer
iny
bne -
+ lda #0
sta (P8ZP_SCRATCH_W1),y ; finish string with 0 byte
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
txa
asl a
stz cx16.VERA_CTRL
stz cx16.VERA_ADDR_H
sta cx16.VERA_ADDR_L
sty 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
stz cx16.VERA_CTRL
stz cx16.VERA_ADDR_H
sta cx16.VERA_ADDR_L
sty 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
%asm {{
pha
txa
asl a
ina
stz cx16.VERA_CTRL
stz cx16.VERA_ADDR_H
sta cx16.VERA_ADDR_L
sty 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
stz cx16.VERA_CTRL
stz cx16.VERA_ADDR_H
sta cx16.VERA_ADDR_L
sty cx16.VERA_ADDR_M
lda cx16.VERA_DATA0
rts
}}
}
sub setcc (ubyte column, ubyte row, ubyte char, ubyte charcolor) {
; ---- set char+color at the given position on the screen
%asm {{
phx
lda column
asl a
tax
ldy row
lda charcolor
and #$0f
sta P8ZP_SCRATCH_B1
stz cx16.VERA_CTRL
stz cx16.VERA_ADDR_H
stx cx16.VERA_ADDR_L
sty cx16.VERA_ADDR_M
lda char
sta cx16.VERA_DATA0
inx
stz cx16.VERA_ADDR_H
stx cx16.VERA_ADDR_L
sty cx16.VERA_ADDR_M
lda cx16.VERA_DATA0
and #$f0
ora P8ZP_SCRATCH_B1
sta cx16.VERA_DATA0
plx
rts
}}
}
asmsub plot (ubyte col @ Y, ubyte row @ A) clobbers(A) {
; ---- safe wrapper around PLOT kernel routine, to save the X register.
%asm {{
phx
tax
clc
jsr c64.PLOT
plx
rts
}}
}
asmsub width() clobbers(X,Y) -> ubyte @A {
; -- returns the text screen width (number of columns)
%asm {{
jsr c64.SCREEN
txa
rts
}}
}
asmsub height() clobbers(X, Y) -> ubyte @A {
; -- returns the text screen height (number of rows)
%asm {{
jsr c64.SCREEN
tya
rts
}}
}
}
Reference in New Issue View Git Blame Copy Permalink