add monogfx lib to virtual target

compiler/res/prog8lib/math.asm

@@ -74,7 +74,7 @@ multiply_words	.proc
 ; - unrolled the two inner loops once
 ;
 ; 16 bit x 16 bit unsigned multiply, 32 bit result
-; Average cycles:
+; Average cycles: ~442 ?
 ; 93 bytes
 
 _multiplicand    = P8ZP_SCRATCH_W2   ; 2 bytes

compiler/res/prog8lib/virtual/monogfx.p8

@@ -0,0 +1,350 @@
+; Monochrome Bitmap pixel graphics routines for the Virtual Machine
+; Using the full-screen 640x480 and 320x240 screen modes, but just black/white.
+
+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
+        sys.gfx_enable(0)
+        width = 320
+        height = 240
+        clear_screen(0)
+    }
+
+    sub hires() {
+        ; enable 640*480 bitmap mode
+        sys.gfx_enable(1)
+        width = 640
+        height = 480
+        clear_screen(0)
+    }
+
+    sub textmode() {
+        ; back to normal text mode
+    }
+
+    sub clear_screen(ubyte color) {
+        stipple(false)
+        if color
+            color=255
+        sys.gfx_clear(color)
+    }
+
+    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) {
+        ; Draw a filled rectangle of the given size and color.
+        ; To fill the whole screen, use clear_screen(color) instead - it is much faster.
+        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 color = 0
+        if draw
+            color = 255
+        uword xpos
+        for xpos in xx to xx+length-1
+            plot(xpos, yy, color)
+    }
+
+    sub vertical_line(uword xx, uword yy, uword lheight, bool draw) {
+        ubyte color = 0
+        if draw
+            color = 255
+        uword ypos
+        for ypos in yy to yy+lheight-1
+            plot(xx, ypos, color)
+    }
+
+    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) {
+        if draw {
+            if dont_stipple_flag
+                sys.gfx_plot(xx, yy, 255)
+            else {
+                if (xx ^ yy)&1
+                    sys.gfx_plot(xx, yy, 255)
+                else
+                    sys.gfx_plot(xx, yy, 0)
+            }
+        }
+        else
+            sys.gfx_plot(xx, yy, 0)
+    }
+
+    sub pget(uword @zp xx, uword yy) -> ubyte {
+        return sys.gfx_getpixel(xx, yy)
+    }
+
+    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++
+            }
+        }
+        sub pop_stack() {
+            cx16.r12L--
+            x1 = stack_xl[cx16.r12L]
+            x2 = stack_xr[cx16.r12L]
+            yy = stack_y[cx16.r12L]
+            dy = stack_dy[cx16.r12L]
+            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
+                xx--
+            if x1!=xx
+                horizontal_line(xx as uword+1, yy as uword, x1-xx as uword, cx16.r10L)
+            else
+                goto skip
+
+            left = xx + 1
+            if left < x1
+                push_stack(left, x1 - 1, yy, -dy)
+            xx = x1 + 1
+
+            do {
+                cx16.r9 = xx
+                while xx <= width-1 and pget(xx as uword, yy as uword) == cx16.r11L
+                    xx++
+                if cx16.r9!=xx
+                    horizontal_line(cx16.r9, yy as uword, (xx as uword)-cx16.r9, cx16.r10L)
+
+                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 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.
+        ; TODO vm has no bitmap charset
+    }
+
+    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.
+        ; TODO vm has no bitmap charset
+    }
+}

docs/source/libraries.rst

@@ -452,8 +452,8 @@ to see what's in there.
 Information about the exposed debug registers is in the `emulator's documentation <https://github.com/X16Community/x16-emulator#debug-io-registers>`_.
 
 
-monogfx  (cx16 only)
+monogfx  (cx16 and virtual)
---------------------
+---------------------------
 Full-screen lores or hires monochrome bitmap graphics routines, available on the Cx16 machine only.
 Same interface as gfx2, but is optimized for monochrome (1 bpp) screens.
 

docs/source/todo.rst

@@ -53,10 +53,10 @@ Compiler:
 
 Libraries:
 
-- gfx2 cs_innerloop640() extend number of bytes cleared, and use vera fx cached writes
+- gfx2 cs_innerloop640() extend number of bytes cleared, and use vera fx cached writes (speed up screen clear)
 - gfx2 horizontal_line and vertical_line: use vera fx cached writes
-- port monogfx, gf2, graphics to the vm
 - use verafx transparent writes to speed up pixel plotting in gfx2 and monogfx modules (avoids read/mask/write)
+- port gfx2 to the vm?  First add colors to the vm?
 - fix the problems in atari target, and flesh out its libraries.
 - c128 target: make syslib more complete (missing kernal routines)?
 - pet32 target: make syslib more complete (missing kernal routines)?