Add DHGR slideshow

src/inc/lz4.plh

@@ -1,3 +1,8 @@
 import lz4
+    struc t_lz4header
+        word lz4magic[2]
+        byte lz4FLG
+        byte lz4BD
+    end
     predef lz4Unpack(seq, seqend, buff, buffend)
 end

src/makefile

@@ -88,6 +88,7 @@ DCGRTEST   = rel/apple/DCGRTEST\#FE1000
 DCGRSPRED  = rel/apple/DCGRSPRED\#FE1000
 DCGREASY   = rel/apple/DCGREASY\#FE1000
 DCGRRGB    = rel/apple/DCGRRGB\#FE1000
+DCGRSHOW   = rel/apple/DCGRSHOW\#FE1000
 MEMMGR     = rel/MEMMGR\#FE1000
 MEMTEST    = rel/MEMTEST\#FE1000
 FIBERTEST  = rel/FIBERTEST\#FE1000
@@ -124,7 +125,7 @@ TXTTYPE	= .TXT
 #SYSTYPE	= \#FF2000
 #TXTTYPE	= \#040000
 
-apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM802) $(PLVM03) $(PLVMJIT03) $(CMD) $(CMDJIT) $(JIT) $(JIT16) $(JITUNE) $(SOSCMD) $(SOSCMDJIT) $(PLASMAPLASM) $(CODEOPT) $(PLFORTH) $(HRFORTH) $(HR2FORTH) $(TX2FORTH) $(SEXPR) $(SMATH) $(DRAWL) $(ZIPCHIP) $(MATCHFILES) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(COPY) $(DEL) $(REN) $(CAT) $(NEWDIR) $(TYPE) $(INITSLOT) $(SOS) $(ROD) $(SIEVE) $(PRIMEGAP) $(MOUSE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(TFTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(SFM) $(SFMSPRT) $(GRAFIX) $(GFXDEMO) $(LINES) $(HGRTILE) $(HGRFONT) $(HGRSPRITE) $(HGRLIB) $(TILETEST) $(HGRTEST) $(DCGRLIB) $(GRLIB) $(DGRLIB) $(DCGRUTILS) $(GRTEST) $(DGRTEST) $(HGRTEST) $(DCGRTEST) $(DCGRSPRED) $(DCGREASY) $(DCGRRGB) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(INT32) $(INT32TEST) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(LZ4) $(LZ4CAT) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) $(CONIOTEST)
+apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM802) $(PLVM03) $(PLVMJIT03) $(CMD) $(CMDJIT) $(JIT) $(JIT16) $(JITUNE) $(SOSCMD) $(SOSCMDJIT) $(PLASMAPLASM) $(CODEOPT) $(PLFORTH) $(HRFORTH) $(HR2FORTH) $(TX2FORTH) $(SEXPR) $(SMATH) $(DRAWL) $(ZIPCHIP) $(MATCHFILES) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(COPY) $(DEL) $(REN) $(CAT) $(NEWDIR) $(TYPE) $(INITSLOT) $(SOS) $(ROD) $(SIEVE) $(PRIMEGAP) $(MOUSE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(TFTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(SFM) $(SFMSPRT) $(GRAFIX) $(GFXDEMO) $(LINES) $(HGRTILE) $(HGRFONT) $(HGRSPRITE) $(HGRLIB) $(TILETEST) $(HGRTEST) $(DCGRLIB) $(GRLIB) $(DGRLIB) $(DCGRUTILS) $(GRTEST) $(DGRTEST) $(HGRTEST) $(DCGRTEST) $(DCGRSPRED) $(DCGREASY) $(DCGRRGB) $(DCGRSHOW) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(INT32) $(INT32TEST) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(LZ4) $(LZ4CAT) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) $(CONIOTEST)
 
 	-rm vmsrc/plvmzp.inc
 
@@ -542,6 +543,10 @@ $(DCGREASY): utilsrc/apple/dcgreasy.pla $(DCGRLIB) $(DCGRUTILS) $(PLASM)
 	./$(PLASM) -AMOW utilsrc/apple/dcgreasy.pla
 	acme --setpc 4094 -o $(DCGREASY) utilsrc/apple/dcgreasy.a
 
+$(DCGRSHOW): utilsrc/apple/dcgrshow.pla $(DCGRLIB) $(DCGRUTILS) $(PLASM)
+	./$(PLASM) -AMOW utilsrc/apple/dcgrshow.pla
+	acme --setpc 4094 -o $(DCGRSHOW) utilsrc/apple/dcgrshow.a
+
 $(DCGRRGB): samplesrc/dcgrrgb.pla $(DCGRLIB) $(DCGRUTILS) $(PLASM)
 	./$(PLASM) -AMOW samplesrc/dcgrrgb.pla
 	acme --setpc 4094 -o $(DCGRRGB) samplesrc/dcgrrgb.a

src/mkrel

@@ -110,12 +110,13 @@ cp rel/apple/GRTEST#FE1000   prodos/demos/apple2/GRTEST.REL
 cp rel/apple/DGRTEST#FE1000  prodos/demos/apple2/DGRTEST.REL
 
 mkdir prodos/demos/apple2/dcgr
+cp rel/apple/DCGRRGB#FE1000  prodos/demos/apple2/dcgr/DCGRRGB.REL
+cp rel/apple/DCGRSHOW#FE1000 prodos/demos/apple2/dcgr/DCGRSHOW.REL
 cp rel/apple/DCGRTEST#FE1000 prodos/demos/apple2/dcgr/DCGRTEST.REL
 cp samplesrc/ENT.*           prodos/demos/apple2/dcgr
 cp samplesrc/SPLASH.DHGR.BIN prodos/demos/apple2/dcgr
 cp samplesrc/RACECAR.RGB.BIN prodos/demos/apple2/dcgr
 cp samplesrc/RACECAR.LZ4.BIN prodos/demos/apple2/dcgr
-cp rel/apple/DCGRRGB#FE1000  prodos/demos/apple2/dcgr/DCGRRGB.REL
 
 mkdir prodos/demos/apple2/spiders
 cp rel/apple/SFM#FE1000     prodos/demos/apple2/spiders/SFM.REL

src/samplesrc/dcgrrgb.pla

@@ -11,7 +11,7 @@ const GRN = 1
 const BLU = 2
 const RGB_MAX = 63
 const ERR_MAX = 32
-const ERR_DIV = 2
+byte errDiv = 2
 
 byte[] ntscChroma
 // Imperical 0-255       R    G    B
@@ -72,9 +72,9 @@ def rgbPix(r, g, b, x, y)#0
 
   // Error propogation
   errptr = rgbErr + x * 3 * 2
-  r = r + errptr=>[RED] / ERR_DIV
+  r = r + errptr=>[RED] / errDiv
-  g = g + errptr=>[GRN] / ERR_DIV
+  g = g + errptr=>[GRN] / errDiv
-  b = b + errptr=>[BLU] / ERR_DIV
+  b = b + errptr=>[BLU] / errDiv
   //r = min(RGB_MAX, max(-RGB_MAX, r))
   //g = min(RGB_MAX, max(-RGB_MAX, g))
   //b = min(RGB_MAX, max(-RGB_MAX, b))
@@ -135,9 +135,15 @@ end
 def rgbInit#0
   var i
 
-  for i = 1 to 255
+  if not gamma
-    gamma[i] = (i / 4) * (i / 4) / 63
+    for i = 0 to 255
-  next
+      gamma[i] = (i / 4) * (i / 4) / 63
+    next
+  else
+    for i = 0 to 255
+      gamma[i] = i / 4
+    next
+  fin
   dcgrMode(0)
   // Init error propogation array
   rgbErr = heapalloc(561 * 3 * 2)
@@ -148,6 +154,7 @@ def rgbInit#0
 end
 
 def rgbExit#0
+  heaprelease(rgbErr)
   dcgrMode(-1)
 end
 
@@ -222,16 +229,30 @@ end
 
 arg = argNext(argFirst)
 if ^arg
-  if ^(arg + 1) == '-'
+  while ^(arg + 1) == '-'
-    if toupper(^(arg + 2)) == 'T'
+    when toupper(^(arg + 2))
-      rgbTest
+      is 'T' // Run color test
-    fin
+        rgbTest
+        break
+      is 'L' // Use linear RGB transfer instead of gama
+        gamma = 1
+        break
+      is 'E' // Set error divisor
+        if ^arg > 2
+          errDiv = ^(arg + 3) - '0'
+          if ^arg > 3
+            errDiv = errDiv * 10 + ^(arg + 4) - '0'
+          fin
+        fin
+        errDiv = max(1, min(63, errDiv))
+        break
+    wend
     arg = argNext(arg)
-  fin
+  loop
   if ^arg
     rgbImportExport(arg, argNext(arg))
   fin
   return 0
 fin
-puts("Usage: DCGRRGB [-T] RGBFILE [DHGRFILE]\n")
+puts("Usage: DCGRRGB [-T] [-L] [-E##] RGBFILE [DHGRFILE]\n")
 done

src/utilsrc/apple/dcgrshow.pla

@@ -8,27 +8,49 @@ include "inc/lz4.plh"
 
 sysflags resxtxt1|reshgr1|resxhgr1|reshgr2
 
-def lz4ReadBlock(flags, dstbuf)#2
+const page1m = $C054
-    word size[2], block, len
+const page1x = $C055
 
-    len = fileio:read(inref, @size, 4)
+byte dolz4, quit
+char[64] wildfile
+var arg, srcfilelist, srcfileptr, srccnt
+var entrylist, entrycnt
+
+//
+// Copy string with upper case conversion
+//
+def struprcpy(dst, src)#0
+    byte i
+
+    if ^src
+        for i = 1 to ^src
+            dst->[i] = toupper(src->[i])
+        next
+    fin
+    ^dst = ^src
+end
+
+def lz4ReadBlock(ref, flags, dstbuf)#1
+    word size[2], block, data, len
+
+    len = fileio:read(ref, @size, 4)
     if len <> 4 or size[0] == 0 or size[1] & $7FFF
-        return NULL, 0
+        return 0
     fin
     block = dstbuf
     if block
-        len = fileio:read(inref, block, size[0])
+        len = fileio:read(ref, block, size[0])
         if len <> size[0]
-            return NULL, 0
+            return 0
         fin
     else
-        return NULL, 0
+        return 0
     fin
     if size[1] & $8000
         //
         // Uncompressed block
         //
-        data = block
+        //data = dstbuf
     else
         //
         // Decompress block
@@ -36,47 +58,123 @@ def lz4ReadBlock(flags, dstbuf)#2
         len  = heapavail - 256 // Allocate almost entire heap to decompress into
         data = heapalloc(len)
         if data
-            len = lz4Unpack(block, block + size[0], data, data + len)
+            len = lz4Unpack(dstbuf, dstbuf + size[0], data, data + len)
-            memcpy(block, data, len)
+            memcpy(dstbuf, data, len)
-            data = block
         else
             len = 0
         fin
     fin
     if flags & $10 // Block Checksum
-        fileio:read(inref, @size, 4)
+        fileio:read(ref, @size, 4)
     fin
     return len
 end
-def lz4ReadFrame#0
+def lz4ReadFrame(filestr)#0
     word data, len
-    byte header[t_header], opt
+    byte ref, header[t_lz4header], opt
 
-    fileio:read(inref, @header, t_header)
+    ref = fileio:open(filestr)
-    if header:magic[1] <> $184D or header:magic[0] <> $2204
+    if not ref; return; fin
+    fileio:read(ref, @header, t_lz4header)
+    if header:lz4magic[1] <> $184D or header:lz4magic[0] <> $2204
         puts("Not LZ4 file.\n")
         return
     fin
-    if header.FLG & $C0 <> $40
+    if header.lz4FLG & $C0 <> $40
         puts("Wrong LZ4 version.\n")
         return
     fin
-    if header.BD & $70 <> $40
+    if header.lz4BD & $70 <> $40
         puts("Not 64K block size.\n")
         return
     fin
     opt = 1
-    if header.FLG & $08 // Content Size
+    if header.lz4FLG & $08 // Content Size
         opt = opt + 8
     fin
-    if header.FLG & $01 // Dictionary ID
+    if header.lz4FLG & $01 // Dictionary ID
         opt = opt + 4
     fin
-    fileio:read(inref, heapmark, opt) // Read rest of header and throw away
+    fileio:read(ref, heapmark, opt) // Read rest of header and throw away
     repeat
-        len = lz4ReadBlock(header.FLG, $2000)
+        len = lz4ReadBlock(ref, header.lz4FLG, $2000)
     until len == 0
-    if header.FLG & $04 // Content Checksun
+    //if header.lz4FLG & $04 // Content Checksun
-        fileio:read(inref, heapmark, 4)
+    //    fileio:read(ref, heapmark, 4)
+    //fin
+    fileio:close(ref)
+end
+
+def screenShow(filestr)#0
+    if dolz4
+        ^page1x // Decompress AUX+MAIN bytes
+        lz4ReadFrame(filestr)
+        ^page1m // Copy MAIN half to screen memory
+        memcpy($2000, $4000, $2000)
+    else
+        screenRead(filestr)
     fin
 end
+
+def delay_getkey#1
+    var busywait
+
+    for busywait = 0 to 10000
+        if ^$C000 > 127
+            return ^$C010 == $83
+        fin
+    next
+    return FALSE
+end
+
+arg = argNext(argFirst)
+while ^arg and ^(arg + 1) == '-'
+    //
+    // Process flags
+    //
+    when toupper(^(arg + 2))
+        is 'Z' // decompress screens
+            dolz4 = TRUE
+            break
+    wend
+    arg = argNext(arg)
+loop
+while ^arg
+    //
+    // Add to source list
+    //
+    struprcpy(@wildfile, arg)
+    entrylist, entrycnt = matchList(NULL, @wildfile)
+    if not entrylist
+        puts(arg); puts(" ???\n")
+    else
+        if not srcfilelist
+            srcfilelist = entrylist
+        fin
+        srccnt = srccnt + entrycnt
+    fin
+    arg = argNext(arg)
+loop
+if srccnt
+    dcgrMode(0)
+    if srccnt == 1
+        screenShow(srcfilelist)
+        getc
+    else
+        repeat
+            entrylist = srcfilelist
+            entrycnt  = srccnt
+            while entrycnt
+                screenShow(entrylist)
+                entrylist = entrylist + t_fileentry
+                entrycnt--
+                quit = delay_getkey
+                if quit; break; fin
+            loop
+        until quit
+    fin
+    dcgrMode(-1)
+    return 0
+fin
+puts("Usage: DCGRSHOW [-Z] <FILES>+\n")
+done

src/utilsrc/lz4cat.pla

@@ -4,11 +4,6 @@ include "inc/fileio.plh"
 include "inc/lz4.plh"
 
 const ERASE_DST = 1
-struc t_header
-    word magic[2]
-    byte FLG
-    byte BD
-end
 word arg
 byte ioflags
 byte inref, outref
@@ -59,31 +54,31 @@ def lz4ReadBlock(flags)#2
 end
 def lz4ReadFrame#0
     word data, len
-    byte header[t_header], opt
+    byte header[t_lz4header], opt
 
-    fileio:read(inref, @header, t_header)
+    fileio:read(inref, @header, t_lz4header)
-    if header:magic[1] <> $184D or header:magic[0] <> $2204
+    if header:lz4magic[1] <> $184D or header:lz4magic[0] <> $2204
         puts("Not LZ4 file.\n")
         return
     fin
-    if header.FLG & $C0 <> $40
+    if header.lz4FLG & $C0 <> $40
         puts("Wrong LZ4 version.\n")
         return
     fin
-    if header.BD & $70 <> $40
+    if header.lz4BD & $70 <> $40
         puts("Not 64K block size.\n")
         return
     fin
     opt = 1
-    if header.FLG & $08 // Content Size
+    if header.lz4FLG & $08 // Content Size
         opt = opt + 8
     fin
-    if header.FLG & $01 // Dictionary ID
+    if header.lz4FLG & $01 // Dictionary ID
         opt = opt + 4
     fin
     fileio:read(inref, heapmark, opt) // Read rest of header and throw away
     repeat
-        data, len = lz4ReadBlock(header.FLG)
+        data, len = lz4ReadBlock(header.lz4FLG)
         if len
             if outref
                 fileio:write(outref, data, len)
@@ -97,7 +92,7 @@ def lz4ReadFrame#0
             heaprelease(data)
         fin
     until not data
-    if header.FLG & $04 // Content Checksun
+    if header.lz4FLG & $04 // Content Checksun
         fileio:read(inref, heapmark, 4)
     fin
 end