home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPLZH025.ZIP / LZO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-01-04  |  3.4 KB  |  134 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N+,O+,R-,S+,V-,X+}
  2.  
  3. {
  4.    LZO.PAS - object-oriented interface for LZH.PAS
  5.  
  6.    LZH.PAS based on:
  7.  
  8.    LZHUF.C English version 1.0 based on Japanese version 29-NOV-1988
  9.    Haruhiko OKUMURA:   LZSS coded
  10.    Haruyasu YOSHIZAKI: Adaptive Huffman Coding coded
  11.    Kenji RIKITAKE:     Edited and translated to English
  12.    Peter Sawatzki,
  13.    Wayne Sullivan:     Converted to Turbo Pascal 5.0
  14.    Joe Jared:          Assembler (12/16/92)
  15.                        [still in progress]
  16.    Andres Cvitkovich:  object-oriented interface
  17.                        [to be continued?]
  18.  
  19.    note:  ONLY ONE INSTANCE OF THUFF (OR DERIVATES) MAY BE USED BY NOW.
  20.           YOU MUST ASSURE THIS IN YOUR PROGRAMS.
  21.           THAT MEANS, USAGE OF THUFF IS A 'CRITICAL SECTION'.
  22. }
  23.  
  24. unit LZO;
  25.  
  26. interface uses LZH;
  27.  
  28. const EngineVer = LZH.EngineVer;
  29.  
  30. type PHuff = ^THuff;
  31.      THuff = Object                     {*** abstract - inherit for use! ***}
  32.        Compressing: boolean;     { true on compression, false on decompress }
  33.        constructor Init;
  34.        destructor  Done; virtual;
  35.        function    Compress (Bytes: longint): longint; virtual;
  36.        procedure   Expand; virtual;
  37.        function    ReadBuf (var data; size: word): longint; virtual;
  38.        function    WriteBuf (var data; size: word): longint; virtual;
  39.                    { have to return n/of bytes actually read/written
  40.                      or -1 on error (unix-like) }
  41.        procedure   Error (code: integer); virtual;
  42.                    { code=0: error reading, 1: error writing }
  43.      END;
  44.  
  45. var LZHused: boolean;                         { true if unit already in use }
  46.  
  47. implementation
  48.  
  49. var ActualHuff: PHuff;
  50.  
  51. procedure ReadBufLo; far;               { lo-level procedure, called by LZH }
  52. var res: longint;
  53. begin
  54.   with LZHMem^ do begin
  55.     inptr := 0;
  56.     res   := ActualHuff^.ReadBuf (inbuf, SizeOf (inbuf));
  57.     if res = -1 then begin
  58.       ActualHuff^.Error (0);
  59.       inend := 0
  60.     end else
  61.       inend := word (res)
  62.   end
  63. end;
  64.  
  65. procedure WriteBufLo; far;              { lo-level procedure, called by LZH }
  66. begin
  67.   with LZHMem^ do begin
  68.     if ActualHuff^.WriteBuf (outbuf, outptr) <> outptr then
  69.       ActualHuff^.Error (1);
  70.     outptr := 0
  71.   end
  72. end;
  73.  
  74. constructor THuff.Init;
  75. begin
  76.   if LZHused then exit else LZHused := TRUE;
  77.   ActualHuff := @Self;
  78.   InitLZH;
  79.   LZHMem^.outend := SizeOf (LZHMem^.outbuf);          {> unsure about these }
  80.   LZHMem^.outptr := 0;                                {> two lines (placed) }
  81. end;
  82.  
  83. destructor THuff.Done;
  84. begin
  85.   ActualHuff := NIL;
  86.   DInitLZH;
  87.   LZHused := FALSE
  88. end;
  89.  
  90. function THuff.Compress (Bytes: longint): longint;
  91. begin
  92.   Compressing := TRUE;
  93.   {ReadBufLo;}
  94.   LZHMem^.Ebytes := Bytes;
  95.   Encode;
  96.   Compress := LZHMem^.codesize
  97. end;
  98.  
  99. procedure THuff.Expand;
  100. begin
  101.   Compressing := FALSE;
  102.  { ReadBufLo;}
  103.   Decode
  104. end;
  105.  
  106. function THuff.ReadBuf (var data; size: word): longint;
  107. begin
  108.   Writeln ('*** ABSTRACT METHOD HAS BEEN CALLED! ***');
  109.   Halt (255)
  110. end;
  111.  
  112. function THuff.WriteBuf (var data; size: word): longint;
  113. begin
  114.   Writeln ('*** ABSTRACT METHOD HAS BEEN CALLED! ***');
  115.   Halt (255)
  116. end;
  117.  
  118. procedure THuff.Error (code: integer);
  119. begin
  120.   Write ('*** ERROR ');
  121.   if code=0 then
  122.     Write ('READ')
  123.   else
  124.     Write ('WRIT');
  125.   Writeln ('ING DATA ***');
  126.   Halt (255)
  127. end;
  128.  
  129. begin
  130.   ReadToBuffer    := ReadBufLo;
  131.   WriteFromBuffer := WriteBufLo;
  132.   LZHused := FALSE
  133. end.
  134.