To contact me, please (Author of this website) E-mail me at:
This page last updated July 6 2008
----------------------------------------------------------------------
CONST FALSE% = 0, TRUE% = NOT FALSE%
CONST PREFIX% = 0, SUFFIX% = 1, LINK% = 2
CONST MAXTABLE% = 4095
DECLARE SUB BLOCKCOPY (FROMSEG%, FROMADDR%, TOSEG%, TOADDR%, NUMbytes%)
DECLARE SUB CompletionPercent (MaxTaskValue&, CurTaskValue&, Position%)
DECLARE SUB Compload (FileSpec$, StartLoad&, MaxBytes&, Position%, FilePassword$, ProcessCode%, BytesLoaded&)
DECLARE SUB DeleteStr (Work$)
DECLARE SUB MEMaddr (Location&, Segment%, Offset%)
DECLARE FUNCTION CONVtoINT% (Digit&)
DECLARE FUNCTION MIDCHAR% (Work$, Position%)
DECLARE FUNCTION POWER2& (Digit%)
SUB Compload (FileSpec$, StartLoad&, MaxBytes&, Position%, FilePassword$, ProcessCode%, BytesLoaded&)
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: Subroutine, CompLoad - load a passed filespec into memory after :::
'::: performing data uncompression techniques. :::
'::: :::
'::: INPUT: Filespec$, full disk, path and filename to load :::
'::: StartLoad&, this is the actual memory address (Seg:offs) :::
'::: to begin loading the file to :::
'::: MaxBytes&, maximum bytes of memory available for loading :::
'::: OUTPUT: ProcessCode%, result code of the load process, :::
'::: 0-load ok, other-BASIC/PDQ error code :::
'::: FilePassWord$, password assigned to the file :::
'::: BytesLoaded&, number of bytes loaded from the input file:::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DIM WorkArray%(4700) ' 9400 bytes
DIM SuffixValue(20) AS INTEGER, BINVALUE(16) AS LONG
DIM CODETBL(4096, 2) AS INTEGER, HITTBL(4096) AS INTEGER
DIM LASTbuffer AS STRING
DIM PrefixCandidate AS INTEGER, SuffixCandidate AS INTEGER
DIM TABLEFULL AS INTEGER, TABLETOP AS INTEGER
DIM BitsPerWord AS INTEGER ' PACKING BITS (use 9 to 12 only)
DIM StoreValue AS LONG, PackPointer AS INTEGER
FOR X% = 0 TO 16: BINVALUE(X%) = POWER2&(X%): NEXT: ProcessCode% = 0
LastLoad& = StartLoad&: LastIndex& = StartIndex&: BytesLoaded& = FALSE%
Handle% = FREEFILE: BufSize& = 2048: OPEN FileSpec$ FOR BINARY AS Handle%
IF ERR = 75 THEN
OPEN FileSpec$ FOR INPUT AS Handle%
END IF
IF ERR THEN ProcessCode% = ERR
Remaining& = LOF(Handle%): FileSize& = Remaining&
IF Remaining& > MaxBytes& THEN ProcessCode% = 7
DO WHILE Remaining& > 0
IF Remaining& < BufSize& THEN BufSize& = Remaining&: EOFflag% = TRUE%
Buffer$ = SPACE$(BufSize&): GET #Handle%, , Buffer$
IF ERR THEN ProcessCode% = ERR
IF ProcessCode% THEN EXIT DO
Rec% = Rec% + 1
IF Rec% = 1 THEN
A$ = MID$(Buffer$, 3, 6)
FOR X% = 1 TO 6
PassWord$ = PassWord$ + CHR$(MIDCHAR%(A$, X%) - 128)
NEXT: FilePassword$ = RTRIM$(PassWord$)
Buffer$ = RIGHT$(Buffer$, LEN(Buffer$) - 8): BitsPerWord = 9
GOSUB InitLZW
ELSE
IF CrLf% = 0 THEN ProcessCode% = 6
END IF
GOSUB DecompressLZW
IF ProcessCode% THEN EXIT DO
Buffer$ = LEFToff$ + Buffer$: DeleteStr LEFToff$
DO WHILE LEN(Buffer$)
B% = LEN(Buffer$)
IF B% >= 80 OR (EOFflag% = TRUE% AND B% <= 80) THEN
GOSUB DecompressPOLAND
MEMaddr LastLoad&, MEMseg%, MEMoff%
BLOCKCOPY VARSEG(C$), SADD(C$), MEMseg%, MEMoff%, LEN(C$)
LastLoad& = LastLoad& + 80&
IF LastLoad& + 80& - StartLoad& > MaxBytes& THEN
ProcessCode% = 7: EXIT DO
END IF
ELSE
LEFToff$ = Buffer$: DeleteStr Buffer$
END IF
LOOP
Remaining& = Remaining& - BufSize&
IF ProcessCode% THEN EXIT DO
LOOP
CLOSE Handle%: BytesLoaded& = LastLoad& - StartLoad&: EXIT SUB
InitLZW:
FOR I% = 0 TO MAXTABLE%
HITTBL(I%) = FALSE%: CODETBL(I%, LINK%) = FALSE%
IF I% > 255 THEN
CODETBL(I%, PREFIX%) = FALSE%: CODETBL(I%, SUFFIX%) = FALSE%
ELSE
CODETBL(I%, PREFIX%) = -1: CODETBL(I%, SUFFIX%) = I%
END IF
NEXT: TABLEFULL% = FALSE%: TABLETOP = 255: RETURN
DecompressLZW:
IF LEN(Buffer$) THEN
Pointer% = 1
IF Rec% = 1 THEN
GOSUB GetIntValue: PrefixCandidate = INTVALUE%
END IF
DO
GOSUB GetIntValue: Dummy% = INTVALUE%
IF Dummy% = -1 THEN
IF EOFflag% = FALSE% THEN
CompByte& = CompByte& + Pointer%
Buffer$ = SPACE$(MemPointer%)
BLOCKCOPY VARSEG(WorkArray%(0)), VARPTR(WorkArray%(0)), VARSEG(Buffer$), SADD(Buffer$), MemPointer%
MemPointer% = 0: EXIT DO
ELSE
A$ = Buffer$: DeleteStr Buffer$: GOSUB GetIntValue: Dummy% = INTVALUE%
Buffer$ = A$: DeleteStr A$
IF Dummy% = FALSE% THEN
Buffer$ = SPACE$(MemPointer%)
BLOCKCOPY VARSEG(WorkArray%(0)), VARPTR(WorkArray%(0)), VARSEG(Buffer$), SADD(Buffer$), MemPointer%
MemPointer% = 0: EXIT DO
END IF
END IF
END IF
IF PrefixCandidate < 256 THEN
BLOCKCOPY VARSEG(PrefixCandidate), VARPTR(PrefixCandidate), VARSEG(WorkArray%(0)), VARPTR(WorkArray%(0)) + MemPointer%, 1
MemPointer% = MemPointer% + 1
END IF
SuffixCandidate = Dummy%
IF SuffixCandidate > 255 THEN ' compressed character?
SUFFIXCOPY% = SuffixCandidate ' save just in case we expand it
'
' Handle special case when you need to expand an entry that you
' have not yet added to the table
'
IF TABLETOP + 1 = SuffixCandidate THEN
InputValue% = PrefixCandidate: OutputStatus% = FALSE%
ExpandValue% = SuffixCandidate: GOSUB EXPAND
SuffixCandidate = ExpandValue%
GOSUB ManageTable: FoundCode% = MANAGETBL%
SuffixCandidate = SUFFIXCOPY%
InputValue% = SuffixCandidate: OutputStatus% = TRUE%
ExpandValue% = Dummy%: GOSUB EXPAND
BLOCKCOPY VARSEG(Expanded$), SADD(Expanded$), VARSEG(WorkArray%(0)), VARPTR(WorkArray%(0)) + MemPointer%, LEN(Expanded$)
MemPointer% = MemPointer% + LEN(Expanded$)
ELSE
InputValue% = SuffixCandidate: OutputStatus% = TRUE%
ExpandValue% = SuffixCandidate: GOSUB EXPAND
SuffixCandidate = ExpandValue%
BLOCKCOPY VARSEG(Expanded$), SADD(Expanded$), VARSEG(WorkArray%(0)), VARPTR(WorkArray%(0)) + MemPointer%, LEN(Expanded$)
MemPointer% = MemPointer% + LEN(Expanded$)
GOSUB ManageTable: FoundCode% = MANAGETBL%
SuffixCandidate = SUFFIXCOPY%
END IF
ELSE
GOSUB ManageTable: FoundCode% = MANAGETBL%
END IF
IF TABLEFULL THEN
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LZW ADAPTIVE RESET - Cleans out the compression tables and allows '
' re-filling of the tables. This allows large files to be compressed '
' and decompressed. BitsPerWord must be reset to 9 after this routine.'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
GOSUB InitLZW: GOSUB ManageTable: FoundCode% = MANAGETBL%
END IF
SELECT CASE TABLETOP
CASE IS < 511: BitsPerWord = 9
CASE IS < 1023: BitsPerWord = 10
CASE IS < 2047: BitsPerWord = 11
CASE ELSE: BitsPerWord = 12
END SELECT
PrefixCandidate = SuffixCandidate
IF Position% THEN
IF Pointer% AND 100 THEN
CompletionPercent FileSize&, FileSize& - (CompByte& + Pointer%), Position%
END IF
END IF
LOOP
END IF
RETURN
GetIntValue:
Flag% = FALSE%
DO
IF LEN(Buffer$) THEN
IF Pointer% <= LEN(Buffer$) THEN
UNPACK& = MIDCHAR%(Buffer$, Pointer%)
Pointer% = Pointer% + 1
ELSE
INTVALUE% = -1: RETURN
END IF
ELSE
UNPACK& = FALSE%
END IF
PackPointer = PackPointer + 8
IF PackPointer > BitsPerWord - 1 THEN
TOT& = (UNPACK& * BINVALUE(PackPointer - 8)) + StoreValue
ACTUAL& = TOT& MOD BINVALUE(BitsPerWord)
Flag% = TRUE%
INTVALUE% = CONVtoINT%(ACTUAL&)
StoreValue = TOT& \ BINVALUE(BitsPerWord)
PackPointer = PackPointer - BitsPerWord
ELSE
StoreValue = (UNPACK& * BINVALUE(PackPointer - 8)) + StoreValue
END IF
LOOP UNTIL Flag% = TRUE%
RETURN
DecompressPOLAND:
BufferIN$ = Buffer$: C$ = ""
FOR Y% = 1 TO LEN(BufferIN$)
CUR% = MIDCHAR%(BufferIN$, Y%)
SELECT CASE CUR%
CASE 249 ' repeat last line uncompression
C$ = LASTbuffer$: EXIT FOR
CASE 250 ' repeat portion of last line uncompression
Y% = Y% + 1: NMBRchars% = MIDCHAR%(BufferIN$, Y%)
C$ = LEFT$(LASTbuffer$, NMBRchars%)
CASE 251 ' process CRLF uncompression
CrLf% = CrLf% + 1: EXIT FOR
CASE 11 ' process duplicate character uncompression
Y% = Y% + 1: NMBRchars% = MIDCHAR%(BufferIN$, Y%)
Y% = Y% + 1: CHARvalue% = MIDCHAR%(BufferIN$, Y%)
C$ = C$ + STRING$(NMBRchars%, CHARvalue%)
CASE 9 ' process tab uncompression
TABoff% = (LEN(C$) + 1) \ 8: TABchars% = ((TABoff% + 1) * 8) - LEN(C$)
C$ = C$ + SPACE$(TABchars%)
CASE ELSE
C$ = C$ + CHR$(CUR%)
END SELECT
IF LEN(C$) = 80 THEN EXIT FOR
NEXT: LASTbuffer$ = C$
Buffer$ = MID$(BufferIN$, Y% + 1, LEN(BufferIN$)): DeleteStr BufferIN$
IF LEN(C$) > 100 THEN ProcessCode% = 6
RETURN
ManageTable:
Found% = FALSE%: ENDOFLINKS% = FALSE%
IF HITTBL(PrefixCandidate) THEN
CURPTR% = HITTBL(PrefixCandidate)
DO
IF CODETBL(CURPTR%, PREFIX%) = PrefixCandidate AND CODETBL(CURPTR%, SUFFIX%) = SuffixCandidate THEN
Found% = TRUE%
ELSE
IF CODETBL(CURPTR%, LINK%) THEN
CURPTR% = CODETBL(CURPTR%, LINK%)
ELSE
ENDOFLINKS% = TRUE%
END IF
END IF
LOOP UNTIL Found% OR ENDOFLINKS%
END IF
IF Found% THEN
MANAGETBL% = CURPTR%
ELSE
IF NOT TABLEFULL THEN
'
' The next 3 lines inserts prefixcandidate-suffixcandidate combo
' into the next available entry in the table.
'
TABLETOP = TABLETOP + 1
CODETBL(TABLETOP, PREFIX%) = PrefixCandidate
CODETBL(TABLETOP, SUFFIX%) = SuffixCandidate
IF TABLETOP = MAXTABLE% THEN TABLEFULL = TRUE%
IF HITTBL(PrefixCandidate) = 0 THEN
HITTBL(PrefixCandidate) = TABLETOP
ELSE
CODETBL(CURPTR%, LINK%) = TABLETOP
END IF
END IF
MANAGETBL% = FALSE%
END IF
RETURN
EXPAND:
DeleteStr Expanded$: SUFFIXcount% = FALSE%
IF InputValue% > 255 THEN ' Compressed value>255
Kprefix% = CODETBL(InputValue%, PREFIX%)
KSUFFIX% = CODETBL(InputValue%, SUFFIX%)
IF Kprefix% > 255 THEN ' Get suffix values until prefix < 256
DO WHILE Kprefix% > 255
returned% = Kprefix%
SUFFIXcount% = SUFFIXcount% + 1
Kprefix% = CODETBL(returned%, PREFIX%)
KRETURNED% = Kprefix%
SuffixValue%(SUFFIXcount%) = CODETBL(returned%, SUFFIX%)
IF SUFFIXcount% > 19 THEN ProcessCode% = 6: RETURN
LOOP
IF OutputStatus% THEN
Expanded$ = Expanded$ + CHR$(Kprefix%)
FOR A% = SUFFIXcount% TO 1 STEP -1
Expanded$ = Expanded$ + CHR$(SuffixValue%(A%))
NEXT
END IF
ELSE
KRETURNED% = Kprefix%
IF OutputStatus% THEN Expanded$ = Expanded$ + CHR$(Kprefix%)
END IF
IF OutputStatus% THEN Expanded$ = Expanded$ + CHR$(KSUFFIX%)
ELSE
KRETURNED% = InputValue%
END IF
ExpandValue% = KRETURNED%
RETURN
END SUB
----------------------------------------------------------------------
CONST FALSE% = 0, TRUE% = NOT FALSE%
CONST PREFIX% = 0, SUFFIX% = 1, LINK% = 2
DECLARE SUB BLOCKCOPY (FROMSEG%, FROMADDR%, TOSEG%, TOADDR%, NUMbytes%)
DECLARE SUB CompletionPercent (MaxTaskValue&, CurTaskValue&, Position%)
DECLARE SUB CompSave (FileSpec$, BeginAddress&, BytesToSave&, Position%, FilePassWord$, ProcessCode%, BytesSaved&)
DECLARE SUB MemAddr (Location&, Segment%, Offset%)
DECLARE FUNCTION ConvToLong& (Digit%)
DECLARE FUNCTION MIDCHAR% (Work$, Position%)
DECLARE FUNCTION POWER2& (Digit%)
SUB CompSave (FileSpec$, BeginAddress&, BytesToSave&, Position%, FilePassWord$, ProcessCode%, BytesSaved&)
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: Subroutine, Compsave - Save a range of memory specified :::
'::: by input parameters to a LZW compressed file. :::
'::: :::
'::: INPUT: FileSpec$ - disk, path and filespec of save file :::
'::: StartSave& - Beginning full address value :::
'::: BytesToSave& - Number of bytes to save to disk :::
'::: Position% - Actual byte to print completion :::
'::: percentage of the save task :::
'::: FilePassWord$ - password assigned to the file :::
'::: :::
'::: OUTPUT: ProcessCode% - 0=successful operation :::
'::: other=BASIC/PDQ error code :::
'::: BytesSaved& - Number of bytes successfully saved:::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
DIM LastBuffer AS STRING
DIM CODETBL(4096, 2) AS INTEGER, HITTBL(4096) AS INTEGER
DIM PREFIXCANDIDATE AS INTEGER, SUFFIXCANDIDATE AS INTEGER
DIM TableFull AS INTEGER, TableTop AS INTEGER
DIM BitsPerWord AS INTEGER ' PACKING BITS (use 9 to 12 only)
DIM BINVALUE(16) AS LONG, STOREvalue AS LONG
DIM PACKpointer AS INTEGER, StrBytes(80) AS INTEGER
DIM WorkArea(960) AS INTEGER
FOR X% = 0 TO 16: BINVALUE(X%) = POWER2&(X%): NEXT: MAXTABLE% = 255
ProcessCode% = 0: Handle% = FREEFILE: OPEN FileSpec$ FOR BINARY AS Handle%
IF ERR THEN ProcessCode% = ERR
BitsPerWord = 9: GOSUB LZWinit: MAXTABLE% = 4095: PassWord$ = ""
FOR X% = 1 TO 6
IF X% > LEN(FilePassWord$) THEN
PassWord$ = PassWord$ + " "
ELSE
PassWord$ = PassWord$ + CHR$(MIDCHAR%(FilePassWord$, X%) + 128)
END IF
NEXT
A$ = "JP" + PassWord$: PUT Handle%, , A$
IF ERR THEN ProcessCode% = ERR
PACKpointer = FALSE%: STOREvalue = FALSE%
FOR SAV& = BeginAddress& TO BeginAddress& + BytesToSave& STEP 80
IF ProcessCode% THEN GOTO ErrorCheckRoutine ' Bail out
Buffer$ = SPACE$(80): MemAddr SAV&, MemSeg%, MemOff%
BLOCKCOPY MemSeg%, MemOff%, VARSEG(Buffer$), SADD(Buffer$), 80
GOSUB PolandCompress: Pointer% = FALSE%
IF SAV& = BeginAddress& THEN
Pointer% = 1: PREFIXCANDIDATE = MIDCHAR%(Buffer$, Pointer%)
END IF
MemPointer% = FALSE%
DO
Pointer% = Pointer% + 1: SUFFIXCANDIDATE = MIDCHAR%(Buffer$, Pointer%)
IF SUFFIXCANDIDATE = -1 THEN ' End of data ????
IF SAV& < BeginAddress& + BytesToSave& - 80 OR PREFIXCANDIDATE = -1 THEN
IF STOREvalue > 0 AND PREFIXCANDIDATE = -1 THEN
PREFIXCANDIDATE = FALSE%: GOSUB PackLzw
END IF
TempBuffer$ = ""
IF MemPointer% THEN
TempBuffer$ = SPACE$(MemPointer%)
BLOCKCOPY VARSEG(WorkArea%(0)), 0, VARSEG(TempBuffer$), SADD(TempBuffer$), MemPointer%
END IF
Buffer$ = TempBuffer$
EXIT DO
END IF
END IF
GOSUB ManageTable
IF FOUNDcode% THEN
PREFIXCANDIDATE = FOUNDcode%
ELSE
GOSUB PackLzw
SELECT CASE TableTop
' Upper bit limit is 12 (4096) and the lower limit
' is 9 (521)
CASE IS < 512: BitsPerWord = 9
CASE IS < 1024: BitsPerWord = 10
CASE IS < 2048: BitsPerWord = 11
CASE ELSE: BitsPerWord = 12
END SELECT
IF TableFull THEN
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LZW ADAPTIVE RESET - Cleans out the compression '
' tables and allows re-filling of the tables. This '
' allows large files to be compressed and decompressed. '
' BitsPerWord must not be reset to 9 after this routine. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
GOSUB LZWinit: GOSUB ManageTable
END IF
PREFIXCANDIDATE = SUFFIXCANDIDATE
END IF
LOOP
Accum$ = Accum$ + Buffer$
IF Position% THEN
CompletionPercent BytesToSave&, BeginAddress& + BytesToSave& - SAV&, Position%
END IF
IF LEN(Accum$) > 4096 THEN
PUT Handle%, , Accum$: Accum$ = ""
IF ERR THEN ProcessCode% = ERR
END IF
NEXT
IF ProcessCode% = 0 THEN PUT Handle%, , Accum$
IF ERR THEN ProcessCode% = ERR
GOTO ErrorCheckRoutine
LZWinit:
TableFull = FALSE%
FOR I% = 0 TO MAXTABLE%
HITTBL(I%) = FALSE%: CODETBL(I%, LINK%) = FALSE%
IF I% > 255 THEN
CODETBL(I%, PREFIX%) = FALSE%: CODETBL(I%, SUFFIX%) = FALSE%
ELSE
CODETBL(I%, PREFIX%) = -1: CODETBL(I%, SUFFIX%) = I%
END IF
NEXT
TableTop = 255: RETURN
PolandCompress:
NewBuffer$ = RTRIM$(Buffer$): StrLen% = LEN(NewBuffer$): New.Dat$ = ""
FOR X% = 1 TO StrLen%: StrBytes%(X%) = MIDCHAR%(NewBuffer$, X%): NEXT
IF StrLen% < 80 THEN StrBytes%(StrLen% + 1) = 251: StrLen% = StrLen% + 1
' Repeat compression from previous line?
ALLFLAG% = FALSE%: Repeat% = FALSE%: O% = FALSE%: Space.Count% = FALSE%
RptStart% = 1
IF LastBuffer$ = NewBuffer$ THEN
ALLFLAG% = 1
ELSEIF LEN(LastBuffer$) > 2 AND StrLen% > 2 THEN
FOR X% = 1 TO StrLen%
IF StrBytes%(X%) >= FALSE% THEN
O% = O% + 1
IF StrBytes%(X%) = MIDCHAR%(LastBuffer$, O%) THEN
Repeat% = Repeat% + 1
ELSE
EXIT FOR
END IF
END IF
NEXT
END IF
IF StrLen% > 2 AND ALLFLAG% <> FALSE% THEN
FOR y% = 2 TO StrLen%: StrBytes%(y%) = -1: NEXT
StrBytes%(1) = 249
ELSEIF Repeat% > 2 THEN
StrBytes%(1) = 250: StrBytes%(2) = Repeat%
FOR y% = 3 TO X% - 1
StrBytes%(y%) = -1
NEXT: RptStart% = y% + 1
END IF
' Process tab compression
FOR X% = 8 TO StrLen% STEP 8
FOR y% = X% TO X% - 7 STEP -1
Space.Count% = FALSE%
IF StrBytes%(y%) = 32 THEN Space.Count% = Space.Count% + 1 ELSE EXIT FOR
NEXT
IF Space.Count% > 1 THEN
StrBytes%(y% + 1) = 9
FOR Z% = y% + 2 TO y% + Space.Count%
StrBytes%(Z%) = -1
NEXT
END IF
NEXT
FOR X% = StrLen% TO 1 STEP -1 ' strip at end to beginning
SELECT CASE StrBytes%(X%)
CASE 9, 0
StrBytes%(X%) = -1
CASE ELSE
EXIT FOR
END SELECT
NEXT
' Process duplicate characters more than 3 bytes in succession
DUPLICATES% = 1: LASTbyte% = FALSE%: FINDflag% = FALSE%
FOR X% = RptStart% TO StrLen%
IF LASTbyte% > 0 THEN
FINDflag% = FALSE%
IF StrBytes%(X%) = LASTbyte% THEN FINDflag% = 1
IF FINDflag% AND X% <> StrLen% THEN
DUPLICATES% = DUPLICATES% + 1
ELSE
IF DUPLICATES% > 3 THEN
IF FINDflag% AND X% = StrLen% THEN DUPLICATES% = DUPLICATES% + 1: X% = X% + 1
StrBytes%(X% - DUPLICATES%) = 11
StrBytes%(X% + 1 - DUPLICATES%) = DUPLICATES%
StrBytes%(X% + 2 - DUPLICATES%) = LASTbyte%
FOR y% = X% + 3 - DUPLICATES% TO X% - 1
StrBytes%(y%) = -1
NEXT
END IF
DUPLICATES% = 1
END IF
END IF
IF X% < StrLen% THEN
IF StrBytes%(X%) > 0 THEN LASTbyte% = StrBytes%(X%)
END IF
NEXT
FOR X% = 1 TO StrLen%
IF StrBytes%(X%) >= FALSE% THEN New.Dat$ = New.Dat$ + CHR$(StrBytes%(X%))
NEXT
Buffer$ = New.Dat$: LastBuffer$ = NewBuffer$: RETURN
ManageTable:
Found% = FALSE%: ENDOFLINKS% = FALSE%: CURPTR% = FALSE%
IF HITTBL(PREFIXCANDIDATE) THEN
CURPTR% = HITTBL(PREFIXCANDIDATE)
DO
IF CODETBL(CURPTR%, PREFIX%) = PREFIXCANDIDATE AND CODETBL(CURPTR%, SUFFIX%) = SUFFIXCANDIDATE THEN
Found% = TRUE%
ELSE
IF CODETBL(CURPTR%, LINK%) THEN
CURPTR% = CODETBL(CURPTR%, LINK%)
ELSE
ENDOFLINKS% = TRUE%
END IF
END IF
LOOP UNTIL Found% OR ENDOFLINKS%
END IF
IF Found% THEN
FOUNDcode% = CURPTR%
ELSE
IF NOT TableFull THEN
TableTop = TableTop + 1: CODETBL(TableTop, PREFIX%) = PREFIXCANDIDATE
CODETBL(TableTop, SUFFIX%) = SUFFIXCANDIDATE
IF TableTop = MAXTABLE% THEN TableFull = TRUE%
IF HITTBL(PREFIXCANDIDATE) = 0 THEN
HITTBL(PREFIXCANDIDATE) = TableTop
ELSE
CODETBL(CURPTR%, LINK%) = TableTop
END IF
END IF
FOUNDcode% = FALSE%
END IF
RETURN
PackLzw:
LONGint& = ConvToLong&(PREFIXCANDIDATE)
Packed$ = "": PACKpointer = PACKpointer + BitsPerWord
IF PACKpointer > 7 THEN
TOT& = LONGint& * BINVALUE(PACKpointer - BitsPerWord) + STOREvalue
PACKpointer = PACKpointer - 8
Packed$ = Packed$ + CHR$(TOT& MOD BINVALUE(8))
STOREvalue = TOT& \ BINVALUE(8)
IF PACKpointer > 7 THEN
Packed$ = Packed$ + CHR$(STOREvalue MOD BINVALUE(8))
PACKpointer = PACKpointer - 8: STOREvalue = STOREvalue \ BINVALUE(8)
END IF
ELSE
STOREvalue = LONGint&
END IF
A% = LEN(Packed$)
IF A% THEN
BLOCKCOPY VARSEG(Packed$), SADD(Packed$), VARSEG(WorkArea%(0)), MemPointer%, A%
MemPointer% = MemPointer% + A%
END IF
RETURN
ErrorCheckRoutine:
CLOSE Handle%: BytesSaved& = SAV& - BeginAddress& - 80
END SUB
jep1965@gmail.com
