Add ability to run all in memory for PLVM

dschmenk · Dec 15, 2024 · 376feac · 376feac
1 parent 512c307
commit 376feac
Show file tree

Hide file tree

Showing 3 changed files with 114 additions and 45 deletions.
diff --git a/src/dhgr.tk/libs/dhgrlib.pla b/src/dhgr.tk/libs/dhgrlib.pla
@@ -622,7 +622,7 @@ asm     _dcgrBitmapScrB
 +       INC     ESTKH-1,X   ; X++
         LDY     ESTKH-1,X   ; CURRENT X COORD
         CPY     TMPH        ; AT RIGHT EDGE?
-        BCS     NXTBITS
+        BEQ     NXTBITS
         DEC     TMPL        ; BIT COUNT
         BNE     BITSCR
         BEQ     BITS8
@@ -684,10 +684,9 @@ asm     _dcgrPixmapScrC
 PIXSCRH INC     TMPL
         LDA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     ++
+        BEQ     ++
         CMP     #140        ; OFF SCREEN?
         BCS     +
-        LDY     #$00
         LDA     (SRC),Y     ; HI NIBBLE SRC PIXEL
         LSR
         LSR
@@ -710,7 +709,7 @@ asm     _dcgrPixmapScrE
         BNE     +
         INC     SRCH
 +       CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCC     PIXSCRL
+        BNE     PIXSCRL
 NXTPIXS DEC     ESTKL-4,X   ; HEIGHT
         BNE     YPIXS       ; NEXT ROW
 RETPIXS RTS
@@ -777,7 +776,7 @@ asm     _dcgrRlemapScrC
 RLESCRH INC     TMPL
         LDA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     NXTRLES
+        BEQ     NXTRLES
         DEC     TMPH        ; RUN LENGTH
         BEQ     RUNLENS
         CMP     #140        ; OFF SCREEN?
@@ -801,7 +800,7 @@ asm     _dcgrRlemapScrE
 +       INC     TMPL
         LDA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     NXTRLES
+        BEQ     NXTRLES
         DEC     TMPH        ; RUN LENGTH
         BNE     RLESCRL
         BEQ     RUNLENS
@@ -815,7 +814,7 @@ SKPRUNS LDY     #$00
         ADC     TMPL
         STA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     NXTRLES
+        BEQ     NXTRLES
         BCC     RUNLENS
 end
 //
@@ -1118,7 +1117,7 @@ asm     _dcgrBitmapMemA
 +       INC     ESTKH-1,X   ; X++
         LDA     ESTKH-1,X   ; CURRENT X COORD
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     NXTBITM
+        BEQ     NXTBITM
         DEC     ESTKH-2,X   ; BIT COUNT--
         BNE     BITMEM
         BEQ     BITM8
@@ -1198,7 +1197,7 @@ asm     _dcgrPixmapMemC
 PIXMEMH INC     TMPL
         LDA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     ++          ; NEXT ROW
+        BEQ     ++          ; NEXT ROW
         CMP     ESTKL-6,X   ; OUT OF DST BOUNDS?
         BCS     +
         LDA     (SRC),Y     ; HI NIBBLE SRC PIXEL
@@ -1224,7 +1223,7 @@ asm     _dcgrPixmapMemE
         BNE     +
         INC     SRCH
 +       CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCC     PIXMEML
+        BNE     PIXMEML
 NXTPIXM CLC
         LDA     ESTKL-9,X   ; SPAN
         ADC     DSTL
@@ -1276,7 +1275,7 @@ SKPRUNM LDY     #$00
         ADC     TMPL
         STA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCC     RUNLENM
+        BNE     RUNLENM
         ;BCS     NXTRLEM
 NXTRLEM CLC
         LDA     ESTKL-9,X   ; SPAN
@@ -1327,7 +1326,7 @@ asm     _dcgrRlemapMemC
 RLEMEMH INC     TMPL
         LDA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     NXTRLEM     ; NEXT
+        BEQ     NXTRLEM     ; NEXT
         DEC     ESTKH-4,X   ; RUN LENGTH
         BEQ     RUNLENM
         CMP     ESTKL-6,X   ; OUT OF DST BOUNDS?
@@ -1352,7 +1351,7 @@ asm     _dcgrRlemapMemE
 +       INC     TMPL
         LDA     TMPL
         CMP     ESTKH-3,X   ; AT RIGHT EDGE?
-        BCS     NXTRLEM
+        BEQ     NXTRLEM
         DEC     ESTKH-4,X   ; RUN LENGTH
         BNE     RLEMEML
         BEQ     RUNLENM
@@ -2348,6 +2347,15 @@ export def dcgrGetPixel(x, y)#1
 end
 export def dhgrMode(mode)#1
     if mode >= 0
