'===========================================================================
' Subject: EX-PACK DECOMPRESSOR V0.80         Date: 11-28-97 (22:10)       
'  Author: Andrew Nagy                        Code: QB, PDS                
'  Origin: nagyi@bigfoot.com                Packet: PACKER.ABC
'===========================================================================
DECLARE SUB Help ()
DEFINT A-Z
DECLARE SUB PutByte (a)
DECLARE SUB Rebuild.Table (New.Entries)
DECLARE FUNCTION GetCode ()
DECLARE FUNCTION GetByte ()
CONST True = -1, False = 0
ON ERROR GOTO hiba
'Prefix & Suffix of each code
DIM SHARED Prefix(4096), Suffix(4096), Used(4096)
DIM SHARED ver$
DIM OutCode(4096)               'simulates a hardware stack

'Input and output disk buffers
DIM SHARED InBuffer$, IAddress, IEndAddress, Iseg
DIM SHARED OutBuffer$, OStartAddress, OAddress, OEndAddress, Oseg

'Used for screen updating
DIM SHARED BytesIn&

'VERSION#
'------------------------------------------------------------------
ver$ = "0.80"
'------------------------------------------------------------------

'Powers of two
DIM SHARED Powers(7)
DIM SHARED LongPowers(12) AS LONG
'Mask for each codesize
DIM SHARED Masks(12)
'Current codesize
DIM SHARED CodeSize
'Initialize each array
IF COMMAND$ = "" THEN CALL Help
FOR a = 0 TO 7: Powers(a) = 2 ^ a: NEXT
FOR a = 0 TO 12: LongPowers(a) = 2 ^ a: NEXT
FOR a = 1 TO 12: Masks(a) = (2 ^ a) - 1: NEXT
'Turn on cursor
LOCATE , , 1
'Initialize each disk buffer
InBuffer$ = STRING$(5000, 0)
OutBuffer$ = STRING$(5000, 0)
'Find address of output buffer
a& = SADD(OutBuffer$)
a& = a& - 65536 * (a& < 0)
Oseg = VARSEG(OutBuffer$) + (a& \ 16)
OAddress = (a& MOD 16)
OEndAddress = OAddress + 5000
OStartAddress = OAddress
BytesIn& = 0
'Open files
OPEN COMMAND$ FOR BINARY AS #1
CLS
i$ = STRING$(7, 0)
GET #1, , i$
PRINT i$
IF i$ = "EXP0.80" THEN i$ = "EXP0.76": idv = 1
IF i$ = "EXP0.76" THEN GOTO exp7 ELSE GOTO sdf
sdf:
id$ = STRING$(8, 0)
sedd$ = STRING$(1, 0)
ax$ = STRING$(12, 0)
crc$ = STRING$(1, 0)
dt$ = STRING$(10, 0)
GET #1, , id$
PRINT id$
IF id$ = "EXP0.45A" OR id$ = "EXP0.50A" OR id$ = "EXP0.60A" OR id$ = "EXP0.70B" OR id$ = "EXP0.76G" THEN GOTO oksi ELSE RESET: PRINT "Not a valid packed file.": END
oksi:
IF id$ = "EXP0.45A" THEN
GET #1, , ax$
GOTO ok
END IF
IF id$ = "EXP0.50A" THEN
GET #1, , ax$
GET #1, , dt$
GOTO ok
END IF
IF id$ = "EXP0.60A" THEN
GET #1, , ax$
GET #1, , dt$
GOTO ok
END IF
IF id$ = "EXP0.70B" THEN
GET #1, , ax$
GET #1, , dt$
GET #1, , crc$
GOTO ok
END IF
IF id$ = "EXP0.76G" THEN
GET #1, , ax$
GET #1, , dt$
GET #1, , crc$
GET #1, , sedd$
'PRINT crc$
'PRINT sedd$
'END
IF sedd$ = "Y" THEN spc$ = STRING$(24, 0): GET #1, , spc$
IF spc$ = "" THEN GOTO ok ELSE
FOR tt = 1 TO LEN(spc$)
    yq% = 0
    xq% = ASC(MID$(spc$, tt, 1))
    'PRINT x%
    IF (xq% > 64 AND xq% < 91) OR (xq% > 96 AND xq% < 123) THEN
      yq% = 13
      xq% = xq% - yq%
      IF xq% < 97 AND xq% > 83 THEN xq% = xq% + 26 ELSE IF xq% < 65 THEN xq% = xq% + 26
      END IF
    MID$(spc$, tt, 1) = CHR$(xq%)
  NEXT tt
