Screen Compressor

Area:    Quik_Bas
  Msg:    #701
 Date:    06-18-92 06:56 (Public) 
 From:    Steve Gartrell           
 To:      All                      
 Subject: Screen Compressor        

'Sometimes I'm sort of dense, especially when the subject
'is fairly technical, and I don't have the time to focus
'on it.  Such was my experience with Rich Geldreich's
'excellent example of Huffman compression used in saving
'screen 13 graphics.  I got frustrated, and wrote my own
'compression program instead.  Amusingly, it runs significantly
'faster than the Huffman routine, while paying around a
'10% penalty in compressed size in screen 13.  Both a screen
'13 version and a screen 12 version are included.  I have
'seen the 307,000 pixels involved in screen 12 compressed to
'roughly 31,000 bytes; an equivalent GET/BSAVE of all four
'bitplanes would yield over 1.2 MBytes of files.  This is
'all native QB source code => it could be made faster yet.
'How does it work?  The trick is the likelihood that at
'least some pixels adjacent to each other on the same
'row or column, dependent upon screen mode, will be the
'same color.  In 16 color modes, you need 4 bits to store
'any pixel's color.  QB/PDS happen to have 16 bits available
'in their smallest numeric data type.  In 16 color modes,
'that means that by left-shifting the color bits, you can
'use the lower bits to count the number of adjacent pixels
'of the same color.  Since 640 pixels use only through the
'10th least significant bit, you can describe all of the
'colors of an entire row, assuming they are the _same_ color,
'in one integer.  Thus, you can conceivably describe a mode
'12 screen that was blank using just 480 integers, or 960
'bytes.  In screen 13, it takes 8 bits to describe a color.
'This left me with just eight bits for pixel counting; thus
'the vertical (by column) count as 200 uses through the 8th
'least significant bit.  Of course, I had to figure out some
'contortions to use the 16th bit, since QB/PDS insists on
'signed integers.  A caveat; in 16 bit modes, you normally
'could pack a 16-bit integer with 4 pixel colors, thus any
'screen that rarely sees 4 same color pixels adjacent could
'conceivably be stored inefficiently.  Likewise, two pixels
'could be stored in an integer in mode 12, requiring the
'appearance of two sequential same color bits to maintain
'storage parity.
'
'Do use the PDS/QB /ah switch before loading....And do
'leave my name in the source, and credit me if you are
'going to make money from it!!!...<g>....|-}

DEFINT A-Z
DECLARE SUB FourBits ()
CONST BufSize% = 32766
CONST MaxedOut% = 32767
CONST C$ = "Created 06/17/92 by Steve Gartrell.  No rights reserved."
SCREEN 13, , 0, 0
REDIM SHARED FileBuffer%(1 TO 32000)

FourBits

SCREEN 13
'make some graphics-borrowed from Rich Geldreich!!!
FOR A = 1 TO 400
   RANDOMIZE TIMER
   IF RND > .05 THEN
       LINE -(RND * 320, RND * 200), RND * 255
   ELSE
       LINE -(RND * 320, RND * 200), RND * 255, BF
   END IF
NEXT

COLOR 15
LOCATE 25, 1: PRINT "320 x 200";

filenum% = FREEFILE
OPEN "256PRESS.GRF" FOR BINARY AS filenum%
IF LOF(filenum%) <> 0 THEN
   CLOSE filenum%
   KILL "256PRESS.GRF"
ELSE
   CLOSE filenum%
END IF

cell% = 1
ByteCnt& = 1

FOR x% = 0 TO 319
   CurColorPix% = POINT(x%, 0)
   ColorWord& = CurColorPix% * &H100&
   FOR y% = 0 TO 199
      ThisPixColor% = POINT(x%, y%)
      PRESET (x%, y%), 0
      IF ThisPixColor% = CurColorPix% THEN
         ColorWord& = ColorWord& + 1
      ELSE
         IF ColorWord& > 32767 THEN
             ColorWord& = ((-ColorWord& - 1) XOR &HFFFFFFFF) - 65536
         END IF
         FileBuffer%(cell%) = CINT(ColorWord&)
         cell% = cell% + 1
         CurColorPix% = ThisPixColor%
         ColorWord& = CurColorPix% * &H100& + 1&
      END IF
   NEXT
   IF ColorWord& > 32767 THEN
       ColorWord& = ((-ColorWord& - 1) XOR &HFFFFFFFF) - 65536
   END IF
   FileBuffer%(cell%) = CINT(ColorWord&)
   cell% = cell% + 1
NEXT

cell& = cell% * 2&
DEF SEG = VARSEG(FileBuffer%(1))
BSAVE "256PRESS.GRF", VARPTR(FileBuffer%(1)), cell&
DEF SEG

CLOSE #filenum%
BEEP: BEEP: BEEP

LOCATE 9, 1
PRINT "Screen reduced to "; LTRIM$(STR$(cell&)); " bytes.";
LOCATE 10, 1: PRINT "Press any key to decompress.";
DO: LOOP UNTIL INKEY$ <> ""

filenum% = FREEFILE

OPEN "256PRESS.GRF" FOR BINARY AS filenum%
cell% = LOF(filenum%) \ 2
CLOSE filenum%

REDIM FileBuffer%(1 TO cell%)

DEF SEG = VARSEG(FileBuffer%(1))
BLOAD "256PRESS.GRF", VARPTR(FileBuffer%(1))
DEF SEG

CLS

ByteCnt& = 1
BitCnt% = 0
x% = 0
FOR cnt% = 1 TO cell%
   ColorWord% = FileBuffer%(cnt%)
   IF ColorWord% < 0 THEN
       ColorWord& = ABS(((CLNG(ColorWord%) + 65536) XOR &HFFFF) + 1)
   ELSE
       ColorWord& = CLNG(ColorWord%)
   END IF
   ByteCnt& = ByteCnt& + 2
   PixCnt% = ColorWord& MOD &H100
   PixColor% = ColorWord& \ &H100
   COLOR PixColor%
   FOR ThisPix% = BitCnt% TO (BitCnt% + PixCnt%) - 1
      PSET (x%, ThisPix%)
   NEXT
   BitCnt% = BitCnt% + PixCnt%
   IF ThisPix% = 200 THEN
      BitCnt% = 0
      x% = x% + 1
      IF x% = 320 THEN
         EXIT FOR
      END IF
   END IF
NEXT

BEEP: BEEP: BEEP

DO: LOOP UNTIL INKEY$ <> ""
SCREEN 0
WIDTH 80
COLOR 7, 0
END

SUB FourBits

REDIM FileBuffer%(1 TO BufSize%)

SCREEN 12
'make some graphics-borrowed from Rich Geldreich!
FOR A = 1 TO 400
   RANDOMIZE TIMER
   IF RND > .05 THEN
       LINE -(RND * 640, RND * 480), RND * 255 MOD 16
   ELSE
       LINE -(RND * 640, RND * 480), RND * 255 MOD 16, BF
   END IF
NEXT

COLOR 15
LOCATE 30, 1: PRINT "640 x 480";

filenum% = FREEFILE
OPEN "16PRESS.GRF" FOR BINARY AS filenum%
IF LOF(filenum%) <> 0 THEN
   CLOSE filenum%
   KILL "16PRESS.GRF"
   filenum% = FREEFILE
   OPEN "16PRESS.GRF" FOR BINARY AS filenum%
END IF

MaxedFlag% = 0
ByteCnt& = 1
cell% = 1

FOR y% = 0 TO 479
   CurColorPix% = POINT(0, y%)
-end-