Category : Modula II Source Code
Archive   : HUFFMAN.ZIP
Filename : HUFFMAN.MOD

 
Output of file : HUFFMAN.MOD contained in archive : HUFFMAN.ZIP
======
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

  3 Responses to “Category : Modula II Source Code
Archive   : HUFFMAN.ZIP
Filename : HUFFMAN.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/