prog8/compiler/res/prog8lib/cx16/monogfx.p8
Irmen de Jong ee81da14d6 cx16: removed monochrome modes from gfx2 (use monogfx instead). New screen mode numbering!
programs will now be a lot smaller than before if they use gfx2 (or monogfx if they were only using monochrome drawing)
monogfx also fixes some drawing errors with small horizontal lines, and stippled vertical lines.
2023-10-05 02:12:46 +02:00

785 lines
24 KiB
Lua

; Monochrome Bitmap pixel graphics routines for the CommanderX16
; Using the full-screen 640x480 and 320x240 screen modes, in 1 bpp mode (black/white).
;
; No text layer is currently shown, but text can be drawn as part of the bitmap itself.
; For color bitmap graphics, see the gfx2 library.
;
; NOTE: a lot of the code here is similar or the same to that in gfx2
monogfx {
%option no_symbol_prefixing
; read-only control variables:
uword width = 0
uword height = 0
bool dont_stipple_flag = true ; set to false to enable stippling mode
sub lores() {
; enable 320*240 bitmap mode
cx16.VERA_CTRL=0
cx16.VERA_DC_VIDEO = (cx16.VERA_DC_VIDEO & %11001111) | %00100000 ; enable only layer 1
cx16.VERA_DC_HSCALE = 64
cx16.VERA_DC_VSCALE = 64
cx16.VERA_L1_CONFIG = %00000100
cx16.VERA_L1_MAPBASE = 0
cx16.VERA_L1_TILEBASE = 0
width = 320
height = 240
clear_screen()
}
sub hires() {
; enable 640*480 bitmap mode
cx16.VERA_CTRL=0
cx16.VERA_DC_VIDEO = (cx16.VERA_DC_VIDEO & %11001111) | %00100000 ; enable only layer 1
cx16.VERA_DC_HSCALE = 128
cx16.VERA_DC_VSCALE = 128
cx16.VERA_L1_CONFIG = %00000100
cx16.VERA_L1_MAPBASE = 0
cx16.VERA_L1_TILEBASE = %00000001
width = 640
height = 480
clear_screen()
}
sub textmode() {
; back to normal text mode
cx16.r15L = cx16.VERA_DC_VIDEO & %00000111 ; retain chroma + output mode
cbm.CINT()
cx16.VERA_DC_VIDEO = (cx16.VERA_DC_VIDEO & %11111000) | cx16.r15L
}
sub clear_screen() {
stipple(false)
position(0, 0)
when width {
320 -> {
repeat 240/2/8
cs_innerloop640()
}
640 -> {
repeat 480/8
cs_innerloop640()
}
}
position(0, 0)
}
sub stipple(bool enable) {
dont_stipple_flag = not enable
}
sub rect(uword xx, uword yy, uword rwidth, uword rheight, bool draw) {
if rwidth==0 or rheight==0
return
horizontal_line(xx, yy, rwidth, draw)
if rheight==1
return
horizontal_line(xx, yy+rheight-1, rwidth, draw)
vertical_line(xx, yy+1, rheight-2, draw)
if rwidth==1
return
vertical_line(xx+rwidth-1, yy+1, rheight-2, draw)
}
sub fillrect(uword xx, uword yy, uword rwidth, uword rheight, bool draw) {
if rwidth==0
return
repeat rheight {
horizontal_line(xx, yy, rwidth, draw)
yy++
}
}
sub horizontal_line(uword xx, uword yy, uword length, bool draw) {
ubyte[9] masked_starts = [ 0, %00000001, %00000011, %00000111, %00001111, %00011111, %00111111, %01111111, %11111111]
ubyte[9] masked_ends = [ 0, %10000000, %11000000, %11100000, %11110000, %11111000, %11111100, %11111110, %11111111]
if length==0
return
if length<=8 {
; just use 2 byte writes with shifted mask
position2(xx,yy,true)
%asm {{
ldy length
lda masked_ends,y
sta cx16.r0L ; save left byte
stz P8ZP_SCRATCH_B1
lda xx
and #7
beq +
tay
lda cx16.r0L
- lsr a
ror P8ZP_SCRATCH_B1
dey
bne -
sta cx16.r0L ; new left byte
+
lda dont_stipple_flag
bne _dontstipple
; determine stipple pattern
lda yy
and #1
beq +
lda #%10101010
bne ++
+ lda #%01010101
+ sta P8ZP_SCRATCH_REG
lda cx16.r0L
and P8ZP_SCRATCH_REG
sta cx16.r0L
lda P8ZP_SCRATCH_B1
and P8ZP_SCRATCH_REG
sta P8ZP_SCRATCH_B1
_dontstipple
lda draw
beq _clear
lda cx16.r0L ; left byte
ora cx16.VERA_DATA1
sta cx16.VERA_DATA0
lda P8ZP_SCRATCH_B1 ; right byte
ora cx16.VERA_DATA1
sta cx16.VERA_DATA0
rts
_clear
lda cx16.r0L ; left byte
eor #255
and cx16.VERA_DATA1
sta cx16.VERA_DATA0
lda P8ZP_SCRATCH_B1 ; right byte
eor #255
and cx16.VERA_DATA1
sta cx16.VERA_DATA0
rts
}}
}
ubyte separate_pixels = (8-lsb(xx)) & 7
if separate_pixels {
if dont_stipple_flag {
position(xx,yy)
cx16.VERA_ADDR_H &= %00000111 ; vera auto-increment off
if draw
cx16.VERA_DATA0 |= masked_starts[separate_pixels]
else
cx16.VERA_DATA0 &= ~masked_starts[separate_pixels]
xx += separate_pixels
} else {
repeat separate_pixels {
plot(xx, yy, draw)
xx++
}
}
length -= separate_pixels
}
if length {
position(xx, yy)
separate_pixels = lsb(length) & 7
xx += length & $fff8
%asm {{
lsr length+1
ror length
lsr length+1
ror length
lsr length+1
ror length
lda draw
bne +
ldy #0 ; black
bra _loop
+ lda dont_stipple_flag
beq _stipple
ldy #255 ; don't stipple
bra _loop
_stipple lda yy
and #1 ; determine stipple pattern to use
bne +
ldy #%01010101
bra _loop
+ ldy #%10101010
_loop lda length
ora length+1
beq _done
sty cx16.VERA_DATA0
lda length
bne +
dec length+1
+ dec length
bra _loop
_done
}}
if dont_stipple_flag {
cx16.VERA_ADDR_H &= %00000111 ; vera auto-increment off
if draw
cx16.VERA_DATA0 |= masked_ends[separate_pixels]
else
cx16.VERA_DATA0 &= ~masked_ends[separate_pixels]
} else {
repeat separate_pixels {
plot(xx, yy, draw)
xx++
}
}
}
cx16.VERA_ADDR_H &= %00000111 ; vera auto-increment off again
}
sub vertical_line(uword xx, uword yy, uword lheight, bool draw) {
cx16.r15L = monogfx.plot.maskbits[xx as ubyte & 7] ; bitmask
if draw {
if dont_stipple_flag {
; draw continuous line.
position2(xx,yy,true)
if width==320
set_both_strides(11) ; 40 increment = 1 line in 320 px monochrome
else
set_both_strides(12) ; 80 increment = 1 line in 640 px monochrome
repeat lheight {
%asm {{
lda cx16.VERA_DATA0
ora cx16.r15L
sta cx16.VERA_DATA1
}}
}
} else {
; draw stippled line.
if (xx ^ yy)&1==0 {
yy++
lheight--
}
lheight++ ; because it is divided by 2 later, don't round off the last pixel
position2(xx,yy,true)
if width==320
set_both_strides(12) ; 80 increment = 2 line in 320 px monochrome
else
set_both_strides(13) ; 160 increment = 2 line in 640 px monochrome
repeat lheight/2 {
%asm {{
lda cx16.VERA_DATA0
ora cx16.r15L
sta cx16.VERA_DATA1
}}
}
}
} else {
position2(xx,yy,true)
cx16.r15 = ~cx16.r15 ; erase pixels
if width==320
set_both_strides(11) ; 40 increment = 1 line in 320 px monochrome
else
set_both_strides(12) ; 80 increment = 1 line in 640 px monochrome
repeat lheight {
%asm {{
lda cx16.VERA_DATA0
and cx16.r15L
sta cx16.VERA_DATA1
}}
}
}
sub set_both_strides(ubyte stride) {
stride <<= 4
cx16.VERA_CTRL = 0
cx16.VERA_ADDR_H = cx16.VERA_ADDR_H & %00000111 | stride
cx16.VERA_CTRL = 1
cx16.VERA_ADDR_H = cx16.VERA_ADDR_H & %00000111 | stride
}
}
sub line(uword @zp x1, uword @zp y1, uword @zp x2, uword @zp y2, bool draw) {
; Bresenham algorithm.
; This code special-cases various quadrant loops to allow simple ++ and -- operations.
if y1>y2 {
; make sure dy is always positive to have only 4 instead of 8 special cases
cx16.r0 = x1
x1 = x2
x2 = cx16.r0
cx16.r0 = y1
y1 = y2
y2 = cx16.r0
}
word @zp dx = (x2 as word)-x1
word @zp dy = (y2 as word)-y1
if dx==0 {
vertical_line(x1, y1, abs(dy) as uword +1, draw)
return
}
if dy==0 {
if x1>x2
x1=x2
horizontal_line(x1, y1, abs(dx) as uword +1, draw)
return
}
word @zp d = 0
cx16.r1L = true ; 'positive_ix'
if dx < 0 {
dx = -dx
cx16.r1L = false
}
word @zp dx2 = dx*2
word @zp dy2 = dy*2
cx16.r14 = x1 ; internal plot X
if dx >= dy {
if cx16.r1L {
repeat {
plot(cx16.r14, y1, draw)
if cx16.r14==x2
return
cx16.r14++
d += dy2
if d > dx {
y1++
d -= dx2
}
}
} else {
repeat {
plot(cx16.r14, y1, draw)
if cx16.r14==x2
return
cx16.r14--
d += dy2
if d > dx {
y1++
d -= dx2
}
}
}
}
else {
if cx16.r1L {
repeat {
plot(cx16.r14, y1, draw)
if y1 == y2
return
y1++
d += dx2
if d > dy {
cx16.r14++
d -= dy2
}
}
} else {
repeat {
plot(cx16.r14, y1, draw)
if y1 == y2
return
y1++
d += dx2
if d > dy {
cx16.r14--
d -= dy2
}
}
}
}
}
sub circle(uword @zp xcenter, uword @zp ycenter, ubyte radius, bool draw) {
; Midpoint algorithm.
if radius==0
return
ubyte @zp xx = radius
ubyte @zp yy = 0
word @zp decisionOver2 = (1 as word)-xx
; R14 = internal plot X
; R15 = internal plot Y
while xx>=yy {
cx16.r14 = xcenter + xx
cx16.r15 = ycenter + yy
plot(cx16.r14, cx16.r15, draw)
cx16.r14 = xcenter - xx
plot(cx16.r14, cx16.r15, draw)
cx16.r14 = xcenter + xx
cx16.r15 = ycenter - yy
plot(cx16.r14, cx16.r15, draw)
cx16.r14 = xcenter - xx
plot(cx16.r14, cx16.r15, draw)
cx16.r14 = xcenter + yy
cx16.r15 = ycenter + xx
plot(cx16.r14, cx16.r15, draw)
cx16.r14 = xcenter - yy
plot(cx16.r14, cx16.r15, draw)
cx16.r14 = xcenter + yy
cx16.r15 = ycenter - xx
plot(cx16.r14, cx16.r15, draw)
cx16.r14 = xcenter - yy
plot(cx16.r14, cx16.r15, draw)
yy++
if decisionOver2<=0
decisionOver2 += (yy as word)*2+1
else {
xx--
decisionOver2 += (yy as word -xx)*2+1
}
}
}
sub disc(uword @zp xcenter, uword @zp ycenter, ubyte @zp radius, bool draw) {
; Midpoint algorithm, filled
if radius==0
return
ubyte @zp yy = 0
word @zp decisionOver2 = (1 as word)-radius
while radius>=yy {
horizontal_line(xcenter-radius, ycenter+yy, radius*$0002+1, draw)
horizontal_line(xcenter-radius, ycenter-yy, radius*$0002+1, draw)
horizontal_line(xcenter-yy, ycenter+radius, yy*$0002+1, draw)
horizontal_line(xcenter-yy, ycenter-radius, yy*$0002+1, draw)
yy++
if decisionOver2<=0
decisionOver2 += (yy as word)*2+1
else {
radius--
decisionOver2 += (yy as word -radius)*2+1
}
}
}
sub plot(uword @zp xx, uword @zp yy, bool @zp draw) {
ubyte[8] @shared maskbits = [128, 64, 32, 16, 8, 4, 2, 1]
if draw {
; solid color or perhaps stipple
%asm {{
lda xx
eor yy
ora dont_stipple_flag
and #1
}}
if_nz {
prepare()
%asm {{
tsb cx16.VERA_DATA0
}}
}
} else {
; only erase
prepare()
%asm {{
trb cx16.VERA_DATA0
}}
}
sub prepare() {
%asm {{
lda xx
and #7
pha ; xbits
}}
xx /= 8
if width==320
xx += yy*(320/8)
else
xx += yy*(640/8)
%asm {{
stz cx16.VERA_CTRL
stz cx16.VERA_ADDR_H
lda xx+1
sta cx16.VERA_ADDR_M
lda xx
sta cx16.VERA_ADDR_L
ply ; xbits
lda maskbits,y
}}
}
}
sub pget(uword @zp xx, uword yy) -> ubyte {
%asm {{
lda xx
and #7
pha ; xbits
}}
xx /= 8
if width==320
xx += yy*(320/8)
else
xx += yy*(640/8)
%asm {{
stz cx16.VERA_CTRL
stz cx16.VERA_ADDR_H
lda xx+1
sta cx16.VERA_ADDR_M
lda xx
sta cx16.VERA_ADDR_L
ply ; xbits
lda plot.maskbits,y
and cx16.VERA_DATA0
beq +
lda #1
+ rts
}}
}
sub fill(word @zp xx, word @zp yy, bool draw) {
; Non-recursive scanline flood fill.
; based loosely on code found here https://www.codeproject.com/Articles/6017/QuickFill-An-efficient-flood-fill-algorithm
; with the fixes applied to the seedfill_4 routine as mentioned in the comments.
const ubyte MAXDEPTH = 48
word[MAXDEPTH] @split @shared stack_xl
word[MAXDEPTH] @split @shared stack_xr
word[MAXDEPTH] @split @shared stack_y
byte[MAXDEPTH] @shared stack_dy
cx16.r12L = 0 ; stack pointer
word x1
word x2
byte dy
cx16.r10L = draw as ubyte
sub push_stack(word sxl, word sxr, word sy, byte sdy) {
if cx16.r12L==MAXDEPTH
return
cx16.r0s = sy+sdy
if cx16.r0s>=0 and cx16.r0s<=height-1 {
;; stack_xl[cx16.r12L] = sxl
;; stack_xr[cx16.r12L] = sxr
;; stack_y[cx16.r12L] = sy
;; stack_dy[cx16.r12L] = sdy
;; cx16.r12L++
%asm {{
ldy cx16.r12L
lda sxl
sta stack_xl_lsb,y
lda sxl+1
sta stack_xl_msb,y
lda sxr
sta stack_xr_lsb,y
lda sxr+1
sta stack_xr_msb,y
lda sy
sta stack_y_lsb,y
lda sy+1
sta stack_y_msb,y
ldy cx16.r12L
lda sdy
sta stack_dy,y
inc cx16.r12L
}}
}
}
sub pop_stack() {
;; cx16.r12L--
;; x1 = stack_xl[cx16.r12L]
;; x2 = stack_xr[cx16.r12L]
;; y = stack_y[cx16.r12L]
;; dy = stack_dy[cx16.r12L]
%asm {{
dec cx16.r12L
ldy cx16.r12L
lda stack_xl_lsb,y
sta x1
lda stack_xl_msb,y
sta x1+1
lda stack_xr_lsb,y
sta x2
lda stack_xr_msb,y
sta x2+1
lda stack_y_lsb,y
sta yy
lda stack_y_msb,y
sta yy+1
ldy cx16.r12L
lda stack_dy,y
sta dy
}}
yy+=dy
}
cx16.r11L = pget(xx as uword, yy as uword) ; old_color
if cx16.r11L == cx16.r10L
return
if xx<0 or xx>width-1 or yy<0 or yy>height-1
return
push_stack(xx, xx, yy, 1)
push_stack(xx, xx, yy + 1, -1)
word left = 0
while cx16.r12L {
pop_stack()
xx = x1
while xx >= 0 and pget(xx as uword, yy as uword) == cx16.r11L {
plot(xx as uword, yy as uword, cx16.r10L)
xx--
}
if xx >= x1
goto skip
left = xx + 1
if left < x1
push_stack(left, x1 - 1, yy, -dy)
xx = x1 + 1
do {
while xx <= width-1 and pget(xx as uword, yy as uword) == cx16.r11L {
plot(xx as uword, yy as uword, cx16.r10L)
xx++
}
push_stack(left, xx - 1, yy, dy)
if xx > x2 + 1
push_stack(x2 + 1, xx - 1, yy, -dy)
skip:
xx++
while xx <= x2 and pget(xx as uword, yy as uword) != cx16.r11L
xx++
left = xx
} until xx>x2
}
}
sub position(uword @zp xx, uword yy) {
if width==320
cx16.r0 = yy*(320/8)
else
cx16.r0 = yy*(640/8)
cx16.vaddr(0, cx16.r0+(xx/8), 0, 1)
}
sub position2(uword @zp xx, uword yy, bool also_port_1) {
position(xx, yy)
if also_port_1
cx16.vaddr_clone(0)
}
const ubyte charset_bank = $1
const uword charset_addr = $f000 ; in bank 1, so $1f000
sub text_charset(ubyte charset) {
; -- select the text charset to use with the text() routine
; the charset number is the same as for the cx16.screen_set_charset() ROM function.
; 1 = ISO charset, 2 = PETSCII uppercase+graphs, 3= PETSCII uppercase+lowercase.
cx16.screen_set_charset(charset, 0)
}
sub text(uword @zp xx, uword yy, bool draw, uword sctextptr) {
; -- Write some text at the given pixel position. The text string must be in screencode encoding (not petscii!).
; You must also have called text_charset() first to select and prepare the character set to use.
uword chardataptr
ubyte[8] @shared char_bitmap_bytes_left
ubyte[8] @shared char_bitmap_bytes_right
cx16.r3 = sctextptr
while @(cx16.r3) {
chardataptr = charset_addr + @(cx16.r3) * $0008
; copy the character bitmap into RAM
cx16.vaddr_autoincr(charset_bank, chardataptr, 0, 1)
%asm {{
; pre-shift the bits
lda text.xx
and #7
sta P8ZP_SCRATCH_B1
ldy #0
- lda cx16.VERA_DATA0
stz P8ZP_SCRATCH_REG
ldx P8ZP_SCRATCH_B1
cpx #0
beq +
- lsr a
ror P8ZP_SCRATCH_REG
dex
bne -
+ sta char_bitmap_bytes_left,y
lda P8ZP_SCRATCH_REG
sta char_bitmap_bytes_right,y
iny
cpy #8
bne --
}}
; left part of shifted char
position2(xx, yy, true)
set_autoincrs()
if draw {
%asm {{
ldy #0
- lda char_bitmap_bytes_left,y
ora cx16.VERA_DATA1
sta cx16.VERA_DATA0
iny
cpy #8
bne -
}}
} else {
%asm {{
ldy #0
- lda char_bitmap_bytes_left,y
eor #255
and cx16.VERA_DATA1
sta cx16.VERA_DATA0
iny
cpy #8
bne -
}}
}
; right part of shifted char
if lsb(xx) & 7 {
position2(xx+8, yy, true)
set_autoincrs()
if draw {
%asm {{
ldy #0
- lda char_bitmap_bytes_right,y
ora cx16.VERA_DATA1
sta cx16.VERA_DATA0
iny
cpy #8
bne -
}}
} else {
%asm {{
ldy #0
- lda char_bitmap_bytes_right,y
eor #255
and cx16.VERA_DATA1
sta cx16.VERA_DATA0
iny
cpy #8
bne -
}}
}
}
cx16.r3++
xx += 8
}
sub set_autoincrs() {
; set autoincrements to go to next pixel row (40 or 80 increment)
if width==320 {
cx16.VERA_CTRL = 0
cx16.VERA_ADDR_H = cx16.VERA_ADDR_H & $0f | (11<<4)
cx16.VERA_CTRL = 1
cx16.VERA_ADDR_H = cx16.VERA_ADDR_H & $0f | (11<<4)
} else {
cx16.VERA_CTRL = 0
cx16.VERA_ADDR_H = cx16.VERA_ADDR_H & $0f | (12<<4)
cx16.VERA_CTRL = 1
cx16.VERA_ADDR_H = cx16.VERA_ADDR_H & $0f | (12<<4)
}
}
}
asmsub cs_innerloop640() clobbers(Y) {
%asm {{
ldy #80
- stz cx16.VERA_DATA0
stz cx16.VERA_DATA0
stz cx16.VERA_DATA0
stz cx16.VERA_DATA0
stz cx16.VERA_DATA0
stz cx16.VERA_DATA0
stz cx16.VERA_DATA0
stz cx16.VERA_DATA0
dey
bne -
rts
}}
}
}