decoded$ = spc$

GOTO ok

END IF
exp7:
sedd$ = STRING$(1, 0)
ax$ = STRING$(12, 0)
crc$ = STRING$(1, 0)
dt$ = STRING$(10, 0)

IF i$ = "EXP0.76" THEN
GET #1, , ax$
GET #1, , dt$
GET #1, , crc$
GET #1, , sedd$
'PRINT crc$
'PRINT sedd$
'END
IF sedd$ = "Y" THEN spc$ = STRING$(24, 0): GET #1, , spc$
IF spc$ = "" THEN GOTO ok ELSE
FOR tt = 1 TO LEN(spc$)
    yq% = 0
    xq% = ASC(MID$(spc$, tt, 1))
    'PRINT x%
    IF (xq% > 64 AND xq% < 91) OR (xq% > 96 AND xq% < 123) THEN
      yq% = 13
      xq% = xq% - yq%
      IF xq% < 97 AND xq% > 83 THEN xq% = xq% + 26 ELSE IF xq% < 65 THEN xq% = xq% + 26
      END IF
    MID$(spc$, tt, 1) = CHR$(xq%)
  NEXT tt
decoded$ = spc$

GOTO ok

END IF

ok:
'BytesIn& = 12
OPEN ax$ FOR BINARY AS #2

'First code is 259
FreeCode = 259
StartCode = 259
'First codesize is 9 bits
CodeSize = 9
'Get First code(special case)
Code = GetCode
CurCode = Code
OldCode = Code
FinChar = Code
PutByte FinChar

FileLength& = LOF(1)
IF POS(0) <> 1 THEN PRINT
IF crc$ = "" THEN crc$ = "N"
CLS
COLOR 15, 3: PRINT "EX-Pack Decompressor v" + ver$ + " by the SigmaNetworks Programming Group               "
'COLOR 15, 0
'PRINT
COLOR 7, 0
COMMAN$ = LTRIM$(COMMAND$)
COMMAN$ = RTRIM$(COMMAND$)
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³ Decompressing " + COMMAN$
PRINT "³"
PRINT "³ File compressed on     : "; dt$
IF i$ <> "" THEN id$ = i$
IF idv = 1 THEN id$ = "EXP0.80"
PRINT "³ Header detected        : "; id$
IF spc$ = "" THEN spc$ = "--------"
PRINT "³ SpecialEdition for     : "; spc$
IF crc$ = "Y" THEN PRINT "³ CRC+ (tm) recovery     : Present!" ELSE PRINT "³ CRC+ (tm) recovery     : Not present."
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
LOCATE 3, 78: PRINT "³"
LOCATE 3, 39: PRINT "³0% ±±±±±±±±±±±±±±±±±±±±±±±±±±±±±± 100%"
LOCATE 4, 39: PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
LOCATE 4, 78: PRINT "´"
LOCATE 5, 78: PRINT "³"
LOCATE 6, 78: PRINT "³"
LOCATE 7, 78: PRINT "³"
LOCATE 8, 78: PRINT "³"

Y = CSRLIN: X = POS(0)
'Main decompression loop
DO
LOCATE , , 0
    'Update screen every 1,024 codes
    OutputCounter = OutputCounter + 1
    IF OutputCounter = 1024 THEN
        LOCATE 3, 26
        PRINT ":"; (100& * BytesIn&) \ FileLength&; "% OK";
        axd = (((100& * BytesIn&) \ FileLength&) * 20) \ 64
        LOCATE 3, axd + 42: COLOR 15: PRINT "±": COLOR 7
        OutputCounter = 0
    END IF

