home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HomeWare 14
/
HOMEWARE14.bin
/
prog
/
qbcomprs.arj
/
DECODER4.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-02-06
|
5KB
|
175 lines
'DECODER4.BAS - A static Huffman decompression program for PDS/QB4.5
'By Rich Geldreich 1992
'Replaces DECODER.BAS
'August 14th, 1992
'QuickBASIC users: you must change all of the "SSEG" string to "VARSEG"
'in this program with search and replace!
DEFINT A-Z
DECLARE SUB FillBuff ()
DECLARE FUNCTION GetBit ()
DECLARE FUNCTION RGDecode (InputFile$, OutputFile$)
CONST True = -1, False = 0, Null = -2, BufferLength = 16384
DIM SHARED Bits(8)
DIM SHARED In.File, Buffer$, Address, EndAddress, BufferSeg
DIM SHARED CurrentByte, BitsIn
DIM SHARED ErrorStatus, ErrorNumber
'Example usage:
'Decompresses "OUTPUT.HUF" to the file "TEST.TXT".
'RGDecode is a function which returns 0 if no error, otherwise it returns
'a QB error code.
E = RGDecode("OUTPUT.HUF", COMMAND$)
IF E <> 0 THEN PRINT "Error:"; E ELSE PRINT "Cool."
END
DiskError:
ErrorStatus = True
ErrorNumber = ERR
RESUME NEXT
SUB FillBuff
'Fill up the input buffer and setup the pointers to it
GET In.File, , Buffer$
A& = SADD(Buffer$): A& = A& - 65536 * (A& < 0)
BufferSeg = SSEG(Buffer$) + (A& \ 16)
Address = A& AND 15
EndAddress = Address + BufferLength
DEF SEG = BufferSeg
END SUB
FUNCTION GetBit STATIC
'gets one bit from the input file, only used for reading in the tree
IF BitsIn < 0 THEN
Address = Address + 1
IF Address = EndAddress THEN FillBuff
CurrentByte = PEEK(Address): BitsIn = 7
END IF
GetBit = (CurrentByte AND Bits(BitsIn)): BitsIn = BitsIn - 1
END FUNCTION
FUNCTION RGDecode (InputFile$, OutputFile$)
DIM LeftSon(255), RightSon(255)
ErrorStatus = False: ErrorNumber = 0
ON ERROR GOTO DiskError
'Setup the Bits() array- why use the READ command, which just takes
'up more EXE space?
Bits(0) = 1
Bits(1) = 2
Bits(2) = 4
Bits(3) = 8
Bits(4) = 16
Bits(5) = 32
Bits(6) = 64
Bits(7) = 128
Bits(8) = 256
'Setup the input buffer(it will be initialized in the FillBuff sub)
Buffer$ = SPACE$(BufferLength)
Address = 0
EndAddress = 1
BitsIn = -1
'Open the input file
In.File = FREEFILE
Out.File = In.File + 1
OPEN InputFile$ FOR INPUT AS In.File: CLOSE In.File
IF ErrorStatus THEN GOTO ByeBye
OPEN InputFile$ FOR BINARY AS In.File
GET In.File, , FileLength&
GET In.File, , TopOfTree
GET In.File, , RealIndex
IF ErrorStatus THEN GOTO ByeBye
'Retrieve the tree
FOR A = 0 TO RealIndex
Son = 0
FOR C = 0 TO 8
IF GetBit THEN Son = Son + Bits(C)
NEXT
LeftSon(A) = Son - 256
Son = 0
FOR C = 0 TO 8
IF GetBit THEN Son = Son + Bits(C)
NEXT
RightSon(A) = Son - 256
NEXT
'Setup the output buffer
A$ = SPACE$(BufferLength)
A& = SADD(A$): A& = A& - 65536 * (A& < 0)
OutputSeg = SSEG(A$) + (A& \ 16)
OAddress = A& AND 15
OEndAddress = OAddress + BufferLength
OStart = OAddress
IF ErrorStatus THEN GOTO ByeBye
'open the output file
OPEN OutputFile$ FOR OUTPUT AS Out.File: CLOSE Out.File
IF ErrorStatus THEN GOTO ByeBye
OPEN OutputFile$ FOR BINARY AS Out.File
'decompress the input file
FOR CurrentByte& = 1 TO FileLength&
'Set the peek segment to the input buffer
DEF SEG = BufferSeg
'Start at the top of the tree. Go left if a "1" bit is received,
'otherwise go right. Stop when a character is encountered, write
'that character to the output file and do it all over again until
'complete.
A = TopOfTree
DO
IF BitsIn < 0 THEN
Address = Address + 1
IF Address = EndAddress THEN
FillBuff
IF ErrorStatus THEN GOTO ByeBye
END IF
CurrentByte = PEEK(Address)
BitsIn = 7
END IF
IF (CurrentByte AND Bits(BitsIn)) THEN
A = LeftSon(A)
ELSE
A = RightSon(A)
END IF
BitsIn = BitsIn - 1
LOOP UNTIL A < 0
'POKE the character into the output buffer
DEF SEG = OutputSeg
POKE OAddress, A + 256
OAddress = OAddress + 1
'If output buffer full then dump it to the output file
IF OAddress = OEndAddress THEN
PUT Out.File, , A$
IF ErrorStatus THEN GOTO ByeBye
OAddress = OStart
END IF
NEXT
'Dump whatever's left to the output file
A$ = LEFT$(A$, OAddress - OStart)
PUT Out.File, , A$
ByeBye:
RGDecode = ErrorNumber
CLOSE In.File, Out.File
ON ERROR GOTO 0
END FUNCTION