prog8/compiler/res/prog8lib/pet32/textio.p8
2024-03-28 00:39:58 +01:00

263 lines
4.8 KiB
Lua

; Prog8 definitions for the Text I/O and Screen routines for the Commodore PET
; 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 = 40
const ubyte DEFAULT_HEIGHT = 25
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 home() {
chrout(19)
}
sub nl() {
chrout('\n')
}
sub spc() {
chrout(' ')
}
sub bell() {
chrout(7)
}
asmsub fill_screen (ubyte character @ A, ubyte color @ Y) clobbers(A) {
; ---- fill the character screen with the given fill character. color is ignored on PET
%asm {{
jmp clear_screenchars
}}
}
asmsub clear_screenchars (ubyte character @ A) clobbers(Y) {
; ---- clear the character screen with the given fill character
; (assumes screen matrix is at the default address)
%asm {{
ldy #250
- sta cbm.Screen+250*0-1,y
sta cbm.Screen+250*1-1,y
sta cbm.Screen+250*2-1,y
sta cbm.Screen+250*3-1,y
dey
bne -
rts
}}
}
sub clear_screencolors (ubyte color) {
; --- dummy function on PET
}
sub color (ubyte txtcol) {
; --- dummy function on PET
}
sub lowercase() {
txt.chrout(14)
}
sub uppercase() {
txt.chrout(142)
}
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 {{
ldx #0
ldy #38
-
.for row=0, row<=24, row+=1
lda cbm.Screen + 40*row + 1,x
sta cbm.Screen + 40*row + 0,x
.next
inx
dey
bpl -
rts
}}
}
asmsub scroll_right () clobbers(A,X) {
; ---- scroll the whole screen 1 character to the right
; contents of the leftmost column are unchanged, you should clear/refill this yourself
%asm {{
ldx #38
-
.for row=0, row<=24, row+=1
lda cbm.Screen + 40*row + 0,x
sta cbm.Screen + 40*row + 1,x
.next
dex
bpl -
rts
}}
}
asmsub scroll_up () clobbers(A,X) {
; ---- scroll the whole screen 1 character up
; contents of the bottom row are unchanged, you should refill/clear this yourself
%asm {{
ldx #39
-
.for row=1, row<=24, row+=1
lda cbm.Screen + 40*row,x
sta cbm.Screen + 40*(row-1),x
.next
dex
bpl -
rts
}}
}
asmsub scroll_down () clobbers(A,X) {
; ---- scroll the whole screen 1 character down
; contents of the top row are unchanged, you should refill/clear this yourself
%asm {{
ldx #39
-
.for row=23, row>=0, row-=1
lda cbm.Screen + 40*row,x
sta cbm.Screen + 40*(row+1),x
.next
dex
bpl -
rts
}}
}
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
%asm {{
pha
tya
asl a
tay
lda _screenrows+1,y
sta _mod+2
txa
clc
adc _screenrows,y
sta _mod+1
bcc +
inc _mod+2
+ pla
_mod sta $ffff ; modified
rts
_screenrows .word cbm.Screen + range(0, 1000, 40)
}}
}
asmsub getchr (ubyte col @A, ubyte row @Y) clobbers(Y) -> ubyte @ A {
; ---- get the character in the screen matrix at the given location
%asm {{
pha
tya
asl a
tay
lda setchr._screenrows+1,y
sta _mod+2
pla
clc
adc setchr._screenrows,y
sta _mod+1
bcc _mod
inc _mod+2
_mod lda $ffff ; modified
rts
}}
}
sub setclr (ubyte col, ubyte row, ubyte color) {
; --- dummy function on PET
}
sub setcc (ubyte col, ubyte row, ubyte character, ubyte charcolor) {
; ---- set char at the given position on the screen. charcolor is ignored on PET
%asm {{
lda row
asl a
tay
lda setchr._screenrows+1,y
sta _charmod+2
lda setchr._screenrows,y
clc
adc col
sta _charmod+1
bcc +
inc _charmod+2
+ lda character
_charmod sta $ffff ; modified
rts
}}
}
asmsub plot (ubyte col @ Y, ubyte row @ X) {
%asm {{
jsr home
cpy #0
beq +
- lda #17
jsr chrout
dey
bne -
+ cpx #0
beq +
- lda #29
jsr chrout
dex
bne -
+ rts
}}
}
asmsub width() clobbers(X,Y) -> ubyte @A {
; -- returns the text screen width (number of columns)
%asm {{
lda $d5
clc
adc #1
rts
}}
}
asmsub height() clobbers(X, Y) -> ubyte @A {
; -- returns the text screen height (number of rows)
%asm {{
lda #25
rts
}}
}
asmsub waitkey() -> ubyte @A {
%asm {{
- jsr cbm.GETIN
beq -
rts
}}
}
}