LZW compresor

Una unidad LZW para comprimir archivos

Contribuyente: IAN HUNTER

(*
De: IAN HUNTER
Asunto: Unidad de compresión LZW
*)

Unidad IHLZW;
(- Unidad para manejar la compresión de datos)
Interface
Const
StackOverFlow = 1;
DeniedWrite = 2;
Tipo
GetCharFunc = function (Var Ch: Car): Boolean;
PutCharProc = Procedimiento (Ch: Car);
LZW = Objeto
Getchar: GetCharFunc;
Putchar: PutCharProc;
LastError: Word;
Constructor de inicio;
Función Get_Hash_Code (PrevC, FollC: Integer): Integer;
Procedimiento Make_Table_Entry (PrevC, FollC: Integer);
Procedimiento Initialize_String_Table;
Iniciar procedimiento;
Función Lookup_String (PrevC, FollC: Integer): Integer;
Procedimiento Get_Char (Var C: Integer);
Procedimiento Put_Char (C: Integer);
Comprimir procedimiento;
Descomprimir procedimiento;
Fin;

Aplicación
Const
MaxTab = 4095;
No_Prev = $ 7FFF;
EOF_Char = -2;
End_List = -1;
Vacío = -3;

Tipo
AnyStr = String;
String_Table_Entry = record
Utilizado: Boolean;
PrevChar: Integer;
FollChar: Integer;
Siguiente: Integer;
Fin;

Var
String_Table: Array [0 .. MaxTab] De String_Table_Entry;
Table_Used: Integer;
Output_Code: Integer;
Input_Code: Integer;
If_Compressing: Boolean;

Constructor LZW.Init;
Empezar
LastError: = 0;
Fin;

Función LZW.Get_Hash_Code (PrevC, FollC: Integer): Integer;
Var
Index: Integer;
Index2: Integer;
Empezar
Índice: = ((PrevC SHL 5) XOR FollC) Y MaxTab;
Si (No String_Table [Inicio]. Utilizado)
Entonces
Get_Hash_Code: = Índice de
Algo más
Empezar
Si bien (String_Table [Inicio]. Siguiente <> End_List) Do
Index: = String_Table [Inicio]. Siguiente;
Index2: = (Index + 101) y MaxTab;
Si bien (String_Table [Index2]. Utilizado) Do
Index2: = Succ (Index2) Y MaxTab;
String_Table [Inicio]. Siguiente: = Index2;
Get_Hash_Code: = Index2;
Fin;
Fin;

