prog8/compiler/res/prog8lib/c64/textio.p8

588 lines
11 KiB
Plaintext
Raw Normal View History

2020-08-27 16:10:22 +00:00
; Prog8 definitions for the Text I/O and Screen routines for the Commodore-64
;
; Written by Irmen de Jong (irmen@razorvine.net) - license: GNU GPL 3.0
;
; indent format: TABS, size=8
2020-09-09 20:49:32 +00:00
%target c64
%import syslib
%import conv
2020-08-27 16:10:22 +00:00
txt {
2020-09-19 22:17:33 +00:00
const ubyte DEFAULT_WIDTH = 40
const ubyte DEFAULT_HEIGHT = 25
sub clear_screen() {
clear_screenchars(' ')
2020-08-30 17:31:20 +00:00
}
2020-09-21 19:39:36 +00:00
asmsub fill_screen (ubyte char @ A, ubyte color @ Y) clobbers(A) {
2020-08-30 17:31:20 +00:00
; ---- fill the character screen with the given fill character and character color.
2019-01-06 01:11:16 +00:00
; (assumes screen and color matrix are at their default addresses)
%asm {{
2019-01-06 01:11:16 +00:00
pha
tya
jsr clear_screencolors
pla
jsr clear_screenchars
rts
}}
}
2019-07-08 21:00:18 +00:00
asmsub clear_screenchars (ubyte char @ A) clobbers(Y) {
2019-01-06 01:11:16 +00:00
; ---- clear the character screen with the given fill character (leaves colors)
; (assumes screen matrix is at the default address)
%asm {{
ldy #0
_loop sta c64.Screen,y
sta c64.Screen+$0100,y
sta c64.Screen+$0200,y
sta c64.Screen+$02e8,y
iny
bne _loop
rts
}}
2019-01-06 01:11:16 +00:00
}
2020-09-21 19:39:36 +00:00
asmsub clear_screencolors (ubyte color @ A) clobbers(Y) {
2019-01-06 01:11:16 +00:00
; ---- clear the character screen colors with the given color (leaves characters).
; (assumes color matrix is at the default address)
%asm {{
ldy #0
_loop sta c64.Colors,y
sta c64.Colors+$0100,y
sta c64.Colors+$0200,y
sta c64.Colors+$02e8,y
iny
bne _loop
rts
}}
}
sub color (ubyte txtcol) {
c64.COLOR = txtcol
}
sub lowercase() {
c64.VMCSB |= 2
}
sub uppercase() {
c64.VMCSB &= ~2
}
2020-09-21 19:39:36 +00:00
asmsub scroll_left (ubyte alsocolors @ Pc) 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
; Carry flag determines if screen color data must be scrolled too
2020-03-24 01:42:32 +00:00
%asm {{
stx P8ZP_SCRATCH_REG
bcs +
jmp _scroll_screen
+ ; scroll the color memory
ldx #0
ldy #38
-
.for row=0, row<=24, row+=1
lda c64.Colors + 40*row + 1,x
sta c64.Colors + 40*row,x
.next
inx
dey
bpl -
_scroll_screen ; scroll the screen memory
ldx #0
ldy #38
-
.for row=0, row<=24, row+=1
lda c64.Screen + 40*row + 1,x
sta c64.Screen + 40*row,x
.next
inx
dey
bpl -
ldx P8ZP_SCRATCH_REG
rts
}}
}
2020-09-21 19:39:36 +00:00
asmsub scroll_right (ubyte alsocolors @ Pc) clobbers(A) {
; ---- scroll the whole screen 1 character to the right
; contents of the leftmost column are unchanged, you should clear/refill this yourself
; Carry flag determines if screen color data must be scrolled too
%asm {{
stx P8ZP_SCRATCH_REG
bcs +
jmp _scroll_screen
+ ; scroll the color memory
ldx #38
-
.for row=0, row<=24, row+=1
lda c64.Colors + 40*row + 0,x
sta c64.Colors + 40*row + 1,x
.next
dex
bpl -
_scroll_screen ; scroll the screen memory
ldx #38
-
.for row=0, row<=24, row+=1
lda c64.Screen + 40*row + 0,x
sta c64.Screen + 40*row + 1,x
.next
dex
bpl -
ldx P8ZP_SCRATCH_REG
rts
}}
}
2020-09-21 19:39:36 +00:00
asmsub scroll_up (ubyte alsocolors @ Pc) clobbers(A) {
; ---- scroll the whole screen 1 character up
; contents of the bottom row are unchanged, you should refill/clear this yourself
; Carry flag determines if screen color data must be scrolled too
%asm {{
stx P8ZP_SCRATCH_REG
bcs +
jmp _scroll_screen
+ ; scroll the color memory
ldx #39
-
.for row=1, row<=24, row+=1
lda c64.Colors + 40*row,x
sta c64.Colors + 40*(row-1),x
.next
dex
bpl -
_scroll_screen ; scroll the screen memory
ldx #39
-
.for row=1, row<=24, row+=1
lda c64.Screen + 40*row,x
sta c64.Screen + 40*(row-1),x
.next
dex
bpl -
ldx P8ZP_SCRATCH_REG
rts
}}
}
2020-09-21 19:39:36 +00:00
asmsub scroll_down (ubyte alsocolors @ Pc) clobbers(A) {
; ---- scroll the whole screen 1 character down
; contents of the top row are unchanged, you should refill/clear this yourself
; Carry flag determines if screen color data must be scrolled too
%asm {{
stx P8ZP_SCRATCH_REG
bcs +
jmp _scroll_screen
+ ; scroll the color memory
ldx #39
-
.for row=23, row>=0, row-=1
lda c64.Colors + 40*row,x
sta c64.Colors + 40*(row+1),x
.next
dex
bpl -
_scroll_screen ; scroll the screen memory
ldx #39
-
.for row=23, row>=0, row-=1
lda c64.Screen + 40*row,x
sta c64.Screen + 40*(row+1),x
.next
dex
bpl -
ldx P8ZP_SCRATCH_REG
rts
}}
}
2020-09-19 20:10:33 +00:00
romsub $FFD2 = chrout(ubyte char @ A) ; for consistency. You can also use c64.CHROUT directly ofcourse.
2019-07-08 21:00:18 +00:00
asmsub print (str text @ AY) clobbers(A,Y) {
2018-12-14 22:15:44 +00:00
; ---- 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,
2019-01-12 15:13:40 +00:00
; 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
}}
}
2019-07-08 21:00:18 +00:00
asmsub print_ub0 (ubyte value @ A) clobbers(A,Y) {
2018-12-14 22:15:44 +00:00
; ---- print the ubyte in A in decimal form, with left padding 0s (3 positions total)
%asm {{
stx P8ZP_SCRATCH_REG
jsr conv.ubyte2decimal
pha
tya
jsr c64.CHROUT
pla
jsr c64.CHROUT
2019-09-22 23:58:01 +00:00
txa
jsr c64.CHROUT
ldx P8ZP_SCRATCH_REG
rts
}}
}
2019-07-08 21:00:18 +00:00
asmsub print_ub (ubyte value @ A) clobbers(A,Y) {
2018-12-14 22:15:44 +00:00
; ---- print the ubyte in A in decimal form, without left padding 0s
%asm {{
stx P8ZP_SCRATCH_REG
jsr conv.ubyte2decimal
2018-12-14 22:15:44 +00:00
_print_byte_digits
pha
cpy #'0'
2019-09-22 23:58:01 +00:00
beq +
tya
jsr c64.CHROUT
pla
jsr c64.CHROUT
jmp _ones
2019-09-22 23:58:01 +00:00
+ pla
cmp #'0'
beq _ones
2019-09-22 23:58:01 +00:00
jsr c64.CHROUT
_ones txa
jsr c64.CHROUT
ldx P8ZP_SCRATCH_REG
rts
}}
}
2019-01-12 15:13:40 +00:00
2019-07-08 21:00:18 +00:00
asmsub print_b (byte value @ A) clobbers(A,Y) {
2018-12-14 22:15:44 +00:00
; ---- print the byte in A in decimal form, without left padding 0s
%asm {{
stx P8ZP_SCRATCH_REG
2018-12-14 22:15:44 +00:00
pha
cmp #0
bpl +
lda #'-'
jsr c64.CHROUT
+ pla
jsr conv.byte2decimal
jmp print_ub._print_byte_digits
2018-12-14 22:15:44 +00:00
}}
}
asmsub print_ubhex (ubyte value @ A, ubyte prefix @ Pc) clobbers(A,Y) {
2018-12-14 22:15:44 +00:00
; ---- print the ubyte in A in hex form (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
stx P8ZP_SCRATCH_REG
bcc +
pha
lda #'$'
jsr c64.CHROUT
pla
+ jsr conv.ubyte2hex
jsr c64.CHROUT
tya
jsr c64.CHROUT
ldx P8ZP_SCRATCH_REG
rts
}}
}
asmsub print_ubbin (ubyte value @ A, ubyte prefix @ Pc) clobbers(A,Y) {
2019-01-12 12:34:45 +00:00
; ---- print the ubyte in A in binary form (if Carry is set, a radix prefix '%' is printed as well)
%asm {{
stx P8ZP_SCRATCH_REG
sta P8ZP_SCRATCH_B1
2019-01-12 12:34:45 +00:00
bcc +
lda #'%'
jsr c64.CHROUT
+ ldy #8
- lda #'0'
asl P8ZP_SCRATCH_B1
2019-01-12 12:34:45 +00:00
bcc +
lda #'1'
+ jsr c64.CHROUT
dey
bne -
ldx P8ZP_SCRATCH_REG
2019-01-12 12:34:45 +00:00
rts
}}
}
asmsub print_uwbin (uword value @ AY, ubyte prefix @ Pc) clobbers(A,Y) {
2019-01-12 12:34:45 +00:00
; ---- 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) {
2018-12-14 22:15:44 +00:00
; ---- print the uword in A/Y in hexadecimal form (4 digits)
; (if Carry is set, a radix prefix '$' is printed as well)
%asm {{
2018-12-14 22:15:44 +00:00
pha
tya
2018-12-20 22:28:03 +00:00
jsr print_ubhex
2018-12-14 22:15:44 +00:00
pla
clc
2018-12-20 22:28:03 +00:00
jmp print_ubhex
}}
}
2019-07-08 21:00:18 +00:00
asmsub print_uw0 (uword value @ AY) clobbers(A,Y) {
2018-12-14 22:15:44 +00:00
; ---- print the uword in A/Y in decimal form, with left padding 0s (5 positions total)
%asm {{
stx P8ZP_SCRATCH_REG
jsr conv.uword2decimal
ldy #0
- lda conv.uword2decimal.decTenThousands,y
2019-09-22 23:58:01 +00:00
beq +
jsr c64.CHROUT
iny
bne -
+ ldx P8ZP_SCRATCH_REG
rts
}}
}
2019-07-08 21:00:18 +00:00
asmsub print_uw (uword value @ AY) clobbers(A,Y) {
2018-12-14 22:15:44 +00:00
; ---- print the uword in A/Y in decimal form, without left padding 0s
%asm {{
stx P8ZP_SCRATCH_REG
jsr conv.uword2decimal
ldx P8ZP_SCRATCH_REG
ldy #0
- lda conv.uword2decimal.decTenThousands,y
2019-09-22 23:58:01 +00:00
beq _allzero
cmp #'0'
2019-09-22 23:58:01 +00:00
bne _gotdigit
iny
2019-09-22 23:58:01 +00:00
bne -
2019-09-22 23:58:01 +00:00
_gotdigit
jsr c64.CHROUT
iny
lda conv.uword2decimal.decTenThousands,y
2019-09-22 23:58:01 +00:00
bne _gotdigit
rts
2019-09-22 23:58:01 +00:00
_allzero
lda #'0'
jmp c64.CHROUT
}}
}
2019-07-08 21:00:18 +00:00
asmsub print_w (word value @ AY) clobbers(A,Y) {
2019-03-21 21:36:46 +00:00
; ---- print the (signed) word in A/Y in decimal form, without left padding 0's
2018-12-14 22:15:44 +00:00
%asm {{
cpy #0
bpl +
pha
lda #'-'
jsr c64.CHROUT
tya
eor #255
tay
pla
eor #255
clc
adc #1
bcc +
iny
2018-12-20 22:28:03 +00:00
+ jmp print_uw
2018-12-14 22:15:44 +00:00
}}
}
2019-07-08 21:00:18 +00:00
asmsub input_chars (uword buffer @ AY) clobbers(A) -> ubyte @ Y {
2019-03-15 22:10:26 +00:00
; ---- Input a string (max. 80 chars) from the keyboard. Returns length in Y. (string is terminated with a 0 byte as well)
2018-12-10 08:25:38 +00:00
; 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
}}
}
2020-09-19 20:10:33 +00:00
asmsub setchr (ubyte col @X, ubyte row @Y, ubyte character @A) clobbers(A, Y) {
; ---- sets the character in the screen matrix at the given position
2018-12-18 00:43:04 +00:00
%asm {{
2020-09-19 20:10:33 +00:00
pha
tya
2018-12-18 00:43:04 +00:00
asl a
tay
lda _screenrows+1,y
sta _mod+2
2020-09-19 20:10:33 +00:00
txa
2018-12-18 00:43:04 +00:00
clc
2020-09-19 20:10:33 +00:00
adc _screenrows,y
2018-12-18 00:43:04 +00:00
sta _mod+1
bcc +
inc _mod+2
2020-09-19 20:10:33 +00:00
+ pla
2018-12-18 00:43:04 +00:00
_mod sta $ffff ; modified
rts
2019-01-12 15:13:40 +00:00
2018-12-18 00:43:04 +00:00
_screenrows .word $0400 + range(0, 1000, 40)
}}
}
2020-09-19 20:10:33 +00:00
asmsub getchr (ubyte col @A, ubyte row @Y) clobbers(Y) -> ubyte @ A {
2019-02-21 00:31:33 +00:00
; ---- get the character in the screen matrix at the given location
%asm {{
2020-09-19 20:10:33 +00:00
pha
tya
2019-02-21 00:31:33 +00:00
asl a
tay
lda setchr._screenrows+1,y
sta _mod+2
2020-09-19 20:10:33 +00:00
pla
2019-02-21 00:31:33 +00:00
clc
2020-09-19 20:10:33 +00:00
adc setchr._screenrows,y
2019-02-21 00:31:33 +00:00
sta _mod+1
bcc _mod
inc _mod+2
_mod lda $ffff ; modified
rts
2019-02-21 00:31:33 +00:00
}}
}
2020-09-19 20:10:33 +00:00
asmsub setclr (ubyte col @X, ubyte row @Y, ubyte color @A) clobbers(A, Y) {
; ---- set the color in A on the screen matrix at the given position
2018-12-18 00:43:04 +00:00
%asm {{
2020-09-19 20:10:33 +00:00
pha
tya
2018-12-18 00:43:04 +00:00
asl a
tay
lda _colorrows+1,y
sta _mod+2
2020-09-19 20:10:33 +00:00
txa
2018-12-18 00:43:04 +00:00
clc
2020-09-19 20:10:33 +00:00
adc _colorrows,y
2018-12-18 00:43:04 +00:00
sta _mod+1
bcc +
inc _mod+2
2020-09-19 20:10:33 +00:00
+ pla
2018-12-18 00:43:04 +00:00
_mod sta $ffff ; modified
rts
2019-01-12 15:13:40 +00:00
2018-12-18 00:43:04 +00:00
_colorrows .word $d800 + range(0, 1000, 40)
}}
}
2020-09-19 20:10:33 +00:00
asmsub getclr (ubyte col @A, ubyte row @Y) clobbers(Y) -> ubyte @ A {
2019-02-21 00:31:33 +00:00
; ---- get the color in the screen color matrix at the given location
%asm {{
2020-09-19 20:10:33 +00:00
pha
tya
2019-02-21 00:31:33 +00:00
asl a
tay
lda setclr._colorrows+1,y
sta _mod+2
2020-09-19 20:10:33 +00:00
pla
2019-02-21 00:31:33 +00:00
clc
2020-09-19 20:10:33 +00:00
adc setclr._colorrows,y
2019-02-21 00:31:33 +00:00
sta _mod+1
bcc _mod
inc _mod+2
_mod lda $ffff ; modified
rts
2019-02-21 00:31:33 +00:00
}}
}
2019-01-12 15:13:40 +00:00
sub setcc (ubyte column, ubyte row, ubyte char, ubyte charcolor) {
2018-12-18 00:43:04 +00:00
; ---- set char+color at the given position on the screen
%asm {{
2019-08-04 16:40:50 +00:00
lda row
2018-12-18 00:43:04 +00:00
asl a
tay
lda setchr._screenrows+1,y
sta _charmod+2
adc #$d4
sta _colormod+2
lda setchr._screenrows,y
clc
2019-08-04 16:40:50 +00:00
adc column
2018-12-18 00:43:04 +00:00
sta _charmod+1
sta _colormod+1
bcc +
inc _charmod+2
inc _colormod+2
2019-08-04 16:40:50 +00:00
+ lda char
2018-12-18 00:43:04 +00:00
_charmod sta $ffff ; modified
lda charcolor
2018-12-18 00:43:04 +00:00
_colormod sta $ffff ; modified
rts
2019-01-12 15:13:40 +00:00
}}
2018-12-18 00:43:04 +00:00
}
2019-07-08 21:00:18 +00:00
asmsub plot (ubyte col @ Y, ubyte row @ A) clobbers(A) {
; ---- safe wrapper around PLOT kernel routine, to save the X register.
%asm {{
stx P8ZP_SCRATCH_REG
tax
clc
jsr c64.PLOT
ldx P8ZP_SCRATCH_REG
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
}}
}
2020-08-27 16:10:22 +00:00
}