GetCode:
    'Get code from input file
    Code = GetCode
    'Process code
    SELECT CASE Code
    'End of file code
    CASE 256
        OutBuffer$ = LEFT$(OutBuffer$, OAddress - OStartAddress)
        PUT #2, , OutBuffer$
        LOCATE 3, 27
        PRINT " All OK!    "
        CLOSE
        RESET
COLOR 15:
'LOCATE 12:
'PRINT "                 ±±±±±±±     ±±±±±   ±±±   ±±  ±±±±±±±   ±±   "
'PRINT "                 ±±     ±±  ±     ±  ±± ±  ±±  ±        ±±±±   "
'PRINT "                 ±±      ±  ±     ±  ±± ±  ±±  ±        ±±±±  "
'PRINT "                 ±±      ±  ±     ±  ±± ±  ±±  ±±±±      ±±  "
'PRINT "                 ±±      ±  ±     ±  ±±  ± ±±  ±         ±± "
'PRINT "                 ±±     ±±  ±     ±  ±±  ± ±±  ±            "
'PRINT "                 ±±±±±±±     ±±±±±   ±±   ±±±  ±±±±±±±   ±± "
       
        END
    'Increase code size code
    CASE 257
        CodeSize = CodeSize + 1
    CASE 258
        Rebuild.Table New.Entries
        FreeCode = New.Entries + StartCode
        CodeSize = 9

        IF FreeCode > 4096 THEN
            FreeCode = StartCode
            Code = GetCode
             
            CurCode = Code
            OldCode = Code
             
            FinChar = Code
            PutByte FinChar
        ELSE
            'prevents an invalid code from entering the table
            Ignore.Next = True
        END IF

    'Process a code
    CASE ELSE
       
        CurCode = Code
        InCode = Code
        'Do we have this string yet?
        IF Code >= FreeCode THEN
            'If Code>FreeCode then stop decompression: this can't be right!
            IF Code > FreeCode THEN COLOR 12: PRINT : PRINT : PRINT "File fails CRC check!!": PRINT "The file is damaged and can't be unpacked!!": CLOSE : COLOR 7: END
            'Trick decompressor to use last code
            
            Used(Code) = Used(Code) + 1
            CurCode = OldCode
            OutCode(OutCount) = FinChar
            OutCount = OutCount + 1
        END IF
        
        'Does this code represent a string?
        IF CurCode >= StartCode THEN
            'Get each character from the table and push it onto the stack
            
            DO
                Used(CurCode) = Used(CurCode) + 1
                OutCode(OutCount) = Suffix(CurCode)
                OutCount = OutCount + 1
                CurCode = Prefix(CurCode)
            'keep on doing this until we have a normal character
            LOOP UNTIL CurCode <= 255
        END IF
        FinChar = CurCode
        OutCode(OutCount) = FinChar
        'Pop all the codes of the stack and put them into the output file
        FOR a = OutCount TO 0 STEP -1
            PutByte OutCode(a)
        NEXT
        OutCount = 0
        'Put the new string into the table
        IF Ignore.Next THEN
            Ignore.Next = False
        ELSE
            Prefix(FreeCode) = OldCode
            Suffix(FreeCode) = FinChar
            FreeCode = FreeCode + 1
        END IF
        OldCode = InCode
    END SELECT
LOOP
hiba:
COLOR 7, 0
CLS
PRINT "An error occured, unpacked file will be damaged!!!!"
'RESUME
END

FUNCTION GetByte STATIC
IF IAddress = IEndAddress THEN
        GET #1, , InBuffer$
        a& = SADD(InBuffer$)
        a& = a& - 65536 * (a& < 0)
        Iseg = VARSEG(InBuffer$) + (a& \ 16)
        IAddress = (a& MOD 16)
        IEndAddress = IAddress + 5000
    END IF
    DEF SEG = Iseg
    GetByte = PEEK(IAddress)
    BytesIn& = BytesIn& + 1
    IAddress = IAddress + 1
END FUNCTION

