home *** CD-ROM | disk | FTP | other *** search
/ HomeWare 14 / HOMEWARE14.bin / prog / qbcomprs.arj / DECODER4.BAS < prev    next >
BASIC Source File  |  1995-02-06  |  5KB  |  175 lines

  1. 'DECODER4.BAS - A static Huffman decompression program for PDS/QB4.5
  2. 'By Rich Geldreich 1992
  3. 'Replaces DECODER.BAS
  4. 'August 14th, 1992
  5. 'QuickBASIC users: you must change all of the "SSEG" string to "VARSEG"
  6. 'in this program with search and replace!
  7.  
  8. DEFINT A-Z
  9.  
  10. DECLARE SUB FillBuff ()
  11. DECLARE FUNCTION GetBit ()
  12. DECLARE FUNCTION RGDecode (InputFile$, OutputFile$)
  13.  
  14. CONST True = -1, False = 0, Null = -2, BufferLength = 16384
  15.  
  16. DIM SHARED Bits(8)
  17. DIM SHARED In.File, Buffer$, Address, EndAddress, BufferSeg
  18. DIM SHARED CurrentByte, BitsIn
  19. DIM SHARED ErrorStatus, ErrorNumber
  20.  
  21. 'Example usage:
  22. 'Decompresses "OUTPUT.HUF" to the file "TEST.TXT".
  23. 'RGDecode is a function which returns 0 if no error, otherwise it returns
  24. 'a QB error code.
  25.  
  26. E = RGDecode("OUTPUT.HUF", COMMAND$)
  27.  
  28. IF E <> 0 THEN PRINT "Error:"; E ELSE PRINT "Cool."
  29. END
  30.  
  31. DiskError:
  32.  ErrorStatus = True
  33.  ErrorNumber = ERR
  34. RESUME NEXT
  35.  
  36. SUB FillBuff
  37.     'Fill up the input buffer and setup the pointers to it
  38.     GET In.File, , Buffer$
  39.     A& = SADD(Buffer$): A& = A& - 65536 * (A& < 0)
  40.     BufferSeg = SSEG(Buffer$) + (A& \ 16)
  41.     Address = A& AND 15
  42.     EndAddress = Address + BufferLength
  43.     DEF SEG = BufferSeg
  44. END SUB
  45.  
  46. FUNCTION GetBit STATIC
  47.     'gets one bit from the input file, only used for reading in the tree
  48.     IF BitsIn < 0 THEN
  49.         Address = Address + 1
  50.         IF Address = EndAddress THEN FillBuff
  51.         CurrentByte = PEEK(Address): BitsIn = 7
  52.     END IF
  53.     GetBit = (CurrentByte AND Bits(BitsIn)): BitsIn = BitsIn - 1
  54. END FUNCTION
  55.  
  56. FUNCTION RGDecode (InputFile$, OutputFile$)
  57.     DIM LeftSon(255), RightSon(255)
  58.  
  59.     ErrorStatus = False: ErrorNumber = 0
  60.     ON ERROR GOTO DiskError
  61.  
  62.     'Setup the Bits() array- why use the READ command, which just takes
  63.     'up more EXE space?
  64.     Bits(0) = 1
  65.     Bits(1) = 2
  66.     Bits(2) = 4
  67.     Bits(3) = 8
  68.     Bits(4) = 16
  69.     Bits(5) = 32
  70.     Bits(6) = 64
  71.     Bits(7) = 128
  72.     Bits(8) = 256
  73.  
  74.     'Setup the input buffer(it will be initialized in the FillBuff sub)
  75.     Buffer$ = SPACE$(BufferLength)
  76.     Address = 0
  77.     EndAddress = 1
  78.     BitsIn = -1
  79.  
  80.     'Open the input file
  81.     In.File = FREEFILE
  82.     Out.File = In.File + 1
  83.     OPEN InputFile$ FOR INPUT AS In.File: CLOSE In.File
  84.     IF ErrorStatus THEN GOTO ByeBye
  85.     OPEN InputFile$ FOR BINARY AS In.File
  86.     
  87.     
  88.     GET In.File, , FileLength&
  89.     GET In.File, , TopOfTree
  90.     GET In.File, , RealIndex
  91.     IF ErrorStatus THEN GOTO ByeBye
  92.     
  93.     'Retrieve the tree
  94.     FOR A = 0 TO RealIndex
  95.         Son = 0
  96.         FOR C = 0 TO 8
  97.             IF GetBit THEN Son = Son + Bits(C)
  98.         NEXT
  99.         LeftSon(A) = Son - 256
  100.         Son = 0
  101.         FOR C = 0 TO 8
  102.             IF GetBit THEN Son = Son + Bits(C)
  103.         NEXT
  104.         RightSon(A) = Son - 256
  105.     NEXT
  106.     
  107.     'Setup the output buffer
  108.     A$ = SPACE$(BufferLength)
  109.     A& = SADD(A$): A& = A& - 65536 * (A& < 0)
  110.     OutputSeg = SSEG(A$) + (A& \ 16)
  111.     OAddress = A& AND 15
  112.     OEndAddress = OAddress + BufferLength
  113.     OStart = OAddress
  114.     IF ErrorStatus THEN GOTO ByeBye
  115.  
  116.     'open the output file
  117.     OPEN OutputFile$ FOR OUTPUT AS Out.File: CLOSE Out.File
  118.     IF ErrorStatus THEN GOTO ByeBye
  119.     OPEN OutputFile$ FOR BINARY AS Out.File
  120.     
  121.     'decompress the input file
  122.     FOR CurrentByte& = 1 TO FileLength&
  123.         'Set the peek segment to the input buffer
  124.         DEF SEG = BufferSeg
  125.     
  126.         'Start at the top of the tree. Go left if a "1" bit is received,
  127.         'otherwise go right. Stop when a character is encountered, write
  128.         'that character to the output file and do it all over again until
  129.         'complete.
  130.         A = TopOfTree
  131.         
  132.         DO
  133.             IF BitsIn < 0 THEN
  134.                 Address = Address + 1
  135.                 IF Address = EndAddress THEN
  136.                     FillBuff
  137.                     IF ErrorStatus THEN GOTO ByeBye
  138.                 END IF
  139.                 CurrentByte = PEEK(Address)
  140.                 BitsIn = 7
  141.             END IF
  142.             
  143.             IF (CurrentByte AND Bits(BitsIn)) THEN
  144.                 A = LeftSon(A)
  145.             ELSE
  146.                 A = RightSon(A)
  147.             END IF
  148.             
  149.             BitsIn = BitsIn - 1
  150.         LOOP UNTIL A < 0
  151.         
  152.         'POKE the character into the output buffer
  153.         DEF SEG = OutputSeg
  154.         POKE OAddress, A + 256
  155.         OAddress = OAddress + 1
  156.         'If output buffer full then dump it to the output file
  157.         IF OAddress = OEndAddress THEN
  158.             PUT Out.File, , A$
  159.             IF ErrorStatus THEN GOTO ByeBye
  160.             OAddress = OStart
  161.         END IF
  162.     NEXT
  163.     'Dump whatever's left to the output file
  164.     A$ = LEFT$(A$, OAddress - OStart)
  165.     PUT Out.File, , A$
  166.     
  167.  
  168.  
  169. ByeBye:
  170.     RGDecode = ErrorNumber
  171.     CLOSE In.File, Out.File
  172.     ON ERROR GOTO 0
  173. END FUNCTION
  174.  
  175.