+        //
+        // Make sure we are a 128K //e or //c
+        //
+        if MACHID & $F0 <> $B0
+            puts("\n128K required for double color graphics.\n")
+            ^$C010
+            while ^$C000 < 128; loop
+            return 0
+        fin
         ^page1m
         ^showfull
         ^showhires
@@ -2372,15 +2380,6 @@ export def dhgrMode(mode)#1
     return mode
 end
 //
-// Make sure we are a 128K //e or //c
-//
-if MACHID & $F0 <> $B0
-    puts("\n128K required for double color graphics.\n")
-    ^$C010
-    while ^$C000 < 128; loop
-    return -1
-fin
-//
 // Assembly symbol fixups
 //
 _dcgrColorA:1        = @auxclrsl

diff --git a/src/dhgr.tk/libs/dhgrutils.pla b/src/dhgr.tk/libs/dhgrutils.pla
@@ -65,7 +65,7 @@ var fontWidth = 7
 export def dhgrAllocBl7Mem(w, h)#2
     word memblk, span
 
-    span   = (w+13)/7 << 2
+    span   = (w+13)/14 << 3
     memblk = heapalloc(span * h)
     return memblk, span
 end

diff --git a/src/dhgr.tk/utils/dhgrrgb.pla b/src/dhgr.tk/utils/dhgrrgb.pla
@@ -28,13 +28,39 @@ var = 29451, 29697, 29935, 30163, 30381, 30591, 30791, 30982
 var = 31164, 31336, 31498, 31651, 31794, 31928, 32051, 32165
 var = 32270, 32364, 32449, 32523, 32588, 32643, 32688, 32723
 var = 32748, 32763, 32767
+word hgrScan[] = $0000,$0400,$0800,$0C00,$1000,$1400,$1800,$1C00
+word           = $0080,$0480,$0880,$0C80,$1080,$1480,$1880,$1C80
+word           = $0100,$0500,$0900,$0D00,$1100,$1500,$1900,$1D00
+word           = $0180,$0580,$0980,$0D80,$1180,$1580,$1980,$1D80
+word           = $0200,$0600,$0A00,$0E00,$1200,$1600,$1A00,$1E00
+word           = $0280,$0680,$0A80,$0E80,$1280,$1680,$1A80,$1E80
+word           = $0300,$0700,$0B00,$0F00,$1300,$1700,$1B00,$1F00
+word           = $0380,$0780,$0B80,$0F80,$1380,$1780,$1B80,$1F80
+word           = $0028,$0428,$0828,$0C28,$1028,$1428,$1828,$1C28
+word           = $00A8,$04A8,$08A8,$0CA8,$10A8,$14A8,$18A8,$1CA8
+word           = $0128,$0528,$0928,$0D28,$1128,$1528,$1928,$1D28
+word           = $01A8,$05A8,$09A8,$0DA8,$11A8,$15A8,$19A8,$1DA8
+word           = $0228,$0628,$0A28,$0E28,$1228,$1628,$1A28,$1E28
+word           = $02A8,$06A8,$0AA8,$0EA8,$12A8,$16A8,$1AA8,$1EA8
+word           = $0328,$0728,$0B28,$0F28,$1328,$1728,$1B28,$1F28
+word           = $03A8,$07A8,$0BA8,$0FA8,$13A8,$17A8,$1BA8,$1FA8
+word           = $0050,$0450,$0850,$0C50,$1050,$1450,$1850,$1C50
+word           = $00D0,$04D0,$08D0,$0CD0,$10D0,$14D0,$18D0,$1CD0
+word           = $0150,$0550,$0950,$0D50,$1150,$1550,$1950,$1D50
+word           = $01D0,$05D0,$09D0,$0DD0,$11D0,$15D0,$19D0,$1DD0
+word           = $0250,$0650,$0A50,$0E50,$1250,$1650,$1A50,$1E50
+word           = $02D0,$06D0,$0AD0,$0ED0,$12D0,$16D0,$1AD0,$1ED0
+word           = $0350,$0750,$0B50,$0F50,$1350,$1750,$1B50,$1F50
+word           = $03D0,$07D0,$0BD0,$0FD0,$13D0,$17D0,$1BD0,$1FD0
+
+byte memmode = FALSE // Memory or video surface
+var surfMem, surfSpan
 var[12] ntscChroma
 var[12] ntscCycle
 byte[256] gamma = 0, 2, 0 // Gamma correction
 var brightness = 0
 var contrast = 0
 var tint = 20
-var greyChroma = GREY_CHROMA
 byte errDiv = 3
 var rgbErr // Running color error array
 var arg
@@ -264,18 +290,22 @@ def rgbInit#0
       gamma[i] = max(0, min(255, gamma[i] + brightness))
     next
   fin
