'=========================================================================== ' Subject: SCREEN COMPRESSION Date: 12/26/92 (00:00) ' Author: Rich Geldreich Code: PDS, VBDOS ' Keys: SCREEN,COMPRESSION Packet: GRAPHICS.ABC '=========================================================================== 'SCREEN 13 (320x200x256) Screen Compressor (SP1.BAS) 'Public Domain By Rich Geldreich, December 26, 1992 'Anyone may use this program in anything they want, as long as the 'original author(me, duh) is given credit where credit is due... 'Thanks. I'd appreciate a little cash on the side if you make any 'money off a product that uses this program... :-) If you make any 'neat modifications/optimizations to this program or the ASM decoder, 'I would really like to seem them! 'Description: ' This simple SCREEN 13 compression program uses an LZ77 variant 'to compress SCREEN 13 images. A FAST assembly subroutine is used to 'decompress the image back to the screen. The compression should 'always beat PCX, and should come fairly close or beat out GIF under 'most cases. ' ' The assembly decompressor's speed is several magnitudes faster 'than the quickest GIF decoder I've seen, VPIC 5.1. (Look how simple 'it is and you'll know why!) BTW- The output stage of this program 'was optimized for decoding speed, not for compression. Several 'optimizations could be added to increase this program's compression 'performance, such as entropy encoding on the distance & length 'tokens(which would slow the decoder down immensely), increasing the 'sizes of the sliding dictionary and look ahead buffers, and further 'optimizing the non-greedy aspect of this LZ77 implementation to 'choose the best character/match combinations to store in the output 'stream. ' ' The assembly subroutine is for 286's and above, only. This 'program does NOT work under QuickBASIC, only PDS and VB/DOS because 'of the use of BYVAL. ' ' Any questions, cash/and or death threats call me at '(609)-742-8752 2:30pm - 11:30pm eastern time or send a self 'addressed stamped evelope (SASE) to: ' ' Rich Geldreich ' 410 Market St. ' Gloucester City, NJ 08030 ' 'Possible uses of this program: Use a GIF or PCX converter(or SHELL 'out to VPIC) to display the image you want to use in your 'application on SCREEN 13. Then encode the image with this program. 'You can then instantly recall the image using the fast Decom13 'assembly language subroutine. DEFINT A-Z 'Declaration for the assembly decompressor. If the area of memory 'passed does not start with "RG", the compressed image's signature, 'then this routine will just return without doing anything. This 'prevents your machine from hanging when you pass it a bum pointer. DECLARE SUB Decom13 (BYVAL InSegment, BYVAL InOffset) CONST True = -1, False = 0 'A larger buffer size would surely increase compression. CONST BufferSize = 4096, HashSize = 4096 CONST Null = BufferSize, Threshold = 2, MaxMatch = 273 CONST MaxCompares = 300 'Controls compression ratio vs. speed 'Arrays for LZ77 style compression with multiple linked lists DIM SHARED RingBuffer((BufferSize + MaxMatch - 1) - 1) DIM SHARED NextCell((BufferSize + HashSize + 1) - 1) DIM SHARED LastCell((BufferSize + HashSize + 1) - 1) 'Temp. holding buffer for compression tokens DIM SHARED CodeBuffer(16 * 3 - 1) 'Misc. stuff DIM SHARED DoneFlag, xp, yp, xl, yl, xh, yh DIM SHARED Match.Length, Match.Position, Match.Distance DIM SHARED IOBuffer$, IOPointer DIM SHARED CodePointer, CodeCounter, OrMask AS LONG, BitAccum AS LONG SCREEN 13 '**COMPRESSION EXAMPLE** RANDOMIZE TIMER FOR a = 1 TO 100 'draw us some garbage x = RND * 319: y = RND * 199: c = RND * 255 CIRCLE (x, y), RND * 60, c: PAINT (x, y), RND * 255, c NEXT FOR a = 1 TO 200: LINE -(RND * 319, RND * 199), RND * 255: NEXT Compress13 "coolfile.bci" 'compress the screen to coolfile.bci '**DECOMPRESSION EXAMPLE** 'Allocate 64,000 bytes for a worst case scenario, decrease this of 'course to match the image's compressed size in bytes... REDIM image(32000): DEF SEG = VARSEG(image(0)) BLOAD "coolfile.bci", VARPTR(image(0)) 'Load the compressed data. PRINT "Press a key to decompress.": B$ = INPUT$(1): SCREEN 13 'Call the asm routine to decompress the image. Decom13 VARSEG(image(0)), VARPTR(image(0)): B$ = INPUT$(1) 'Compresses a SCREEN 13 image to a BLOADable file. Use the ASM sub 'Decom13 to decompress the image back to the screen. This routine 'currently crawls, because I didn't optimize it that much. 'The entire palette is also saved to the compressed file, SUB Compress13 (F$) OPEN F$ FOR OUTPUT AS #1: CLOSE : OPEN F$ FOR BINARY AS #1 'Store the BLOAD header and image signature. a$ = CHR$(&HFD) + CHR$(0) + CHR$(&HA0) + STRING$(4, 0) + "RG" PUT #1, , a$ 'Initialize a 4k disk output buffer IOBuffer$ = SPACE$(4096): IOPointer = 1 CodePointer = 0: CodeCounter = 0: OrMask = 1: BitAccum = 0 'Write the screen's palette. OUT &H3C7, 0: FOR a = 0 TO 767: WriteByte INP(&H3C9): NEXT DoneFlag = False: xl = 0: yl = 0: xh = 319: yh = 199 xp = xl: yp = yl 'coordinate of next point to compress InitRingBuffer 'clear the ring buffer InitLZ77 'initialize the linked list pool 'prime the look ahead buffer S = 0: R = BufferSize - MaxMatch FOR LookAheadLength = 0 TO MaxMatch - 1 IF DoneFlag THEN EXIT FOR ELSE RingBuffer(R + LookAheadLength) = GetPixel END IF NEXT 'find first string FindString R DO 'if match too small(less than 3 chars), the just output 'a single character IF Match.Length <= Threshold THEN OutputChar RingBuffer(R): Last.Match.Length = 1 ELSE 'output a string match token Last.Match.Length = Match.Length 'Send the match's distance, instead of its position in 'the ring buffer, because the decompressor is not using a 'ring buffer to store the decompressed data. Match.Distance = (R - Match.Position) AND (BufferSize - 1) OutputMatch END IF 'prime the look ahead buffer with more characters FOR a = 0 TO Last.Match.Length - 1 IF DoneFlag THEN EXIT FOR 'exit this loop if no more chars 'delete string at S, then store a new char at S DeleteString S: RingBuffer(S) = GetPixel 'keep a "ghost buffer" at the end of the ring buffer to 'avoid using a logical AND on all of our buffer pointers IF S < (MaxMatch - 1) THEN RingBuffer(S + BufferSize) = RingBuffer(S) END IF S = (S + 1) AND (BufferSize - 1) R = (R + 1) AND (BufferSize - 1) 'if not last time through loop then just add string to the 'linked list pool, otherwise add it and find a match '(this could be optimized so the IF/THEN conditional is 'removed from inside this loop) IF a = (Last.Match.Length - 1) THEN FindString R ELSE MakeString R END IF NEXT FOR a = a TO Last.Match.Length - 1 'this loop is active when no more characters are available 'from the input stream 'Kill string at S, not sure if this is needed because 'we're not storing any characters in its place. I see 'no reason to do it, but this is one of those little 'quirks that all LZSS implementations I've seen have... ? DeleteString S S = (S + 1) AND (BufferSize - 1) R = (R + 1) AND (BufferSize - 1) LookAheadLength = LookAheadLength - 1 IF LookAheadLength THEN IF a = (Last.Match.Length - 1) THEN FindString R ELSE MakeString R END IF 'Limit match length because the look ahead buffer 'is growing smaller. This is another little oddity 'I've seen amoung the LZSS compressors, they all do 'this check outside this loop before they output a 'character/match token... There's no reason to 'check outside the loop because the string search 'function always limits the match length to the 'look ahead buffer's size. We only check when the 'look ahead buffer starts to get smaller. IF Match.Length > LookAheadLength THEN Match.Length = LookAheadLength END IF END IF NEXT LOOP WHILE LookAheadLength 'loop while still more chars to encode OutputEOF WriteFlush 'get (compressed size)-header a& = LOF(1) - 7: SCREEN 0: WIDTH 80 IF a& > 64000 THEN PRINT "Image could not be compressed." CLOSE #1: KILL F$ ELSE PRINT "Image compressed to"; a&; "bytes." IF a& > 32767 THEN a& = a& - 65536 'store the compressed size so BLOAD loads everything in a = a&: PUT #1, 6, a: CLOSE #1 END IF END SUB 'Deletes the string at S from the linked list pool. SUB DeleteString (BYVAL S) NextCell = NextCell(S): LastCell = LastCell(S) NextCell(LastCell) = NextCell: LastCell(NextCell) = LastCell NextCell(S) = Null END SUB 'Attempts to find a match at R+1 that is larger than the match found 'at R, to get rid of some of the encoder's "greedy" characteristics. FUNCTION FindAlternate (BYVAL R, BYVAL MatchLength) B1 = RingBuffer(R): B2 = RingBuffer(R + 1): B3 = RingBuffer(R + 2) 'hash out the first three characters of the string to locate P = (BufferSize + 1) + ((B1 * 14096& XOR B2 * 77 XOR B3) MOD HashSize) MatchChar = RingBuffer(R + MatchLength) FOR x = 1 TO MaxCompares P = NextCell(P) 'traverse linked list P for a match 'if we struck bottom then search failed IF P = Null THEN FindAlternate = False: EXIT FUNCTION 'compare string P to string R IF RingBuffer(P) = B1 AND RingBuffer(P + 1) = B2 AND RingBuffer (P + 2) = B3 AND RingBuffer(P + MatchLength) = MatchChar THEN FOR SearchLength = 3 TO (MaxMatch - 1) - 1 IF RingBuffer(R + SearchLength) <> RingBuffer(P + SearchLength) THEN EXIT FOR NEXT 'if we find a longer match then exit with success IF SearchLength > MatchLength THEN FindAlternate = True: EXIT FUNCTION END IF NEXT FindAlternate = False END FUNCTION 'Attempts to locate a match in the linked list pool for R. Most 'other LZ77/LZSS implementations I've seen use a binary tree to 'locate string matches. In this implementation, I use a pool of 'linked lists to locate strings. Each linked list contains strings 'which all start with the same 3 characters. (Well, usually. Since 'hash collisions can occur, sometimes a linked list contains two or 'more different strings. This isn't cool, and can't be eliminated 'unless another approach to collision handling is used.) ' ' To locate a string, its linked list is located through a simple 'hashing formula(which was home brewed, BTW, so it may not be that 'optimal), and then each string in the list is compared against our 'target string until we either find a string which matches perfectly 'or the "bombout" variable is decremented to zero. The bombout rate 'defines the number of string compares which may be performed until 'the algorithm stops searching and settles with what it has. This 'decreases compression slightly, but greatly increases compression 'speed, especially when the input stream contains large runs of 'repeated data. (ARJ adjusts its bombout rate with command line 'options: options -m4 to -m0 vary the number of compares it does 'against its string directionary, therefore "dialing" in compression 'speed vs. compression ratio. PKZIP 1.93a does this also. 'Normally, PKZIP 1.93a will set its bombout rate to 50 compares. The 'Continued on page 4 '-s option brings this down to 10-7 compares(can't remember exactly), 'and the -ex option increases the bombout rate to 500 compares. 'Obviously, the -ex option slows down PKZIP 1.93a because it can do 'up to ten times more string compares than usual.) ' ' One optimization that I have not seen anywhere yet speeds up the 'string search by skipping strings which can't possibly be larger 'than the largest string found up to that point... ' ' For instance, let's say we are searching for the string "the 'president eats peanuts". Let's also say the largest match we've 'found so far is "the president ", or 14 characters. The next string 'to compare against our target is "the president finds coolness in 'compression". Since the whole point of searching is to look for the 'largest match, there's no use in doing a whole string compare if the 'match will be smaller/equal to our current match. A quick compare 'of the character that must match for the match length to be larger 'will tell us if the string *may* be larger. If the character 'matches, we must do the compare. If it doesn't, then there is no 'use in doing the string compare because the match cannot possibly be 'longer. Since the 15th character of our target string is "e", and 'the 15th character of our search string is "f", it can instantly be 'discarded because the match cannot possibly be larger than 14 'characters. This especially speeds up the search when large string 'matches are found in the input stream(such as in text files). And 'since the optimization is relatively trivial, it shouldn't slow down 'the string search loop much at all when input stream is not very 'compressable. ' ' Finally, using the linked list pool to find string matches makes 'finding the closest AND longest match very simple(finding the 'closest match aids entropy encoding in attaining more compression 'because it can favor close matches over far ones). Since new 'strings are always inserted as the first string in its pool, the 'entire list is already sorted in order of distance from our current 'position in the ring buffer. SUB FindString (BYVAL R) B1 = RingBuffer(R): B2 = RingBuffer(R + 1): B3 = RingBuffer(R + 2) 'hash the first 3 characters of the string to find LinkHead = (BufferSize + 1) + ((B1 * 14096& XOR B2 * 77 XOR B3) MOD HashSize) Match.Length = 0: MatchChar = B1: P = LinkHead FOR x = 1 TO MaxCompares 'MaxCompares is the bombout rate 'traverse linked list P for match P = NextCell(P): IF P = Null THEN EXIT FOR 'If first 3 characters match, and the character at 'P+MatchLength=R+MatchLength, then compare strings. IF RingBuffer(P) = B1 AND RingBuffer(P + 1) = B2 AND RingBuffer (P + 2) = B3 AND RingBuffer(P + Match.Length) = MatchChar THEN FOR SearchLength = 3 TO (MaxMatch - 1) - 1 IF RingBuffer(R + SearchLength) <> RingBuffer(P + SearchLength) THEN EXIT FOR NEXT 'if matchsize=maxmatch then take it and run '(MaxMatch-1) because our look ahead buffer is one 'character longer than the maximum match length. IF SearchLength >= (MaxMatch - 1) THEN Match.Length = (MaxMatch - 1) Match.Position = P EXIT FOR END IF 'if we find a longer match then take it IF SearchLength > Match.Length THEN Match.Length = SearchLength Match.Position = P MatchChar = RingBuffer(R + Match.Length) END IF END IF NEXT 'make the new string the first entry in its linked list pool 'so we always find the closest match a = NextCell(LinkHead): NextCell(LinkHead) = R LastCell(a) = R: LastCell(R) = LinkHead: NextCell(R) = a 'Attempt to find a longer match at R+1. If there is a longer 'match, then set the match length to zero so the current match 'is ignored. IF (Match.Length <> 0) AND (Match.Length <> (MaxMatch - 1)) THEN IF FindAlternate(R + 1, Match.Length) THEN Match.Length = 0 END IF END SUB 'Returns one pixel from the display. FUNCTION GetPixel GetPixel = POINT(xp, yp): xp = xp + 1 IF xp > xh THEN LINE (xl, yp)-(xh, yp), 0 xp = xl: yp = yp + 1: DoneFlag = yp > yh END IF END FUNCTION 'Initializes the linked list pool arrays 'Page 5 of ENCODE13.BAS begins here. SUB InitLZ77 FOR a = 0 TO (BufferSize + 1 + HashSize) - 1 NextCell(a) = Null: LastCell(a) = Null NEXT END SUB 'Initializes the ring buffer. SUB InitRingBuffer FOR a = 0 TO BufferSize - MaxMatch - 1: RingBuffer(a) = 0: NEXT END SUB 'Stores the string at R into its linked list without scanning for a 'match. SUB MakeString (BYVAL R) LinkHead = (BufferSize + 1) + ((RingBuffer(R) * 14096& XOR _ RingBuffer(R + 1) * 77 XOR RingBuffer(R + 2)) MOD HashSize) a = NextCell(LinkHead): NextCell(LinkHead) = R: LastCell(a) = R LastCell(R) = LinkHead: NextCell(R) = a END SUB 'Stores an uncompressed character and its flag to the output code 'buffer. SUB OutputChar (BYVAL a) OrMask = OrMask * 2 'send a binary 0 CodeBuffer(CodePointer) = a 'store the character CodeCounter = CodeCounter + 1 IF CodeCounter = 16 THEN 'if 16 codes the write 'em out 'write the bit flags WriteByte BitAccum AND 255: WriteByte BitAccum \ 256 'write the codes FOR a = 0 TO CodePointer: WriteByte CodeBuffer(a): NEXT CodePointer = 0: CodeCounter = 0: OrMask = 1: BitAccum = 0 ELSE CodePointer = CodePointer + 1 END IF END SUB 'Writes an EOF code to the output code buffer SUB OutputEOF BitAccum = BitAccum OR OrMask CodeBuffer(CodePointer) = 15 CodeBuffer(CodePointer + 1) = 0: CodeBuffer(CodePointer + 2) = 255 WriteByte BitAccum AND 255: WriteByte BitAccum \ 256 FOR a = 0 TO CodePointer + 2: WriteByte CodeBuffer(a): NEXT END SUB 'Outputs a match and its flag to the output code buffer. SUB OutputMatch BitAccum = BitAccum OR OrMask: OrMask = OrMask * 2 'Favor short matches(3-17 characters). IF Match.Length < 18 THEN CodeBuffer(CodePointer) = (Match.Length - (Threshold + 1)) OR _ (Match.Distance AND &HF) * 16 CodeBuffer(CodePointer + 1) = Match.Distance \ 16 CodePointer = CodePointer + 2 ELSE CodeBuffer(CodePointer) = 15 OR (Match.Distance AND &HF) * 16 CodeBuffer(CodePointer + 1) = Match.Distance \ 16 CodeBuffer(CodePointer + 2) = Match.Length - 18 CodePointer = CodePointer + 3 END IF CodeCounter = CodeCounter + 1 IF CodeCounter = 16 THEN WriteByte BitAccum AND 255: WriteByte BitAccum \ 256 FOR a = 0 TO CodePointer - 1: WriteByte CodeBuffer(a): NEXT CodePointer = 0: CodeCounter = 0: OrMask = 1: BitAccum = 0 END IF END SUB 'Stores one byte into the disk output buffer, and flushes it when it 'is full. SUB WriteByte (BYVAL a) MID$(IOBuffer$, IOPointer, 1) = CHR$(a) IOPointer = IOPointer + 1 IF IOPointer = 4097 THEN 'if buffer full then flush PUT #1, , IOBuffer$: IOPointer = 1 END IF END SUB 'Flushes the disk output buffer. SUB WriteFlush IOBuffer$ = LEFT$(IOBuffer$, IOPointer - 1): PUT #1, , IOBuffer$ END SUB '---------8<----[ DECOM13.ASM begins here. ]---->8------------- ;TASM v2.0 source code for DECOM13.OBJ. By Rich Geldreich, 1992 ;A LZ77 style sliding dictionary decompressor for SCREEN 13 images. .286 ;<-sorry 8088 & 8086 guys, IDEAL ;it's 1992 get a real CPU! MODEL SMALL CODESEG PUBLIC Decom13 PROC Decom13 INPTR EQU [dword ss:bp+6] P = 2 Cld ;clear direction flag Push bp ;setup stack frame Mov bp, sp Push ds es si di ;preserve important regs Lds si, INPTR ;get pointer from stack Cmp [word ds:si], 'R'+'G'*256 ;is an image there? Je @@OK ;nope Jmp @@Exit @@OK: Inc si ;get by signature Inc si Mov [word cs:ISeg1+1], ds ;a little self modifying code Mov [word cs:ISeg2+1], ds ; can't hurt(I think). Jmp @@10 ;empty the prefetch @@20: Mov dx, 03C4h ;sequencer register Mov al, 1 ;clocking mode register Out dx, al Inc dx In al, dx Or al, 32 ;set screen off bit Out dx, al ;go for screen disable Mov dl, 0DAh ;wait for vertical retrace @@30: In al, dx And al, 8 Jz @@30 Mov dl, 0C8h ;dx=03C8h Mov cx, 768 ;prepare to set the palette Xor al, al ;start at attribute 0 Out dx, al Inc dx Rep Outsb ;output the palette Push 0A000h ;es=screen's segment Pop es Xor di, di ;di=output offset Mov dx, di ;dx=# bits left in bitbuffer EVEN ;-decode loop starts here- @@MoreBits: Lodsw ;prime the bitbuffer Mov dl, 16 ;16 more bits now Mov bp, ax Shr bp, 1 ;character or match? Jc @@Match ;go for match if carry set EVEN @@NoMatch: Movsb ;store one character @@MainLoop: Dec dx ;any more bits left? Jz @@MoreBits ;get more if not Shr bp, 1 ;character of match? Jnc @@NoMatch ;go if character(carry=0) @@Match: ;-handles a string match- Lodsw ;get match length and Mov cx, ax ; and distance Shr ax, 4 ;shift by the match length Neg ax ;got -distance now Add ax, di ;ax=match position And cx, 0Fh ;get low 4 bytes for length Add cl, 3 ;add in length threshold Cmp cl, 18 ;is this a big match? Je @@GetMore ;go get 1 more byte if so Xchg ax, si ;save si and set si to match Mov bx, es ; position Mov ds, bx ;ds=es=0A000h Rep Movsb ;copy the string Mov si, ax ;restore ds and si ISeg1: Mov ax, 09999h ;<--self modifying code Mov ds, ax Jmp @@MainLoop ;go again EVEN @@GetMore: Mov bx, ax ;save match pos in bx Xor ax, ax ;get one more byte for Lodsb ; match length Add cx, ax Cmp cx, 273 ;end of image code? Je @@Exit ;if so then done Xchg bx, si ;save si and set si to match 'Continued on page 2 'Page 2 of DECOM13.ASM begins here. Mov ax, es ; pos Mov ds, ax ;ds=es=0A000h Rep Movsb ;copy the data Mov si, bx ;restore ds and si ISeg2: Mov ax, 09999h ;<--self modifying code Mov ds, ax Jmp @@MainLoop @@Exit: Mov dx, 03C5h ;turn screen back on In al, dx And al, NOT 32 Out dx, al Pop di si es ds bp ;exit back to caller Retf P*2 @@10: Jmp @@20 ENDP Decom13 END '---------8<----[ DECOM13.ASM ends here. ]---->8------------- Oops. Here is the OBJ for the assembly decoder: To execute this script, save it to a file and type DEBUG < filename where "filename" is the name of this script file. E165"DECOM13.OBJ" 0 E200".q..9EKNXxKPlAX9/BJHhXs5....IJbQWx46/BrQZpaMgJaQU.WJZ7rQdxaPU" E23D"6X9kY9WH..Edjf0dUl0YJqMjpKAnsGEHp2g6C...ZCHK8...U4W1..EVGdZA." E27A"E/TFJFMF3/1x2F3N7a5..Gk0U.12kMKm..3w3F/FJE2EIEI3YkMS..6/..2IE" E2B7".DM70.M.F57pHJ/pWOG..4wj.P/d1..E.5EIF1xIHlA1...UX6G...7O.F08h" E2F4".2...kTJ9mi54MpJ3Pb//mXI5Fr.df6.4NY9AuFS.s0XSU7.df6.uGw.k4Uv0" E331"lC1UsigOnC76ErymWQi.AUA.viEnv4O..u/nwzWLregEg6uFriQ7.7d8FbwFr" E36E"yQsruW65Au2QDq1QwUVz.U/D.Ut9/RFM7X1vsqnHuWkXPaNu6qfHBY9WxA.nu" E3AB".65MyF2.RFQcrA0gXMDDd9CDiNadXMjShuKw.gHmrizZL5wFL8H..dDrz2kN0" E3E8".EQ4I3.lSEJ.mfc....R" E100 B8 0 3C BA 65 1 33 C9 CD "!rC" BE 0 2 50 BD 7D 1 55 BF 88 90 E117 "W3" DB B1 FA 8A F0 80 C1 6 32 E4 AC "<9v" 8 "