home *** CD-ROM | disk | FTP | other *** search
- {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}{$M 49152,0,0}
- Program CompRaw(Output);
- {
- Raw Sound Lossy [De]compression Program Version 1.00
- Copyright (c) 1992 François Jalbert (jalbert@IRO.UMontreal.CA)
-
- Turbo-Pascal 5.0 (c) 1988 Borland International
- LZEXE 0.91 (c) 1989 Fabrice Bellard
-
- Error Levels: 0 - Normal termination.
- 1 - Command line parameter error.
- 2 - I/O error.
- }
- Const
- MaxBufferSize=32768; { Multiple of 8 }
-
- Type
- BufferRange=1..MaxBufferSize;
- BufferRange0=0..MaxBufferSize;
- BufferType=Record
- BufferItself:Array [BufferRange] of Byte;
- BufferSize:BufferRange0
- End;
- HandleType=Record
- HandleName:String;
- HandleFile:File
- End;
-
- Var
- Compress:Boolean; {[De]compression Flag (True or False)}
- Rate:Byte; {[De]compression Rate (1 to 7)}
- Buffer:BufferType; {I/O Buffer}
- InHandle,OutHandle:HandleType; {Input and Output File Handles}
-
- {------------------------------- ReadParameters -------------------------------}
-
- Procedure Ooops(Var Error:Boolean; Message:String);
- {Set error flag and print error message}
- Begin
- Error:=True;
- Writeln(^G+'Error: '+Message)
- End;
-
- Procedure ReadOperation(Var Compress,CompSet:Boolean; Var Rate:Byte;
- Var RateSet,Error:Boolean; Var Param:String;
- ParamLength:Integer);
- {Sets one operation parameter according to one command line parameter}
- Begin
- If ParamLength<>2 Then
- Ooops(Error,'Parameter too long: '+Param)
- Else
- Case Param[2] Of
- 'd','D':If CompSet Then
- Ooops(Error,'Unexpected parameter: '+Param)
- Else
- Begin
- CompSet:=True;
- Compress:=False;
- Writeln('Decompression operation.')
- End;
- 'c','C':If CompSet Then
- Ooops(Error,'Unexpected parameter: '+Param)
- Else
- Begin
- CompSet:=True;
- Compress:=True;
- Writeln('Compression operation.')
- End;
- '1'..'7':If RateSet Then
- Ooops(Error,'Unexpected parameter: '+Param)
- Else
- Begin
- RateSet:=True;
- Rate:=Ord(Param[2])-Ord('0');
- Writeln('Rate is 8 to '+Param[2]+'.')
- End
- Else
- Ooops(Error,'Unrecognized parameter: '+Param)
- End
- End;
-
- Procedure ReadHandleName(Var InSet,OutSet,Error:Boolean; Var Param:String;
- Var InHandle,OutHandle:HandleType);
- {Sets one file handle according to one command line parameter}
- Begin
- If InSet Then
- If OutSet Then
- Ooops(Error,'Unexpected parameter: '+Param)
- Else
- Begin
- OutSet:=True;
- OutHandle.HandleName:=Param;
- Writeln('Output file name: '+OutHandle.HandleName+'.')
- End
- Else
- Begin
- InSet:=True;
- InHandle.HandleName:=Param;
- Writeln('Input file name: '+InHandle.HandleName+'.')
- End
- End;
-
- Procedure ReadParameters(Var Compress:Boolean; Var Rate:Byte;
- Var InHandle,OutHandle:HandleType);
- {Sets all parameters according to command line parameters}
- Var
- InSet,OutSet,CompSet,RateSet,Error:Boolean;
- Param:String;
- ParamIndex,ParamLength:Word;
- Begin
- InSet:=False;
- OutSet:=False;
- CompSet:=False;
- RateSet:=False;
- If ParamCount=0 Then
- Error:=True
- Else
- Begin
- Error:=False;
- For ParamIndex:=1 To ParamCount Do
- Begin;
- Param:=ParamStr(ParamIndex);
- ParamLength:=Length(Param);
- If (Param[1]='/') OR (Param[1]='-') Then
- ReadOperation(Compress,CompSet,Rate,RateSet,Error,Param,ParamLength)
- Else
- ReadHandleName(InSet,OutSet,Error,Param,InHandle,OutHandle)
- End;
- If NOT InSet Then
- Ooops(Error,'Input file name not specified on command line');
- If NOT OutSet Then
- Ooops(Error,'Output file name not specified on command line');
- If NOT CompSet Then
- Ooops(Error,'Operation type not specified on command line');
- If NOT RateSet Then
- Ooops(Error,'Rate not specified on command line')
- End;
- If Error Then
- Begin
- If ParamCount>0 Then Writeln;
- Writeln('Syntax is COMPRAW <infile> <outfile> /<rate> < /c | /d >');
- Halt(1)
- End
- End;
-
- {----------------------------------- Files ------------------------------------}
-
- Procedure CheckError(Message:String);
- {In case of I/O error, prints message and aborts program}
- Begin
- If IOResult<>0 Then
- Begin
- Writeln;
- Writeln(^G+'Error: '+Message);
- Halt(2)
- End
- End;
-
- Procedure OpenHandles(Var InHandle,OutHandle:HandleType);
- {Opens input and output file handles}
- Begin
- With InHandle Do
- Begin
- Assign(HandleFile,HandleName);
- CheckError('Can''t assign input file to its name');
- FileMode:=0;
- Reset(HandleFile,1);
- CheckError('Can''t open input file')
- End;
- With OutHandle Do
- Begin
- Assign(HandleFile,HandleName);
- CheckError('Can''t assign output file to its name');
- FileMode:=1;
- Rewrite(HandleFile,1);
- CheckError('Can''t create output file')
- End
- End;
-
- Procedure ReadBuffer(Var InHandle:HandleType; Var Buffer:BufferType);
- {Reads as many bytes as possible into the buffer}
- Var Result:Word;
- Begin
- With InHandle,Buffer Do
- Begin
- BlockRead(HandleFile,BufferItself,MaxBufferSize,Result);
- CheckError('Can''t read input file');
- BufferSize:=Result
- End
- End;
-
- Procedure WriteBuffer(Var OutHandle:HandleType; Var Buffer:BufferType);
- {Writes the buffer}
- Var Result:Word;
- Begin
- With OutHandle,Buffer Do
- Begin
- BlockWrite(HandleFile,BufferItself,BufferSize,Result);
- CheckError('Can''t write output file');
- If Result<BufferSize Then
- Begin
- Writeln;
- Writeln(^G+'Error: Disk full');
- Halt(2)
- End
- End
- End;
-
- Procedure CloseHandles(Var InHandle,OutHandle:HandleType);
- {Closes input and output file handles}
- Begin
- Close(InHandle.HandleFile);
- CheckError('Can''t close input file');
- Close(OutHandle.HandleFile);
- CheckError('Can''t close output file')
- End;
-
- {-------------------------------- Compression ---------------------------------}
-
- Procedure Compression(Var Buffer:BufferType; Rate:Byte);
- {Performs compression of bytes in the buffer}
- Var
- Index:Word;
- Data,Offset,Mask,Limit:Byte;
- Begin
- Offset:=$80 SHR Rate;
- Mask:=$FF SHL (8-Rate);
- Limit:=Mask+Offset-1;
- With Buffer Do
- For Index:=1 To BufferSize Do
- Begin
- Data:=BufferItself[Index];
- {Shifts according to simple log 2 table}
- Case Data Of
- $C0..$FF:Data:=$E0+( (Data-$C0) SHR 1 );
- $A0..$BF:Data:=$C0+(Data-$A0);
- $80..$99:Data:=$80+( (Data-$80) SHL 1 );
- $60..$7F:Data:=$80-( ($80-Data) SHL 1 );
- $40..$5F:Data:=$40-($60-Data);
- $00..$3F:Data:=$20-( ($40-Data) SHR 1 )
- End;
- If Data>Limit Then
- {Avoids overflow}
- BufferItself[Index]:=Mask
- Else
- {Centers byte and zeros out the least significant bits}
- BufferItself[Index]:=(Data+Offset) AND Mask
- End
- End;
-
- {------------------------------- Decompression --------------------------------}
-
- Procedure Decompression(Var Buffer:BufferType; Rate:Byte);
- {Performs decompression of bytes in the buffer}
- Var
- BeginIndex,EndIndex,Number,Index,BeginSide,EndSide:Word;
- Offset,Data:Byte;
- LOffset,LOffset1,LNumber1:LongInt;
- BOffset2,Identical,BeginHigher,EndHigher:Boolean;
- Begin
- {Sets centering related data}
- Offset:=$80 SHR Rate;
- LOffset:=LongInt(Offset);
- LOffset1:=LongInt(Offset-1);
- BOffset2:=(Offset>2);
- With Buffer Do
- Begin
- EndIndex:=BufferSize;
- Repeat
- {Sets begin data, when possible}
- BeginIndex:=EndIndex;
- If BeginIndex<BufferSize Then
- BeginHigher:=NOT EndHigher;
- {Sets end data, when possible}
- Data:=BufferItself[BeginIndex];
- Identical:=True;
- While (EndIndex>0) AND Identical Do
- If BufferItself[EndIndex]<>Data Then
- Identical:=False
- Else
- EndIndex:=EndIndex-1;
- If EndIndex>0 Then
- EndHigher:=(BufferItself[EndIndex]>Data);
- {Finds the length of the two sub-plateaus of the current main plateau}
- Number:=BeginIndex-EndIndex;
- If Number>0 Then
- Number:=(Number-1) div 2;
- {Processes each sub-plateau, if they exist and Offset is greater than 1}
- If (Number>0) AND (Offset>1) Then
- Begin
- LNumber1:=LongInt(Number+1);
- {From center toward start of buffer, if not at start of buffer}
- If BeginIndex<BufferSize Then
- Begin
- {Finds one starting point}
- BeginSide:=BeginIndex-Number;
- If BeginHigher Then
- {Goes up from 0 to Offset-1, if Offset-1 is greater than 1}
- If BOffset2 Then
- For Index:=1 To Number Do
- BufferItself[BeginSide+Index]:=
- Data+Byte( (LongInt(Index)*LOffset1) div LNumber1 )
- Else
- Else
- {Goes down from 0 to Offset, and Offset is known greater than 1}
- For Index:=1 To Number Do
- BufferItself[BeginSide+Index]:=
- Data-Byte( (LongInt(Index)*LOffset) div LNumber1 )
- End;
- {From center downwards end of buffer, if not at end of buffer}
- If EndIndex>0 Then
- Begin
- {Finds one starting point}
- EndSide:=EndIndex+1+Number;
- If EndHigher Then
- {Goes up from 0 to Offset-1, if Offset-1 is greater than 1}
- If BOffset2 Then
- For Index:=1 To Number Do
- BufferItself[EndSide-Index]:=
- Data+Byte( (LongInt(Index)*LOffset1) div LNumber1 )
- Else
- Else
- {Goes down from 0 to Offset, and Offset is known greater than 1}
- For Index:=1 To Number Do
- BufferItself[EndSide-Index]:=
- Data-Byte( (LongInt(Index)*LOffset) div LNumber1 )
- End
- End
- Until EndIndex=0;
- {Shifts according to simple log 2 table}
- For Index:=1 To BufferSize Do
- Begin
- Data:=BufferItself[Index];
- Case Data Of
- $E0..$FF:BufferItself[Index]:=$C0+( (Data-$E0) SHL 1 );
- $C0..$DF:BufferItself[Index]:=$A0+(Data-$C0);
- $80..$BF:BufferItself[Index]:=$80+( (Data-$80) SHR 1 );
- $40..$7F:BufferItself[Index]:=$80-( ($80-Data) SHR 1 );
- $20..$3F:BufferItself[Index]:=$60-($40-Data);
- $00..$1F:BufferItself[Index]:=$40-( ($20-Data) SHL 1 )
- End
- End
- End
- End;
-
- {------------------------------------------------------------------------------}
-
- Begin
- Writeln;
- Writeln('Raw Sound Lossy [De]compression Program'); {To make Borland happy}
- Writeln('Version 1.00 Copyright F. Jalbert 1992');
- Writeln;
- ReadParameters(Compress,Rate,InHandle,OutHandle);
- OpenHandles(InHandle,OutHandle);
- Repeat
- ReadBuffer(InHandle,Buffer);
- If Buffer.BufferSize>0 Then
- Begin
- If Compress Then
- Compression(Buffer,Rate)
- Else
- Decompression(Buffer,Rate);
- WriteBuffer(OutHandle,Buffer)
- End
- Until Buffer.BufferSize=0;
- CloseHandles(InHandle,OutHandle);
- End.
-