-  dhgrMode(DHGR_COLOR_MODE)
-  // Init error propogation array
-  rgbErr = heapalloc(563 * 3 * 2)
-  memset(rgberr, 0, 563 * 3 * 2)
-  rgberr=>[RED] = -1
-  rgberr=>[GRN] = -1
-  rgberr=>[BLU] = -1
+  if memmode
+    surfMem, surfSpan = dhgrAllocBl7Mem(SCR_WIDTH, SCR_HEIGHT)
+    dhgrSurfMem(OP_XOR, SCR_HEIGHT, surfMem, surfSpan)
+    dhgrOp(OP_SRC) // Force op recalc
+    dcgrColor(CLR_BLACK)
+    dhgrClearBl7(0, 0, surfSpan >> 2, SCR_HEIGHT)
+  else
+    dhgrMode(DHGR_COLOR_MODE)
+  fin
 end
 
 def rgbExit#0
   heaprelease(rgbErr)
-  dhgrMode(DHGR_TEXT_MODE)
+  if not memmode
+    dhgrMode(DHGR_TEXT_MODE)
+  fin
 end
 
 def rgbImportExport(rgbfile, dhgrfile)#0
@@ -285,13 +315,19 @@ def rgbImportExport(rgbfile, dhgrfile)#0
 
   refnum = fileio:open(rgbfile)
   if refnum
+    rgbInit
     rgbScanline = heapalloc(563 * 3)
-    memset(rgbScanline, 0, 563 * 3)
-    if rgbScanline
-      rgbInit
+    rgbErr      = heapalloc(563 * 3 * 2)
+    if rgbErr and rgbScanline
+      // Init error propogation array
+      memset(rgberr, 0, 563 * 3 * 2)
+      rgberr=>[RED] = -1
+      rgberr=>[GRN] = -1
+      rgberr=>[BLU] = -1
+      memset(rgbScanline, 0, 563 * 3)
       for j = 0 to 191
         fileio:read(refnum, rgbScanline,  560 * 3)
-        memset(@ntscCycle, greyChroma, 24) // Reset chroma cycle
+        memset(@ntscCycle, GREY_CHROMA, 24) // Reset chroma cycle
         rgbptr = rgbScanline
         errptr = rgbErr
         for i = 0 to 559
@@ -307,23 +343,60 @@ def rgbImportExport(rgbfile, dhgrfile)#0
               dhgrOp(OP_SRC)
               dcgrColor(CLR_GREY2)
               dcgrPixel(i >> 2, j)
-              memset(@ntscCycle, greyChroma, 24) // Grey chroma cycle
+              memset(@ntscCycle, GREY_CHROMA, 24) // Grey chroma cycle
             elsif chromabits == $05
-              memset(@ntscCycle, greyChroma, 24) // Grey chroma cycle
+              memset(@ntscCycle, GREY_CHROMA, 24) // Grey chroma cycle
             fin
           fin
           rgbptr = rgbptr + 3
           errptr = errptr + 3 * 2
         next
+        if memmode; putc('.'); fin
         if ^$C000 == $83
           break
         fin
       next
       fileio:close(refnum)
       if ^dhgrfile
-        screenWrite(dhgrfile)
+        if memmode
+          heaprelease(rgbScanline)
+          if MACHID & $F0 <> $B0
+            // Use allocated buffer on non 128K //e
+            rgbScanline = heapalloc($2000)
+          else
+            // Use HGR memory (already reserved) on 128K //e
+            rgbScanline = $2000
+          fin
+          if rgbScanline
+            memset(rgbScanline, 0, $2000)
+            fileio:destroy(dhgrfile)
+            fileio:create(dhgrfile, $06, $2000)
+            refnum = fileio:open(dhgrfile)
+            if refnum
+              // Reorder scanlines into HGR format
+              rgbptr = surfMem
+              for i = 0 to SCR_HEIGHT-1
+                memcpy(rgbScanline+hgrScan[i], rgbptr, 40)
+                rgbptr = rgbptr + surfSpan
+              next
+              // Write AUX bytes
+              fileio:write(refnum, rgbScanline, $2000)
+              rgbptr = surfMem + surfSpan / 2
+              for i = 0 to SCR_HEIGHT-1
+                memcpy(rgbScanline+hgrScan[i], rgbptr, 40)
+                rgbptr = rgbptr + surfSpan
+              next
+              // Write MAIN bytes
+              fileio:write(refnum, rgbScanline, $2000)
+              fileio:close(refnum)
+            fin
+            putln
+          fin
+        else
+          screenWrite(dhgrfile)
+        fin
       fin
-      getc
+      if not memmode; getc; fin
       rgbExit
     fin
   else
@@ -384,11 +457,8 @@ if ^arg
           gamma[1] = atoi(arg + 2)
         fin
         break
-      is 'N' // Set neutral chroma value
-        if ^arg > 2
-          ^(arg + 2) = ^arg - 2
-          greyChroma = atoi(arg + 2)
-        fin
+      is 'M' // Memory mode - no video output
+        memmode = TRUE
         break
       is 'T' // Adjust tint
         if ^arg > 2