; 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 cls() { 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 }} } }