Procedimiento LZW.Make_Table_Entry (PrevC, FollC: Integer);
Empezar
Si (Table_Used <= MaxTab)
Entonces
Empezar
Con String_Table [Get_Hash_Code (PrevC, FollC)] Do
Empezar
Utilizado: = True;
Siguiente: = End_List;
PrevChar: = PrevC;
FollChar: = FollC;
Fin;
Inc (Table_Used);
(*
SI (Table_Used> (MaxTab + 1)) ENTONCES
COMENZAR
WriteLn ( 'hash cuadro completo. ");
END;
*)
Fin;
Fin;

Procedimiento LZW.Initialize_String_Table;
Var
I: Integer;
Empezar
Table_Used: = 0;
Para I: = 0 a MaxTab Do
Con String_Table [I] Do
Empezar
PrevChar: = No_Prev;
FollChar: = No_Prev;
Siguiente: = -1;
Utilizado: = False;
Fin;
Para I: = 0 a 255 Do
Make_Table_Entry (No_Prev, I);
Fin;

Procedimiento LZW.Initialize;
Empezar
Output_Code: = vacío;
Input_Code: = vacío;
Initialize_String_Table;
Fin;

Función LZW.Lookup_String (PrevC, FollC: Integer): Integer;
Var
Index: Integer;
Index2: Integer;
Se han encontrado: Boolean;
Empezar
Índice: = ((PrevC SHL 5) Xor FollC) Y MaxTab;
Lookup_String: = End_List;
Repita
Se han encontrado: = (String_Table [Inicio]. PrevChar = PrevC) Y
(String_Table [Inicio]. FollChar = FollC);
Si (Not Found)
Entonces
Index: = String_Table [Inicio]. Siguiente;
Hasta que se encontró o (Indice = End_List);
Si se encuentran
Entonces
Lookup_String: = índice;
Fin;

Procedimiento LZW.Get_Char (Var C: Integer);
Var
Ch: Char;
Empezar
Si no getchar (Ch)
Entonces
C: = EOF_Char
Algo más
C: = Ord (Ch);
Fin;

Procedimiento LZW.Put_Char (C: Integer);
Var
Ch: Char;
Empezar
Ch: = Chr (C);
Putchar (Ch);
Fin;

Procedimiento LZW.Compress;
Procedimiento Put_Code (Hash_Code: Integer);
Empezar
Si (Output_Code = vacío)
Entonces
Empezar
Put_Char ((Hash_Code SHR 4) y $ FF);
Output_Code: Y = Hash_Code $ 0F;
Final
Algo más
Empezar
Put_Char (((Output_Code SHL 4) y $ FF0) +
((Hash_Code SHR 8) y $ 00F));
Put_Char (Hash_Code Y $ FF);
Output_Code: = vacío;
Fin;
Fin;

Procedimiento Do_Compression;
Var
C: Integer;
WC: Integer;
W: Integer;
Empezar
Get_Char (C);
W: = Lookup_String (No_Prev, C);
Get_Char (C);
Si bien (C <> EOF_Char) Do
Empezar
WC: Lookup_String = (W, C);
Si (WC = End_List)
Entonces
Empezar
Make_Table_Entry (W, C);
Put_Code (W);
W: = Lookup_String (No_Prev, C);
Final
Algo más
W: = WC;
Get_Char (C);
Fin;
Put_Code (W);
Fin;

Empezar
If_Compressing: = True;
Iniciar;
Do_Compression;
Fin;

Procedimiento LZW.Decompress;
Const
MaxStack = 4096;
Var
Pila: array [1 .. MaxStack] of Integer;
Stack_Pointer: Integer;

Procedimiento Push (C: Integer);
Empezar
Inc (Stack_Pointer);
Pila [Stack_Pointer]: = C;
Si (Stack_Pointer> = MaxStack)
Entonces
Empezar
LastError: = 1;
Exit;
Fin;
Fin;

Procedimiento Pop (Var C: Integer);
Principio;
Si (Stack_Pointer> 0)
Entonces
Empezar
C: = pila [Stack_Pointer];
Diciembre (Stack_Pointer);
Final
Algo más
C: = vacío;
Fin;

Procedimiento Get_Code (Var Hash_Code: Integer);
Var
Local_Buf: Integer;
Empezar
Si (Input_Code = vacío)
Entonces
Empezar
Get_Char (Local_Buf);
Si (Local_Buf = EOF_Char)
Entonces
Empezar
Hash_Code: = EOF_Char;
Exit;
Fin;
Get_Char (Input_Code);
Si (Input_Code = EOF_Char)
Entonces
Empezar
Hash_Code: = EOF_Char;
Exit;
Fin;
Hash_Code: = ((Local_Buf SHL 4) y $ FF0) +
((Input_Code SHR 4) y $ 00F);
Input_Code: Y = Input_Code $ 0F;
Final
Algo más
Empezar
Get_Char (Local_Buf);
Si (Local_Buf = EOF_Char)
Entonces
Empezar
Hash_Code: = EOF_Char;
Exit;
Fin;
Hash_Code: Local_Buf = + ((Input_Code SHL 8) y $ F00);
Input_Code: = vacío;
Fin;
Fin;

Procedimiento Do_Decompression;
Var
C: Integer;
Código: Integer;
Old_Code: Integer;
Fin_Char: Integer;
In_Code: Integer;
Last_Char: Integer;
Desconocido: Boolean;
Temp_C: Integer;
Empezar
Stack_Pointer: = 0;
Desconocido: = False;
Get_Code (Old_Code);
Código: = Old_Code;
C: = String_Table [Código]. FollChar;
Put_Char (C);
Fin_Char: = C;
Get_Code (In_Code);
Si bien (In_Code <> EOF_Char) Do
Empezar
Código: = In_Code;
Si (No String_Table [Código]. Utilizado)
Entonces
Empezar
Last_Char: = Fin_Char;
Código: = Old_Code;
Desconocido: = True;
Fin;
Si bien (String_Table [Código]. PrevChar <> No_Prev) Do
Con String_Table [Código] Do
Empezar
Push (FollChar);
Si (LastError <> 0)
Entonces
Exit;
Código: = PrevChar;
Fin;
Fin_Char: = String_Table [Código]. FollChar;
Put_Char (Fin_Char);
Pop (Temp_C);
Si bien (Temp_C <> vacío) Do
Empezar
Put_Char (Temp_C);
Pop (Temp_C);
Fin;
Si Desconocida
Entonces
Empezar
Fin_Char: = Last_Char;
Put_Char (Fin_Char);
Desconocido: = false;
Fin;
Make_Table_Entry (Old_Code, Fin_Char);
Old_Code: = In_Code;
Get_Code (In_Code);
Fin;
Fin;

Empezar
If_Compressing: = False;
Iniciar;
Do_Decompression;
Fin;

Final.

(* ***************************** Programa de prueba ***************** * *)

Programa LZWTest;
(Programa de demostración / prueba LZW el objeto)
Utilización
IHLZW; (Sólo necesita esta)
Var
C: LZW; (La estrella del espectáculo, la compresión de objetos)

$ F (+) Función GetTheChar (Var Ch: Car): Boolean; ($ F-)
(Haz tu rutina getchar la declaración de mirar exactamente como esta)

Empezar
Si no EF (entrada) (Fin de la entrada? )
Entonces
Empezar
Leer (entrada, Ch); (Entonces lee un carácter en CH y ... )
GetTheChar: = True; (... Regresa verdadero)
Final
Algo más
GetTheChar: = False; (En caso contrario devuelva False)
Fin;

$ F (+) Procedimiento PutTheChar (Ch: Car); ($ F-)
(Haz tu rutina putchar la declaración de mirar exactamente como esta)

Empezar
Escribir (de salida, Ch); (Escribir canal de salida a archivo)
Fin;

Empezar
(Abrir archivos de datos)
Asignar (de entrada,''); (entrada estándar; reorientación requiere para ser útil)
Asignar (Producto,''); (salida estándar; reorientación requiere para ser útil)
Reset (Entrada);
Reescribir (de salida);
(No puede dejar todavía - quizás un descendiente podría, aunque ... )
Si no init C.
Entonces
Detener;
(Asignar I / O rutinas)
C. getchar: = GetTheChar; (Set LZW getchar a la rutina GetTheChar)
C. putchar: = PutTheChar; (Set LZW putchar a la rutina PutTheChar)
(Se nos comprimir o descomprimir? )
Si (ParamCount = 0)
Entonces
C. comprimir Comprimir ()
Algo más
Descomprimir C.;) (descomprimir
(Todos los Hecho! )
Final.