- separated subtasks into different Modules

- enhanced readability and efficiency

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@8666 8c9fc860-2736-0410-a75d-ab315db34111

source/OZip.mod

@@ -1,554 +0,0 @@
-module OZip; (** AUTHOR GF; PURPOSE "files and streams compression tool"; *)
-
-import Streams, Commands, Files, Strings, Log := KernelLog;
-
-const 
-	BlockSize = 8*1024;
-	ComprTag = longint(0FEFD1F2FH);
-	Suffix = ".oz";
-	
-type 
-
-	HuffmanNode = object 
-		var 
-			frequency: longint;
-			left, right: HuffmanNode;		(* both nil in case of leaf *)
-			pattern: char;						
-		
-		procedure & Init( patt: char; freq: longint );
-		begin
-			pattern := patt;  frequency := freq;  left := nil;  right := nil
-		end Init;
-		
-		procedure AddChildren( l, r: HuffmanNode );
-		begin
-			left := l;  right := r;  frequency := l.frequency + r.frequency
-		end AddChildren;
-			
-	end HuffmanNode;
-	
-	
-	Codebits = record
-		bitsize: longint;
-		val: longint
-	end;
-	
-	CodeTable = pointer to array 256 of Codebits;
-	
-		
-	HuffmanCode = object
-		var 
-			wsize, bitsize: longint;
-			buffer: pointer to array BlockSize div 3 of longint;
-			lastval, lastbits: longint;
-		
-		procedure &Init;
-		begin  
-			new( buffer );  Clear
-		end Init;
-		
-		procedure Clear;
-		begin
-			wsize := 0;  lastval := 0;  lastbits := 0
-		end Clear;
-		
-		
-		
-		procedure WriteCode( w: Streams.Writer );
-		var i: longint;
-		begin
-			bitsize := 32*wsize + lastbits;
-			if lastbits > 0 then  
-				buffer[wsize] := ash( lastval, 32 - lastbits );  inc( wsize ); 
-			end;
-			
-			w.RawLInt( bitsize );
-			for i := 0 to wsize - 1 do  w.RawLInt( buffer[i] )  end;
-			w.Update
-		end WriteCode;
-		
-		
-		procedure ReadCode( r: Streams.Reader );
-		var i, n: longint;
-		begin
-			Clear;
-			r.RawLInt( bitsize );  n := (bitsize + 31) div 32;
-			for i := 0 to n - 1 do  r.RawLInt( buffer[i] )  end
-		end ReadCode;
-		
-		
-		procedure AppendBits( const bits: Codebits );
-		var 
-			bitsize, val, addval, addbits, shift: longint;
-		begin
-			bitsize := bits.bitsize;  val := bits.val;
-			if lastbits + bitsize > 32 then
-				addbits := 32 - lastbits;  shift := bitsize - addbits;
-				addval := lsh( val, -shift );
-				lastval := lsh( lastval, addbits ) + addval;
-				dec( bitsize, addbits );  dec( val, lsh( addval, shift ) );
-				buffer[wsize] := lastval;  inc( wsize );  lastval := 0;  lastbits := 0
-			end;
-			lastval := lsh( lastval, bitsize ) + val;  inc( lastbits, bitsize );
-			if lastbits = 32 then
-				buffer[wsize] := lastval;  inc( wsize );  lastval := 0;  lastbits := 0
-			end
-		end AppendBits;
-				
-		procedure EncodeBlock( tab: CodeTable;  const buf: array of char;  length: longint );
-		var i: longint;
-		begin
-			Clear;
-			for i := 0 to length - 1 do AppendBits( tab[ord( buf[i] )] )  end
-		end EncodeBlock;
-		
-		procedure DecodeBlock( tree: HuffmanNode;  var buf: array of char;  var length: longint );
-		var i, x, pos: longint; n: HuffmanNode; 
-		begin
-			i := 0;  pos := 0;
-			repeat
-				n := tree; 
-				repeat
-					if i mod 32 = 0 then  x := buffer[i div 32]  end;
-					if ash( x, i mod 32 ) < 0 then  n := n.left  else  n := n.right  end;
-					inc( i )
-				until n.left = nil;	(* leaf *)
-				buf[pos] := n.pattern;  inc( pos )
-			until i >= bitsize;
-			length := pos
-		end DecodeBlock;
-	
-	end HuffmanCode;
-		
-
-	Pattern = record
-		frequency: longint;
-		pattern: char
-	end;
-	
-	PatternArray = array 256 of Pattern;
-	
-	PatternFrequencies = pointer to array of Pattern;		(* ordered by frequency *)
-	
-	MTFList = pointer to record
-		next: MTFList;
-		byte: char;
-	end;
-	
-	
-	procedure Compress*( r: Streams.Reader;  w: Streams.Writer );
-	var 
-		huff: HuffmanCode;  chunksize: longint;
-		codeTable: CodeTable;
-		pf: PatternFrequencies;
-		bwIndex: longint;
-		buffer: array BlockSize of char;
-	begin 
-		new( huff ); 
-		w.RawLInt( ComprTag );
-		loop
-			r.Bytes( buffer, 0, BlockSize, chunksize );
-			if chunksize < 1 then  exit  end;
-			BWEncode( buffer, chunksize, bwIndex );
-			pf := CountPatterns( buffer, chunksize );
-			WriteFrequencies( pf, w );
-			codeTable := BuildCodeTable( BuildHuffmanTree( pf ) );
-			huff.EncodeBlock( codeTable, buffer, chunksize );
-			huff.WriteCode( w );
-			w.RawLInt( bwIndex );
-			w.Update;
-			if r is Files.Reader then  Log.Char( '.' )  end
-		end
-	end Compress;
-	
-	
-		
-	procedure Uncompress*( r: Streams.Reader;  w: Streams.Writer;  var msg: array of char ): boolean;
-	var 
-		tree: HuffmanNode;
-		huff: HuffmanCode;
-		tag, chunksize, i, bwIndex: longint;
-		buffer: array BlockSize of char;
-	begin 
-		r.RawLInt( tag );
-		if tag # ComprTag  then
-			msg := "OZip.Uncompress: bad input (compressed stream expected)"; 
-			return false
-		end;
-		new( huff ); 
-		while r.Available( ) >= 15 (* min size of a compressed block *) do
-			tree := BuildHuffmanTree( ReadFrequencies( r ) );
-			huff.ReadCode( r );
-			huff.DecodeBlock( tree,  buffer, chunksize );
-			r.RawLInt( bwIndex );
-			BWDecode( buffer, chunksize, bwIndex );
-			for i := 0 to chunksize - 1 do  w.Char( buffer[i] )  end
-		end;
-		w.Update;
-		return true
-	end Uncompress;
-		
-	
-	procedure BuildPatternFrequencies( var a: PatternArray ): PatternFrequencies;
-	var 
-		i, n, start: longint;  pf: PatternFrequencies;
-		
-		procedure SortPatterns( low, high: longint );  
-		var 
-			i, j, m: longint;  tmp: Pattern;
-		begin
-			if low < high then
-				i := low;  j := high;  m := (i + j) div 2;
-				repeat
-					while a[i].frequency < a[m].frequency do  inc( i )  end;
-					while a[j].frequency > a[m].frequency do  dec( j )  end;
-					if i <= j then
-						if i = m then  m := j  elsif j = m then  m := i  end;
-						tmp := a[i];  a[i] := a[j];  a[j] := tmp;
-						inc( i );  dec( j )
-					end;
-				until i > j;
-				SortPatterns( low, j );  SortPatterns( i, high )
-			end
-		end SortPatterns;
-		
-	begin
-		SortPatterns( 0, 255 );	(* sort patterns by frequency *)
-		i := 0;
-		while a[i].frequency = 0 do  inc( i )  end; 	(* skip unused patterns *)
-		n := 256 - i;  start := i;
-		new( pf, n );
-		for i := 0 to n - 1 do  pf[i] := a[start + i]  end;
-		return pf
-	end BuildPatternFrequencies;
-	
-	procedure CountPatterns( const block: array of char; blksize: longint ): PatternFrequencies;
-	var 
-		i: longint;  a: PatternArray;
-	begin
-		for i := 0 to 255 do  a[i].pattern := chr( i );  a[i].frequency := 0  end;
-		for i := 0 to blksize - 1 do  inc( a[ord( block[i] )].frequency )  end;
-		for i := 0 to 255 do  
-			if a[i].frequency > 0 then (* scale => [1..101H] *)
-				a[i].frequency := 100H * a[i].frequency div blksize + 1;
-			end
-		end;
-		return BuildPatternFrequencies( a )
-	end CountPatterns;
-		
-	
-	procedure BuildHuffmanTree( pf: PatternFrequencies ): HuffmanNode;
-	var 
-		i, start, top: longint;  n, n2: HuffmanNode;
-		a: pointer to array of HuffmanNode;
-		patt: char;
-	begin
-		new( a, len( pf^ ) );  top := len( pf^ ) - 1;
-		for i := 0 to top do  new( a[i], pf[i].pattern, pf[i].frequency )  end;
-		if top = 0 then  
-			(* the whole, probably last small block contains only a single pattern *)
-			patt := chr( (ord( a[0].pattern ) + 1) mod 256 );	(* some different pattern *)
-			new( n, 0X, 0 );  new( n2, patt, 0 );  n.AddChildren( n2, a[0] );
-		else
-			start := 0;  
-			while start < top do  
-				new( n, 0X, 0 );  n.AddChildren( a[start], a[start+1] ); 
-				i := start + 1;  
-				while (i < top) & (a[i+1].frequency < n.frequency) do  a[i] := a[i+1];  inc( i )  end;
-				a[i] := n;  
-				inc( start );
-			end
-		end;
-		return n
-	end BuildHuffmanTree;
-	
-	
-	procedure BuildCodeTable( huffmanTree: HuffmanNode ): CodeTable;
-	var 
-		start: Codebits; i: longint;
-		table: CodeTable;
-	
-		procedure Traverse( node: HuffmanNode;  bits: Codebits );
-		begin
-			if node.left = nil then  (* leaf *)
-				table[ord( node.pattern )] := bits;
-			else
-				inc( bits.bitsize );  
-				bits.val := 2*bits.val;  Traverse( node.right, bits );	(* ..xx0 *)
-				bits.val := bits.val + 1;  Traverse( node.left, bits );	(* ..xx1 *)
-			end;
-		end Traverse;
-	
-	begin
-		new( table );
-		for i := 0 to 255 do  table[i].bitsize := 0;  table[i].val := 0  end;
-		start.bitsize := 0;  start.val := 0;
-		Traverse( huffmanTree, start );
-		return table
-	end BuildCodeTable;
-	
-	
-	procedure ReadFrequencies( r: Streams.Reader ): PatternFrequencies;
-	var i, n: longint; 
-		pf: PatternFrequencies;
-		a: PatternArray;
-	begin
-		r.RawNum( n );  
-		if n > 0 then
-			new( pf, n );
-			for i := 0 to n - 1 do  r.RawNum( pf[i].frequency );  r.Char( pf[i].pattern )  end
-		else
-			for i := 0 to 255 do  a[i].pattern := chr( i );  r.RawNum( a[i].frequency )  end;
-			pf := BuildPatternFrequencies( a )
-		end;
-		return pf
-	end ReadFrequencies;
-	
-	procedure WriteFrequencies( pf: PatternFrequencies; w: Streams.Writer );
-	var i, n: longint;
-		a: array 256 of longint;
-	begin
-		n := len( pf^ );
-		if n < 128 then
-			w.RawNum( n );
-			for i := 0 to n - 1 do  w.RawNum( pf[i].frequency );  w.Char( pf[i].pattern )  end
-		else
-			w.RawNum( 0 );
-			for i := 0 to 255 do  a[i] := 0  end;
-			for i := 0 to n -1 do  a[ord( pf[i].pattern )] := pf[i].frequency  end;
-			for i := 0 to 255 do  w.RawNum( a[i] )  end
-		end
-	end WriteFrequencies;
-	
-	
-	(* Borrows Wheeler Transformation, Encode*)
-	procedure BWEncode( var buf: array of char; length: longint; var index: longint );
-	type
-		Rotation = record 
-			shift: longint; 
-			lastbyte: char  
-		end;
-	var 
-		i, j: longint;  r: pointer to array of Rotation;
-	
-		procedure Less( a, b: longint ): boolean;
-		var i, x1, x2, i1, i2: longint;  c1, c2: char;
-		begin
-			i := 0; x1 := r[a].shift;  x2 := r[b].shift;
-			repeat
-				i1 := x1 + i;  if i1 >= length then  dec( i1, length )  end;
-				i2 := x2 + i;  if i2 >= length then  dec( i2, length )  end;
-				c1 := buf[i1];  c2 := buf[i2];
-				if c1 < c2 then  return true  elsif c1 > c2 then  return false  end;
-				inc( i )
-			until i = length;
-			return false
-		end Less;
-				
-		procedure SortRotations( lo, hi: longint );
-		var i, j, m: longint;  tmp: Rotation;
-		begin
-			if lo < hi then
-				i := lo;  j := hi;  m := (lo + hi) div 2;
-				repeat
-					while Less( i, m ) do  inc( i )  end;  
-					while Less( m, j ) do  dec( j )  end;
-					if i <= j then
-						if m = i then  m := j  elsif  m = j then  m := i  end;
-						tmp := r[i];  r[i] := r[j];  r[j] := tmp;
-						inc( i );  dec( j )
-					end
-				until i > j;
-				SortRotations( lo, j );  SortRotations( i, hi )
-			end
-		end SortRotations;
-		
-	begin
-		new( r, length );
-		for i := 0 to length - 1 do
-			r[i].shift := i; 
-			if i = 0 then  j := length - 1  else  j := i - 1  end;
-			r[i].lastbyte := buf[j]
-		end;
-		SortRotations( 0, length - 1 );
-		(* replace buffer by column L *)
-		for i := 0 to length -1 do  buf[i] := r[i].lastbyte  end;
-		(* find index of the original row *)
-		index := 0;  while r[index].shift # 0 do  inc( index )  end;
-		MTFEncode( buf, length )
-	end BWEncode;
-	
-			
-	(* Borrows Wheeler Transformation, Decode*)	
-	procedure BWDecode( var buf: array of char; length, index: longint );
-	var 
-		l, f: pointer to array of char;
-		lc, fc: pointer to array of longint;
-		xn: array 256 of longint;  i, j, n: longint;
-		ch: char;
-		
-		procedure SortF( lo, hi: longint );
-		var i, j, m: longint;  tmp: char;
-		begin
-			if lo < hi then
-				i := lo;  j := hi;  m := (lo + hi) div 2;
-				repeat
-					while f[i] < f[m] do  inc( i )  end;  
-					while f[m] < f[j] do  dec( j )  end;
-					if i <= j then
-						if m = i then  m := j  elsif m = j then  m := i  end;
-						tmp := f[i];  f[i] := f[j];  f[j] := tmp;
-						inc( i );  dec( j )
-					end
-				until i > j;
-				SortF( lo, j );  SortF( i, hi )
-			end
-		end SortF;
-		
-	begin
-		MTFDecode( buf, length );
-		new( l, length );  new( f, length ); new( lc, length );  new( fc, length );
-		for i := 0 to 255 do  xn[i] := 0  end;
-		for i := 0 to length - 1 do 
-			l[i] := buf[i];  f[i] := l[i];
-			j := ord( l[i] );  lc[i] := xn[j];  inc( xn[j] )
-		end;
-		SortF( 0, length - 1 );
-		for i := 0 to 255 do  xn[i] := 0  end;
-		for i := 0 to length - 1 do 
-			j := ord( f[i] );  fc[i] := xn[j];  inc( xn[j] )
-		end;
-		for i := 0 to length - 1 do
-			ch := f[index];  n := fc[index];  buf[i] := ch;  index := 0;
-			while (l[index] # ch) or (lc[index] # n) do  inc( index )  end
-		end;
-	end BWDecode;
-	
-	
-	(* Borrows Wheeler move to front *)	
-	procedure MTFEncode( var buf: array of char;  length: longint );
-	var alpha, l, m: MTFList;  i, k: longint;  ch: char;
-	begin
-		alpha := nil;
-		for i := 0 to 255 do
-			new( l );  l.next := alpha;  l.byte := chr( 255 - i );  alpha := l;
-		end;
-		for i := 0 to length - 1 do
-			ch := buf[i];
-			if alpha.byte = ch then  k := 0
-			else
-				l := alpha;  m := alpha.next;  k := 1;
-				while m.byte # ch do  inc( k );  l := m;  m := m.next  end;
-				l.next := m.next;  m.next := alpha;  alpha := m
-			end;
-			buf[i] := chr( k )
-		end
-	end MTFEncode;
-			
-	(* Borrows Wheeler move to front *)	
-	procedure MTFDecode( var buf: array of char;  length: longint );
-	var alpha, l, m: MTFList;  i, c: longint;  ch: char; 
-	begin
-		alpha := nil;
-		for i := 0 to 255 do
-			new( l );  l.next := alpha;  l.byte := chr( 255 - i );  alpha := l;
-		end;
-		for i := 0 to length - 1 do
-			ch := buf[i];
-			if ch # 0X then 
-				c := ord( ch );  l := alpha;
-				while c > 1 do  l := l.next;  dec( c )  end;
-				m := l.next;  l.next := m.next;  m.next := alpha;  
-				alpha := m
-			end;
-			buf[i] := alpha.byte;
-		end
-	end MTFDecode;
-	
-	
-	procedure NewFile( const name: array of char ): Files.File;
-	var
-		name2: array 128 of char;  res: longint;
-	begin
-		if Files.Old( name ) # nil then
-			copy( name, name2);  Strings.Append( name2, ".Bak" );
-			Files.Rename( name, name2, res );
-			Log.String( "Backup created in " ); Log.String( name2 );  Log.Ln
-		end;
-		return Files.New( name )
-	end NewFile;
-	
-	(** OZip.CompressFile  infile [outfile] ~ *)
-	procedure CompressFile*( c: Commands.Context );
-	var
-		f1, f2: Files.File;
-		r: Files.Reader;  w: Files.Writer;
-		name1, name2: array 128 of char;
-	begin
-		if c.arg.GetString( name1 ) then
-			if ~c.arg.GetString( name2 ) then
-				name2 := name1;  Strings.Append( name2, Suffix )
-			end;
-			f1 := Files.Old( name1 );
-			if f1 # nil then
-				Files.OpenReader( r, f1, 0 ); 
-				f2 := NewFile( name2 );  Files.OpenWriter( w, f2, 0 );
-				Compress( r, w );  w.Update;  Files.Register( f2 );
-				Log.String( "Compression finished, outfile = " );  Log.String( name2 );  Log.Ln; 
-			else
-				c.error.String( "could not open file  " );  c.error.String( name1 );  c.error.Ln
-			end
-		else
-			c.error.String( "usage: OZip.CompressFile infile [outfile] ~ " );  c.error.Ln;
-		end;
-		c.error.Update
-	end CompressFile;
-	
-	
-	(** OZip.UncompressFile  infile [outfile] ~ *)
-	procedure UncompressFile*( c: Commands.Context );
-	var
-		f1, f2: Files.File;
-		r: Files.Reader;  w: Files.Writer;
-		name1, name2, msg: array 128 of char;
-	begin
-		if c.arg.GetString( name1 ) then
-			if ~c.arg.GetString( name2 ) then
-				name2 := name1;
-				if Strings.EndsWith( Suffix, name2 ) then  name2[Strings.Length( name2 ) - 3] := 0X
-				else  Strings.Append( name2, ".uncomp" )
-				end
-			end;
-			f1 := Files.Old( name1 );
-			if f1 # nil then
-				Files.OpenReader( r, f1, 0 );	 
-				f2 := NewFile( name2 );  Files.OpenWriter( w, f2, 0 );
-				if Uncompress( r, w, msg ) then
-					w.Update;  Files.Register( f2 );
-					Log.String( "Uncompression finished, outfile = " );  Log.String( name2 );  Log.Ln; 
-				else
-					c.error.String( msg );  c.error.Ln
-				end
-			else
-				c.error.String( "could not open file  " );  c.error.String( name1 );  c.error.Ln
-			end
-		else
-			c.error.String( "usage: OZip.UncompressFile infile [outfile] ~ " );  c.error.Ln;
-		end;
-		c.error.Update
-	end UncompressFile;
-	
-end OZip.
-
-
-	OZip.CompressFile   OZip.mod ~
-	OZip.CompressFile   OZip.Obj ~
-	OZip.CompressFile   summary.pdf ~
-		
-	OZip.UncompressFile   OZip.mod.oz  TTT.mod ~
-	OZip.UncompressFile   OZip.Obj.oz  TTT.Obj ~
-	OZip.UncompressFile   summary.pdf.oz  TTT.pdf ~
-	
-	System.Free OZip  ~
-	
-

source/Release.Tool

@@ -1523,7 +1523,7 @@ PACKAGE Contributions ARCHIVE "Contributions.zip" SOURCE "ContributionsSrc.zip"
 	PrettyPrint.Mod PrettyPrintHighlighter.XML
 
 	# streams and files compression
-	OZip.mod
+	Huffman.Mod BorrowsWheeler.Mod OZip.Mod
 
 	NbrInt8.Mod NbrInt16.Mod NbrInt32.Mod NbrInt64.Mod NbrInt.Mod NbrRat.Mod
 	NbrRe32.Mod NbrRe64.Mod NbrRe.Mod NbrCplx.Mod NbrStrings.Mod