FUNCTION GetCode STATIC
    IF BitsLeft = 0 THEN
        TempChar = GetByte
        BitsLeft = 8
    END IF
    WorkCode& = TempChar \ Powers(8 - BitsLeft)
    DO WHILE CodeSize > BitsLeft
        TempChar = GetByte
        WorkCode& = WorkCode& OR TempChar * LongPowers(BitsLeft)
        BitsLeft = BitsLeft + 8
    LOOP
    BitsLeft = BitsLeft - CodeSize
    GetCode = WorkCode& AND Masks(CodeSize)
END FUNCTION

SUB Help
COLOR 7, 0
CLS
COLOR 15, 3: PRINT "EX-Pack Decompressor v" + ver$ + " by the SigmaNetworks Programming Group              "
COLOR 7, 0
PRINT "Build information : 08-12-1997"; " Build 6"
PRINT
COLOR 15, 0
PRINT "Syntax : expu.exe filename.ext"
COLOR 7, 0
PRINT
PRINT
PRINT "  ÚÄÄÄÄÄÄÄÄÄ Ä - ú                WARNING!!!                 ú - Ä ÄÄÄÄÄÄÄÄÄ¿"
PRINT "  ³ Files packed with EX-Pack v0.40a cannot be unpacked because a change.   ³"
PRINT "  ³ The compression algoryhm changed in EX-Pack v0.45a, and including two   ³"
PRINT "  ³ algorythms makes the filsize SO big, so I didn't included all of the    ³ "
PRINT "  ³ them ... sorry about it!                                                ³"
PRINT "  ÀÄÄÄÄÄÄÄÄÄ Ä - ú                                           ú - Ä ÄÄÄÄÄÄÄÄÄÙ"
END
END SUB

SUB PutByte (a) STATIC
    IF OAddress = OEndAddress THEN
        PUT #2, , OutBuffer$
        OAddress = OStartAddress
    END IF
    DEF SEG = Oseg
    POKE OAddress, a
    OAddress = OAddress + 1
END SUB

SUB Rebuild.Table (New.Entries)
    DIM P(4095), S(4095), U(4095) AS LONG, Pn(4095), c(4095)
    DIM location(4095)
   
    SHARED StartCode, OldCode
   
    Num.Entries = 0
    FOR a = StartCode TO 4095
        IF Used(a) > 0 THEN
            Used(a) = 0
            P = Prefix(a): S = Suffix(a)
            P(Num.Entries) = P
            S(Num.Entries) = S
            U(Num.Entries) = P * 4096& + S
            c(a) = Num.Entries
            Num.Entries = Num.Entries + 1
        END IF
    NEXT
  

    Num.Entries = Num.Entries - 1
    FOR a = 0 TO Num.Entries
        Pn(a) = a
    NEXT
  
    Mid = Num.Entries \ 2
    DO
        FOR a = 0 TO Num.Entries - Mid
            IF U(Pn(a)) > U(Pn(a + Mid)) THEN
                SWAP Pn(a), Pn(a + Mid)
                Swap.Flag = True
                CompareLow = a - Mid
                CompareHigh = a
                DO WHILE CompareLow >= 0
                    IF U(Pn(CompareLow)) > U(Pn(CompareHigh)) THEN
                        SWAP Pn(CompareLow), Pn(CompareHigh)
                        CompareHigh = CompareLow
                        CompareLow = CompareLow - Mid
                    ELSE
                        EXIT DO
                    END IF
                LOOP
              
            END IF
        NEXT
       
        Mid = Mid \ 2
    LOOP WHILE Mid > 0
   
   
    FOR a = 0 TO Num.Entries
        location(Pn(a)) = a
    NEXT
   
    
   
    FOR A1 = 0 TO Num.Entries
        a = Pn(A1)
     
        P = P(a)
        S = S(a)
        IF P >= StartCode THEN
            P = StartCode + location(c(P))
        END IF
        IF S >= StartCode THEN
            S = StartCode + location(c(S))
        END IF
       
        Prefix(A1 + StartCode) = P
        Suffix(A1 + StartCode) = S
       
    NEXT
    
    IF OldCode >= StartCode THEN
        OldCode = StartCode + location(c(OldCode))
    END IF
   
    New.Entries = Num.Entries + 1

END SUB
