home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
modula2
/
library
/
modula1
/
huffman.mod
< prev
next >
Wrap
Text File
|
1988-11-18
|
26KB
|
1,066 lines
======
Editor's note: Remember to break the folowing modules into their own files
before attempting to compile them. Delete "======" and comments inside them
======
Start BitStream.DEF
======
DEFINITION MODULE BitStream;
(* Used for bit-oriented I/O. Minimal facilities. *)
EXPORT QUALIFIED connect, disconnect, EOS, read, write, bitStream,
readChar, writeChar, readCard, writeCard;
TYPE bitStream;
PROCEDURE connect(fileName:ARRAY OF CHAR; read:BOOLEAN):bitStream;
(* Associates a file with a bitStream. A given stream can be
read from or written to, but not both. On a Mac, this procedure
uses the default drive. *)
PROCEDURE disconnect(bs:bitStream);
(* Disconnects stream from file. *)
PROCEDURE EOS(bs:bitStream):BOOLEAN;
(* TRUE at end of stream; for read streams only! *)
PROCEDURE read(bs:bitStream):BOOLEAN;
(* Reads a bit from the stream. TRUE = 1, FALSE = 0 *)
PROCEDURE write(bs:bitStream; b:BOOLEAN);
(* Writes a bit to the stream. *)
PROCEDURE readChar(bs:bitStream):CHAR;
(* Reads eight consecutive bits and translates them into a CHAR. This is
somewhat implementation-dependent. *)
PROCEDURE writeChar(bs:bitStream; c:CHAR);
(* Writes the character as eight consecutive bits. This is somewhat
implementation-dependent. *)
PROCEDURE readCard(bs:bitStream):CARDINAL;
(* Reads 16 consecutive bits and translates them into a CARDINAL. *)
PROCEDURE writeCard(bs:bitStream; c:CARDINAL);
(* Writes the cardinal as 16 consecutive bits *)
END BitStream.
======
Start BitStream.MOD
======
IMPLEMENTATION MODULE BitStream;
(* Note: because Streams.WriteWord and Streams.ReadWord don't appear to
work in MacModula-2, I do I/O with the character operations. A character
code occupies bits 8-15 of a word. *)
FROM Streams IMPORT STREAM, StreamType, Connect, Disconnect, ReadChar,
WriteChar;
IMPORT Streams;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM MyTerminal IMPORT fatal;
CONST maxBit = 15; (* highest numbered bit in a BITSET *)
lowCharBit = 8; (* first bit of a character *)
TYPE wordRange = [0..maxBit];
charRange = [lowCharBit..maxBit];
bitStream = POINTER TO bsRec;
bsRec = RECORD
stream:STREAM;
read:BOOLEAN;
curWord:BITSET;
curBit:charRange;
END;
PROCEDURE connect(fileName:ARRAY OF CHAR; read:BOOLEAN):bitStream;
VAR bs:bitStream;
nullVol:ARRAY[0..0] OF CHAR;
done:BOOLEAN;
BEGIN
nullVol[0] := 0C;
NEW(bs);
bs^.read := read;
IF read THEN
Connect(bs^.stream, streamread, (* open stream for reading *)
fileName, nullVol, 1, (* use drive #1 *)
FALSE, (* don't create if nonexistent *)
done);
IF NOT done THEN
fatal('cannot open file');
END;
bs^.curBit := maxBit;
ELSE
Connect(bs^.stream, streamwrite, fileName, nullVol, 1, TRUE, done);
IF NOT done THEN
fatal('cannot open file');
END;
bs^.curBit := lowCharBit;
bs^.curWord := {};
END;
RETURN bs;
END connect;
PROCEDURE disconnect(bs:bitStream);
BEGIN
WITH bs^ DO
IF (NOT read) AND (curBit <> lowCharBit) THEN (* flush the last word *)
WriteChar(stream, CHAR(curWord));
END;
Disconnect(stream);
DISPOSE(bs);
END;
END disconnect;
PROCEDURE EOS(bs:bitStream):BOOLEAN;
BEGIN
WITH bs^ DO
IF read THEN
RETURN (curBit = maxBit) AND Streams.EOS(stream);
ELSE
fatal('EOS called on write bit stream');
END;
END;
END EOS;
PROCEDURE read(bs:bitStream):BOOLEAN;
(* Init: curBit := maxBit. curBit = "all bits to curBit have been read" *)
VAR c:CHAR;
BEGIN
IF NOT bs^.read THEN
fatal('attempt to read a write bit stream');
ELSE WITH bs^ DO
IF curBit = maxBit THEN
IF NOT Streams.EOS(stream) THEN
ReadChar(stream, c);
curWord := BITSET(c);
curBit := lowCharBit;
END;
ELSE
INC(curBit);
END;
RETURN curBit IN curWord;
END; END;
END read;
PROCEDURE write(bs:bitStream; b:BOOLEAN);
(* init: curBit := lowCharBit, curWord := {}.
curBit = "bit curBit is next to be written" *)
BEGIN
WITH bs^ DO
IF read THEN
fatal('attempt to write a read bit stream');
END;
IF b THEN
INCL(curWord, curBit);
END;
IF curBit = maxBit THEN
WriteChar(stream, CHAR(curWord));
curWord := {};
curBit := lowCharBit;
ELSE
INC(curBit);
END;
END;
END write;
PROCEDURE readChar(bs:bitStream):CHAR;
(* Read 8 bits and make them into a character. In MacModula-2,
a CHAR variable is a word with bits 8-15 containing the ASCII code. *)
VAR i:charRange;
char:BITSET;
BEGIN
char := {};
FOR i := lowCharBit TO maxBit DO
IF read(bs) THEN
INCL(char, i);
END;
END;
RETURN CHAR(char);
END readChar;
PROCEDURE writeChar(bs:bitStream; c:CHAR);
(* see readChar for implementation details *)
VAR i:charRange;
BEGIN
FOR i := lowCharBit TO maxBit DO
write(bs, i IN BITSET(c));
END;
END writeChar;
PROCEDURE readCard(bs:bitStream):CARDINAL;
VAR i:wordRange;
card:BITSET;
BEGIN
FOR i := 0 TO maxBit DO
IF read(bs) THEN
INCL(card, i);
ELSE
EXCL(card, i);
END;
END;
RETURN CARDINAL(card);
END readCard;
PROCEDURE writeCard(bs:bitStream; c:CARDINAL);
VAR i:wordRange;
BEGIN
FOR i := 0 TO maxBit DO
write(bs, i IN BITSET(c));
END;
END writeCard;
BEGIN
END BitStream.
======
Start CharStream.DEF
======
DEFINITION MODULE CharStream;
EXPORT QUALIFIED charStream, connect, disconnect, read, write, EOS;
TYPE
charStream;
PROCEDURE connect(fileName:ARRAY OF CHAR; read:BOOLEAN):charStream;
PROCEDURE disconnect(cs:charStream);
PROCEDURE read(cs:charStream):CHAR;
PROCEDURE write(cs:charStream; c:CHAR);
PROCEDURE EOS(cs:charStream):BOOLEAN;
END CharStream.
======
Start CharStream.MOD
======
IMPLEMENTATION MODULE CharStream;
(* This module supports character I/O from files. Its facilities are minimal.
I wrote it using MacModula-2's Streams module; it should be easy to
duplicate its behavior with whatever file system you have. *)
FROM Streams IMPORT STREAM, StreamType, Connect, Disconnect,
ReadChar, WriteChar;
IMPORT Streams;
FROM MyTerminal IMPORT fatal;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
TYPE
charStream = POINTER TO STREAM;
PROCEDURE connect(fileName:ARRAY OF CHAR; read:BOOLEAN):charStream;
VAR cs:charStream;
nullVol: ARRAY[0..0] OF CHAR;
done:BOOLEAN;
BEGIN
nullVol[0] := 0C;
NEW(cs);
IF read THEN
Connect(cs^, streamread, (* open stream for reading *)
fileName, nullVol, 1, (* use drive #1 *)
FALSE, (* don't create if nonexistent *)
done);
IF NOT done THEN
fatal('cannot open file');
END;
ELSE
Connect(cs^, streamwrite, fileName, nullVol, 1, TRUE, done);
IF NOT done THEN
fatal('cannot open file');
END;
END;
RETURN cs;
END connect;
PROCEDURE disconnect(cs:charStream);
BEGIN
Disconnect(cs^);
DISPOSE(cs);
END disconnect;
PROCEDURE read(cs:charStream):CHAR;
VAR c:CHAR;
BEGIN
ReadChar(cs^, c);
RETURN c;
END read;
PROCEDURE write(cs:charStream; c:CHAR);
BEGIN
WriteChar(cs^, c);
END write;
PROCEDURE EOS(cs:charStream):BOOLEAN;
BEGIN
RETURN Streams.EOS(cs^);
END EOS;
BEGIN
END CharStream.
======
Start Compress.MOD
======
MODULE Compress;
(* File compression algorithm using Huffman coding.
Based on "Data Compression with Huffman Coding," BYTE March 1986.
Copyright 1986 by Jonathan Amsterdam. All Rights Reserved.
*)
FROM CharStream IMPORT charStream;
IMPORT CharStream;
FROM BitStream IMPORT bitStream;
IMPORT BitStream;
FROM MyTerminal IMPORT ClearScreen, pause, WriteCard, WriteLn, WriteString,
WriteLnString, Write;
FROM InOut IMPORT ReadString;
FROM Huffman IMPORT huffTree, huffman, readCode, writeCode, readTree,
writeTree, codeSize;
FROM StringStuff IMPORT stringLen, stringCopy;
FROM RealInOut IMPORT FWriteReal;
(* FWriteReal writes real numbers in decimal format. If your implementation
doesn't have it, substitute WriteReal. *)
CONST stringlen = 60;
VAR frequency:ARRAY CHAR OF CARDINAL;
fileSize:CARDINAL;
inFileName, outFileName: ARRAY[0..stringlen] OF CHAR;
hTree:huffTree;
PROCEDURE doFreq;
(* Obtain frequency count from file *)
VAR cs:charStream;
BEGIN
cs := CharStream.connect(inFileName, TRUE); (* read file *)
freqCount(cs);
CharStream.disconnect(cs);
END doFreq;
PROCEDURE freqCount(cs:charStream);
VAR c:CHAR;
BEGIN
FOR c := 0C TO CHR(HIGH(frequency)) DO
frequency[c] := 0;
END;
c := CharStream.read(cs);
WHILE NOT CharStream.EOS(cs) DO
INC(frequency[c]);
INC(fileSize);
c := CharStream.read(cs);
END;
END freqCount;
PROCEDURE doOutput;
(* Output encoded file *)
VAR inStream:charStream;
outStream:bitStream;
c:CHAR;
BEGIN
inStream := CharStream.connect(inFileName, TRUE);
outStream := BitStream.connect(outFileName, FALSE);
BitStream.writeCard(outStream, fileSize);
writeTree(outStream, hTree);
c := CharStream.read(inStream);
WHILE NOT CharStream.EOS(inStream) DO
writeCode(outStream, hTree, c);
c := CharStream.read(inStream);
END;
CharStream.disconnect(inStream);
BitStream.disconnect(outStream);
END doOutput;
PROCEDURE computeStats;
(* Compute statistics on how much space was saved *)
VAR c:CHAR;
origBits, compBits, nChars:CARDINAL;
savings:REAL;
BEGIN
origBits := fileSize * 8;
compBits := 0;
nChars := 0;
FOR c := 0C TO CHR(HIGH(frequency)) DO
IF frequency[c] <> 0 THEN
INC(nChars);
compBits := compBits + codeSize(hTree, c) * frequency[c];
END;
END;
WriteString("number of different characters: ");
WriteCard(nChars, 0); WriteLn;
WriteString("original file size (bits): ");
WriteCard(origBits, 0); WriteLn;
WriteString("compressed f. size (bits): ");
WriteCard(compBits, 0); WriteLn;
WriteString("percent savings: ");
savings := 1.0 - (FLOAT(compBits) / FLOAT(origBits));
FWriteReal(savings * 100.0, 5); WriteLn;
WriteString("compressed size, including bookkeeping: ");
(* add 16 bits for character, count, 10n-1 bits for tree *)
INC(compBits, 16 + 10*nChars -1);
WriteCard(compBits, 0); WriteLn;
WriteString("true percent savings: ");
savings := 1.0 - (FLOAT(compBits) / FLOAT(origBits));
FWriteReal(savings * 100.0, 5); WriteLn;
END computeStats;
PROCEDURE doOutfileName;
(* Make the name of the output file by appending ".P" to the input file's
name *)
VAR len:CARDINAL;
BEGIN
len := stringLen(inFileName);
stringCopy(outFileName, inFileName);
outFileName[len] := '.';
outFileName[len+1] := 'P';
outFileName[len+2] := 0C;
END doOutfileName;
BEGIN
ClearScreen;
WriteLnString("File Compression using Huffman Coding");
WriteString("Input file: ");
ReadString(inFileName);
doOutfileName;
doFreq;
hTree := huffman(frequency);
doOutput;
computeStats;
pause('done--');
END Compress.
======
Start Huffman.DEF
======
DEFINITION MODULE Huffman;
(* Implements the Huffman coding scheme and procedures for manipulating
the code tree. *)
FROM BitStream IMPORT bitStream;
EXPORT QUALIFIED huffTree, huffman, writeCode, readCode, writeTree, readTree,
codeSize;
TYPE huffTree;
PROCEDURE huffman(VAR frequency:ARRAY OF CARDINAL):huffTree;
(* construct a Huffman coding tree from the given character frequencies *)
PROCEDURE writeCode(bs:bitStream; ht:huffTree; c:CHAR);
(* Write the code for c onto bs, using ht. *)
PROCEDURE readCode(bs:bitStream; ht:huffTree):CHAR;
(* Read bits from bs until a full code is read; return the character *)
PROCEDURE writeTree(bs:bitStream; ht:huffTree);
(* Write the tree onto the stream *)
PROCEDURE readTree(bs:bitStream):huffTree;
(* Read a huffTree from the stream *)
PROCEDURE codeSize(ht:huffTree; c:CHAR):CARDINAL;
(* returns the length of the code for c *)
END Huffman.
======
Start Huffman.MOD
======
IMPLEMENTATION MODULE Huffman;
(* Huffman coding algorithm, as described in "Data Compression With Huffman
Coding," BYTE, March 1986.
Copyright Jonathan Amsterdam 1986, All Rights Reserved. *)
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM BitStream IMPORT bitStream;
IMPORT BitStream;
FROM MyTerminal IMPORT WriteString, WriteCard, WriteLn, fatal;
CONST maxChars = 256;
TYPE
node = POINTER TO nodeRec;
nodeRec = RECORD
char:CHAR;
freq:CARDINAL;
child:ARRAY BOOLEAN OF node;
parent:node; (* used for encoding *)
END;
huffTree = POINTER TO htRec;
htRec = RECORD
tree:node; (* the tree itself *)
leaf:ARRAY CHAR OF node; (* index by character, for encoding *)
END;
VAR tree:ARRAY[1..maxChars] OF node; (* temporary list of trees *)
nTrees:CARDINAL;
(*** constructing the tree ***)
PROCEDURE huffman(VAR frequency:ARRAY OF CARDINAL):huffTree;
VAR ht:huffTree;
BEGIN
ht := initHuffTree(frequency);
initTrees(ht^.leaf);
WHILE nTrees > 1 DO
insert(combineNodes(removeSmallest(), removeSmallest()));
END;
ht^.tree := tree[1];
RETURN ht;
END huffman;
PROCEDURE initHuffTree(VAR freq:ARRAY OF CARDINAL):huffTree;
VAR i:CARDINAL;
ht:huffTree;
BEGIN
ht := newHuffTree();
FOR i := 0 TO HIGH(freq) DO
IF freq[i] <> 0 THEN
ht^.leaf[CHR(i)] := newNode(CHR(i), freq[i], NIL, NIL);
END;
END;
RETURN ht;
END initHuffTree;
PROCEDURE initTrees(VAR leaf:ARRAY OF node);
VAR i:CARDINAL;
BEGIN
nTrees := 0;
FOR i := 0 TO HIGH(leaf) DO
IF leaf[i] <> NIL THEN
insert(leaf[i]);
END;
END;
END initTrees;
PROCEDURE removeSmallest():node;
VAR i, smallest:CARDINAL;
smallestNode:node;
BEGIN
smallest := 1;
FOR i := 2 TO nTrees DO
IF tree[i]^.freq < tree[smallest]^.freq THEN
smallest := i;
END;
END;
smallestNode := tree[smallest];
tree[smallest] := tree[nTrees];
DEC(nTrees);
RETURN smallestNode;
END removeSmallest;
PROCEDURE insert(n:node);
BEGIN
INC(nTrees);
tree[nTrees] := n;
END insert;
(*** code I/O ***)
PROCEDURE writeCode(bs:bitStream; ht:huffTree; c:CHAR);
(* Write the code for c onto bs, using ht. By using recursion, we can
avoid explicitly retracing the path from the root to the leaf. *)
PROCEDURE wrCode(n:node);
BEGIN
IF n^.parent <> NIL THEN
wrCode(n^.parent);
BitStream.write(bs, n = n^.parent^.child[TRUE]);
END;
END wrCode;
BEGIN
IF ht^.leaf[c] = NIL THEN
WriteString("no code for "); WriteCard(CARDINAL(c), 0); WriteLn;
fatal('dying');
END;
wrCode(ht^.leaf[c]);
END writeCode;
PROCEDURE readCode(bs:bitStream; ht:huffTree):CHAR;
(* Read bits from bs until a full code is read; return the character *)
PROCEDURE rdCode(n:node):CHAR;
BEGIN
IF leaf(n) THEN
RETURN n^.char;
ELSE
RETURN rdCode(n^.child[BitStream.read(bs)]);
END;
END rdCode;
BEGIN
RETURN rdCode(ht^.tree);
END readCode;
PROCEDURE writeTree(bs:bitStream; ht:huffTree);
(* Write the tree onto the stream. It is encoded as follows:
A 1 bit indicates an internal node.
A 0 bit indicates a leaf; the next 8 bits are the character code.
The tree is traversed by preorder traversal: first the root, then
the left (FALSE) subtree, then the right (TRUE). *)
PROCEDURE wrTree(n:node);
BEGIN
IF leaf(n) THEN
BitStream.write(bs, FALSE);
BitStream.writeChar(bs, n^.char);
ELSE
BitStream.write(bs, TRUE);
wrTree(n^.child[FALSE]);
wrTree(n^.child[TRUE]);
END;
END wrTree;
BEGIN
wrTree(ht^.tree);
END writeTree;
PROCEDURE readTree(bs:bitStream):huffTree;
(* Read a huffTree from the stream. See writeTree for the encoding used.
Frequency information is NOT preserved. *)
VAR ht:huffTree;
PROCEDURE rdTree():node;
VAR false, true, n:node;
BEGIN
IF BitStream.read(bs) THEN (* an internal node *)
false := rdTree();
true := rdTree();
n := newNode(0C, 0, false, true);
false^.parent := n;
true^.parent := n;
RETURN n;
ELSE (* a leaf *)
n := newNode(BitStream.readChar(bs), 0, NIL, NIL);
ht^.leaf[n^.char] := n;
RETURN n;
END;
END rdTree;
BEGIN
ht := newHuffTree();
ht^.tree := rdTree();
RETURN ht;
END readTree;
(*** huffTree allocation ***)
PROCEDURE newHuffTree():huffTree;
VAR c:CHAR;
ht:huffTree;
BEGIN
NEW(ht);
FOR c := 0C TO CHR(HIGH(ht^.leaf)) DO
ht^.leaf[c] := NIL;
END;
RETURN ht;
END newHuffTree;
(*** node stuff ***)
PROCEDURE combineNodes(n1, n2:node):node;
(* used to combine nodes when constructing the coding tree *)
VAR n:node;
BEGIN
n := newNode(0C, n1^.freq + n2^.freq, n1, n2);
n1^.parent := n;
n2^.parent := n;
RETURN n;
END combineNodes;
PROCEDURE newNode(c:CHAR; f:CARDINAL; false, true:node):node;
VAR n:node;
BEGIN
NEW(n);
WITH n^ DO
char := c;
freq := f;
child[FALSE] := false;
child[TRUE] := true;
parent := NIL;
END;
RETURN n;
END newNode;
PROCEDURE freeNode(n:node);
(* In the current implementation, this is never used *)
BEGIN
IF n <> NIL THEN
freeNode(n^.child[FALSE]);
freeNode(n^.child[TRUE]);
DISPOSE(n);
END;
END freeNode;
PROCEDURE leaf(n:node):BOOLEAN;
BEGIN
IF n = NIL THEN
fatal('leaf: n NIL');
END;
RETURN n^.child[FALSE] = NIL;
END leaf;
PROCEDURE codeSize(ht:huffTree; c:CHAR):CARDINAL;
(* returns the length of the code for c *)
VAR i:CARDINAL;
n:node;
BEGIN
i := 0;
n := ht^.leaf[c];
WHILE n <> NIL DO
INC(i);
n := n^.parent;
END;
RETURN i-1;
END codeSize;
BEGIN
END Huffman.
======
Start MyTerminal.DEF
======
DEFINITION MODULE MyTerminal;
(* Some small but useful additions to the Terminal module. *)
EXPORT QUALIFIED WriteString, WriteLn, Write, Read, ClearScreen, Beep,
WriteLnString, WriteInt, WriteCard, pause, fatal;
PROCEDURE WriteString(s:ARRAY OF CHAR);
PROCEDURE WriteLn;
PROCEDURE Write(c:CHAR);
PROCEDURE Read(VAR c:CHAR);
PROCEDURE ClearScreen;
PROCEDURE Beep;
PROCEDURE WriteLnString(s:ARRAY OF CHAR);
PROCEDURE WriteInt(i:INTEGER; spaces:CARDINAL);
PROCEDURE WriteCard(c, spaces:CARDINAL);
PROCEDURE pause(msg:ARRAY OF CHAR);
(* Prevents the screen from blanking and returning to the Finder until the
user hits a key. msg is typed out. *)
PROCEDURE fatal(msg:ARRAY OF CHAR);
(* Prints the message, does a pause, and HALTs. *)
END MyTerminal.
======
Start MyTerminal.MOD
======
IMPLEMENTATION MODULE MyTerminal;
(* Some small but useful additions to the Terminal module. *)
IMPORT Terminal;
VAR powerOfTen: ARRAY[0..4] OF CARDINAL;
PROCEDURE WriteLnString(s:ARRAY OF CHAR);
BEGIN
Terminal.WriteString(s);
Terminal.WriteLn;
END WriteLnString;
PROCEDURE WriteInt(i:INTEGER; spaces:CARDINAL);
BEGIN
IF i < 0 THEN
writeNum(CARDINAL(-i), spaces-1, TRUE);
ELSE
writeNum(CARDINAL(i), spaces, FALSE);
END;
END WriteInt;
PROCEDURE WriteCard(c, spaces:CARDINAL);
BEGIN
writeNum(c, spaces, FALSE);
END WriteCard;
PROCEDURE writeNum(c, spaces:CARDINAL; neg:BOOLEAN);
VAR p:CARDINAL;
i:INTEGER;
BEGIN
p := places(c);
FOR i := 1 TO INTEGER(spaces) - INTEGER(p) DO
Terminal.Write(' ');
END;
IF neg THEN
Terminal.Write('-');
END;
FOR i := p-1 TO 0 BY -1 DO
Terminal.Write(CHR((c DIV powerOfTen[i]) + ORD('0')));
c := c MOD powerOfTen[i];
END;
END writeNum;
PROCEDURE places(c:CARDINAL):CARDINAL;
(* Returns the number of places c takes to print; i.e. trunc(1+log10(c)). *)
VAR i:CARDINAL;
BEGIN
FOR i := 4 TO 0 BY -1 DO
IF (c DIV powerOfTen[i]) > 0 THEN
RETURN i+1;
END;
END;
RETURN 1;
END places;
PROCEDURE pause(msg:ARRAY OF CHAR);
(* Prevents the screen from blanking and returning to the Finder until the
user hits a key. msg is typed out. *)
VAR ch:CHAR;
BEGIN
Terminal.WriteString(msg);
Terminal.Read(ch);
END pause;
PROCEDURE fatal(msg:ARRAY OF CHAR);
BEGIN
WriteLnString(msg);
pause('Hit any key to die--');
HALT;
END fatal;
(*** Copies of Terminal procedures ***)
PROCEDURE WriteString(s:ARRAY OF CHAR);
BEGIN
Terminal.WriteString(s);
END WriteString;
PROCEDURE WriteLn;
BEGIN
Terminal.WriteLn;
END WriteLn;
PROCEDURE Write(c:CHAR);
BEGIN
Terminal.Write(c);
END Write;
PROCEDURE Read(VAR c:CHAR);
BEGIN
Terminal.Read(c);
END Read;
PROCEDURE ClearScreen;
BEGIN
Terminal.ClearScreen;
END ClearScreen;
PROCEDURE Beep;
BEGIN
Terminal.Beep;
END Beep;
BEGIN
powerOfTen[0] := 1;
powerOfTen[1] := 10;
powerOfTen[2] := 100;
powerOfTen[3] := 1000;
powerOfTen[4] := 10000;
END MyTerminal.
======
Start StringStuff.DEF
======
DEFINITION MODULE StringStuff;
EXPORT QUALIFIED stringCap, charCap, stringLen, stringCopy, stringEqual;
PROCEDURE charCap(ch:CHAR):CHAR;
PROCEDURE stringCap(VAR s:ARRAY OF CHAR);
PROCEDURE stringLen(VAR s:ARRAY OF CHAR):CARDINAL;
PROCEDURE stringCopy(VAR s1:ARRAY OF CHAR; s2:ARRAY OF CHAR);
PROCEDURE stringEqual(s1, s2:ARRAY OF CHAR):BOOLEAN;
END StringStuff.
======
Start StringStuff.MOD
======
IMPLEMENTATION MODULE StringStuff;
PROCEDURE charCap(ch:CHAR):CHAR;
BEGIN
IF (ch >= 'a') AND (ch <= 'z') THEN
RETURN CAP(ch);
ELSE
RETURN ch;
END;
END charCap;
PROCEDURE stringCap(VAR s:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
FOR i := 0 TO stringLen(s) DO
s[i] := charCap(s[i]);
END;
END stringCap;
PROCEDURE stringLen(VAR s:ARRAY OF CHAR):CARDINAL;
VAR i:CARDINAL;
BEGIN
FOR i := 0 TO HIGH(s) DO
IF s[i] = 0C THEN
RETURN i;
END;
END;
RETURN HIGH(s)+1;
END stringLen;
PROCEDURE stringCopy(VAR s1:ARRAY OF CHAR; s2:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
i := 0;
LOOP
IF i > HIGH(s1) THEN
EXIT;
ELSIF i > HIGH(s2) THEN
s1[i] := 0C;
EXIT;
ELSE
s1[i] := s2[i];
END;
INC(i);
END;
END stringCopy;
PROCEDURE stringEqual(s1, s2:ARRAY OF CHAR):BOOLEAN;
VAR i:CARDINAL;
BEGIN
FOR i := 0 TO HIGH(s1) DO
IF i > HIGH(s2) THEN
RETURN s1[i] = 0C;
ELSIF s1[i] <> s2[i] THEN
RETURN FALSE;
ELSIF s1[i] = 0C THEN
RETURN TRUE;
END;
END;
RETURN TRUE;
END stringEqual;
BEGIN
END StringStuff.
======
Start Uncompress.MOD
======
MODULE Uncompress;
(* Takes files encoded by Compress and restores them to their original
state.
Copyright 1986 by Jonathan Amsterdam. All Rights Reserved. *)
FROM CharStream IMPORT charStream;
IMPORT CharStream;
FROM BitStream IMPORT bitStream;
IMPORT BitStream;
FROM MyTerminal IMPORT ClearScreen, pause, WriteCard, WriteLn, WriteString,
WriteLnString, Write;
FROM InOut IMPORT ReadString;
FROM Huffman IMPORT huffTree, huffman, readCode, readTree;
FROM StringStuff IMPORT stringLen, stringCopy;
CONST stringlen = 60;
VAR inFileName, outFileName: ARRAY[0..stringlen] OF CHAR;
PROCEDURE doUncompress;
VAR inStream:bitStream;
outStream:charStream;
fileSize, i:CARDINAL; (* number of characters in file *)
hTree:huffTree;
BEGIN
inStream := BitStream.connect(inFileName, TRUE);
outStream := CharStream.connect(outFileName, FALSE);
fileSize := BitStream.readCard(inStream);
hTree := readTree(inStream);
FOR i := 1 TO fileSize DO
CharStream.write(outStream, readCode(inStream, hTree));
END;
CharStream.disconnect(outStream);
BitStream.disconnect(inStream);
END doUncompress;
PROCEDURE doFileNames;
VAR len:CARDINAL;
BEGIN
len := stringLen(inFileName);
stringCopy(outFileName, inFileName);
inFileName[len] := '.';
inFileName[len+1] := 'P';
inFileName[len+2] := 0C;
outFileName[len] := '.';
outFileName[len+1] := 'U';
outFileName[len+2] := 0C;
END doFileNames;
BEGIN
ClearScreen;
WriteLnString("Uncompression program");
WriteString('Input file (omit ".P"): ');
ReadString(inFileName);
doFileNames;
doUncompress;
pause('done--');
END Uncompress.
ile (omit ".P"): ');
ReadString(inFileName);
doFileNames;
doUncompress;
pause('done--');
END Unc