home *** CD-ROM | disk | FTP | other *** search
- Path: sparky!uunet!dtix!darwin.sura.net!jvnc.net!rutgers!cmcl2!psinntp!psinntp!bepcp!jnicholson
- From: jnicholson@bowker.com (Jim Nicholson)
- Newsgroups: comp.lang.pascal
- Subject: Compression routines
- Message-ID: <D6e3PB1w164w@bowker.com>
- Date: 25 Aug 92 13:54:24 GMT
- Organization: Bowker Electronic Publishing, New Providence NJ
- Lines: 214
-
- These were originally posted in the Fidonet PASCAL echo conference; I'm not
- sure of the legal status, but the conference moderator tells me that any code
- posted is considered in the PD . ..
-
- (Uncompress is in the next message)
-
- {*********************************************************************
- * LZW2.PAS This program performs LZW compression on the input file *
- * and writes the compressed data to the output file. It uses a *
- * more efficient coding scheme than LZW.PAS from the Oct/Nov 1991 *
- * issue of ITP. *
- * To run: LZW2 <infile> <outfile> *
- * Author : David Reid, The Cobb Group *
- * Last Revised : 12-31-91 *
- *********************************************************************}
-
- USES Dos,Crt;
-
- CONST
- {* This defines the string table size. *}
- LZWENTRIES = 8192; {* You can change LZWENTRIES to 512, *}
- {* 1024, 2048, or 4096 as you see fit. *}
- MAXENTRIES = 256+LZWENTRIES;
- XOutMask : Word = $0080; {* Points to next bit in xbitbuff *}
- XBitBuff : Word = 0; {* Holds residual output bits *}
- OutLength: Longint = 0; {* Counter for bytes output *}
- InLength : Longint = 0; {* Counter for bytes input *}
- EXIT_FAILURE = 1; {* Error level return value *}
-
- {*----TYPE DEFINITIONS----------------------------------------------*}
-
- TYPE
- RULEtag = RECORD {* This structure holds one LZW string *}
- {* table entry. It contains the prefix *}
- Prefix : Integer; {* character, the suffix character, *}
- Suffix : Integer; {* and the linked-list pointer to the *}
- Next : Integer; {* next table entry that starts with *}
- END; {* the same prefix as this one does. *}
-
- {*----GLOBAL VARIABLES----------------------------------------------*}
-
- VAR
- RULE : RULEtag;
- Rules : ARRAY[0..MAXENTRIES-1] OF RULEtag; {* The string table *}
- Bitmask : Integer; {* Controls size of input characters *}
- Entries : Integer; {* Number of entries in string table *}
- InFile : FILE; {* Input file *}
- OutFile : FILE; {* Output file *}
-
- PROCEDURE FlushOutput; FORWARD;
-
- { Init - Checks command-line arguments, opens files, and displays an }
- { informational prompt. }
-
- PROCEDURE Init; BEGIN
- IF (ParamCount <> 2 ) THEN BEGIN
- WriteLn('syntax: LZW2 <infile> <outfile>');
- Halt(EXIT_FAILURE)
- END;
- {$I-}
- Assign(InFile, ParamStr(1));
- Reset(InFile,1);
- {$I+}
- IF IOResult <> 0 THEN BEGIN
- WriteLn('Error opening input file ', ParamStr(1));
- Halt(EXIT_FAILURE)
- END;
- {$I-}
- Assign(OutFile, ParamStr(2));
- Rewrite(OutFile,1);
- {$I+}
- IF IOResult <> 0 THEN BEGIN
- WriteLn('Error opening output file ', ParamStr(2));
- Halt(EXIT_FAILURE)
- END;
- WriteLn('Compressing ...') END;
-
- { Term - Flushes any residual bits out to the output file, closes }
- { the files, and displays the file sizes and compression percent. }
-
- PROCEDURE Term; BEGIN
- FlushOutput;
- Close(InFile);
- Close(OutFile);
- WriteLn('Input file length : ',InLength:7,' ',
- 'Output file length: ',OutLength:7);
- WriteLn('Compressed: ',(100 - 100 * outlength/inlength):3:2); END;
-
-
- { Input - Reads one character from the input file and increments the }
- { global counter inlength. }
-
- FUNCTION Input: Integer; VAR
- Rval: Byte; BEGIN
- IF NOT Eof(InFile) THEN BEGIN
- BlockRead(InFile,Rval,1);
- Inc(InLength);
- Input := Rval
- END
- ELSE
- Input := -1 END;
-
- { Output - Writes a 9, 10, 11, 12, or 13 bit code to the output file.}
- { Stores any residual bits in the global variable xbitbuff. The }
- { global variable xoutmask keeps track of the residual bits. The }
- { local variable xinmask walks down the bits in newbits and helps }
- { transfer them to xbitbuff. The starting value for xinmask comes }
- { from the global variable Bitmask. }
-
- PROCEDURE Output(NewBits: Integer); VAR
- XinMask : Word; BEGIN
- IF NewBits > 255 THEN BEGIN
- XinMask := Bitmask;
- NewBits := 255 - NewBits;
- END
- ELSE
- XinMask := $0100;
- WHILE XinMask <> 0 DO BEGIN
- IF (NewBits AND XinMask) <> 0 THEN
- XBitBuff := XBitBuff OR XOutMask;
- XinMask := XinMask SHR 1;
- XOutMask := XOutMask SHR 1;
- IF XOutMask = 0 THEN BEGIN
- BlockWrite(OutFile,XBitBuff,1);
- XBitBuff := 0;
- XOutMask := $0080;
- Inc(OutLength)
- END
- END END;
-
- { FlushOut - Forces all residual bits in xbitbuff to be written to }
- { the output file. }
-
- PROCEDURE FlushOutput; BEGIN
- IF XOutMask < $0080 THEN BEGIN
- BlockWrite(OutFile,XBitBuff,1);
- Inc(OutLength)
- END;
- XBitBuff := 0;
- XOutMask := $0080 END;
-
- { InitTable - Initializes the first 256 string table entries and }
- { sets the globals Bitmask and Entries to their starting values. }
-
- PROCEDURE InitTable; BEGIN
- FOR Entries := 0 TO 255 DO BEGIN
- Rules[Entries].Prefix := -1;
- Rules[Entries].Suffix := Entries;
- Rules[Entries].Next := -1
- END;
- asm mov Bitmask, 2;
- mov Entries, 256; end; END;
-
- { IsInTable - Searches for the specified Prefix-Suffix pair in the }
- { string table. If found, the pair's position in the table is }
- { assigned to RuleNum. Returns TRUE if the pair is found or FALSE }
- { if it isn't found. }
-
- FUNCTION IsInTable(Prefix,Suffix:Integer; VAR RuleNum:Integer): Boolean; VAR
- I : Integer; BEGIN
- I := Prefix;
- WHILE I <> -1 DO
- IF (Rules[I].Prefix = Prefix) AND (Rules[I].Suffix = Suffix) THEN
- BEGIN
- RuleNum := I;
- IsInTable := TRUE;
- Exit
- END
- ELSE
- I := Rules[I].Next;
- IsInTable := FALSE END;
-
- { AddEntry - Adds a Prefix-Suffix pair to the table. Shifts Bitmask }
- { left one bit if necessitated by number of entries. }
-
- PROCEDURE AddEntry(Prefix,Suffix: Integer); BEGIN
- {*----Add Prefix/Suffix pair to the table----------------------*}
- Rules[Entries].Prefix := Prefix;
- Rules[Entries].Suffix := Suffix;
- {*----Update the table's linked list---------------------------*}
- Rules[Entries].Next := Rules[Prefix].Next;
- Rules[Prefix].Next := Entries;
- {*----Check for time to shift bitmask--------------------------*}
- Inc(Entries);
- IF Entries - 255 > Bitmask THEN
- Bitmask := Bitmask SHL 1 END;
-
- { Compress - Compresses the file. The outer while loop repeats each }
- { time the table fills up (adaptive reset). The inner while loop }
- { repeats for each character in the input file. }
-
- PROCEDURE Compress; VAR
- Prefix : Integer;
- Suffix : Integer;
- NewPrefix : Integer; BEGIN
- Prefix := Input;
- WHILE Prefix <> -1 DO BEGIN
- InitTable;
- WHILE (Entries < MAXENTRIES) AND (Prefix <> -1) DO BEGIN
- Suffix := Input;
- IF IsInTable(Prefix, Suffix, NewPrefix) THEN
- Prefix := NewPrefix
- ELSE BEGIN
- Output(Prefix);
- AddEntry(Prefix, Suffix);
- Prefix := Suffix
- END
- END
- END END;
-
- BEGIN
- Init;
- Compress;
- Term END.
-