'ZIP UTILITY, ED. 2022-04-07 BY NATHANIEL BABIAK. '.~^```^~.,,,.~^```^~., BELOW: UNZIP CODE (376 TOKENS) ,.~^```^~.,,,.~^```^~. GLOBAL U_SRC, U_SBIT, U_P2, U_GAM_0, U_G2P3, U_1BITS, U_2BITS, U_3BITS, U_EXTND, U_P3 SUB UNZIP( SRC_ADR, DST_ADR ) U_SRC = SRC_ADR U_SBIT = 7 CALL UNZIP_PEEKB( 14, U_P2 ) CALL UNZIP_PEEKB( 2, U_G2P3 ) CALL UNZIP_PEEKB( 1, U_GAM_0 ) CALL UNZIP_PEEKB( 3, U_1BITS ) CALL UNZIP_PEEKB( 4, U_2BITS ) CALL UNZIP_PEEKB( 4, U_3BITS ) CALL UNZIP_PEEKB( 4, U_EXTND ) DIM BUF1( $4FFF ) FOR P1 = 0 TO U_P2 CALL UNZIP_PEEKG( U_P3 ) IF U_GAM_0 AND U_P3 = 1 THEN CALL UNZIP_PEEKB( 1, U_P3 ) IF U_GAM_0 + U_P3 = 1 THEN CALL UNZIP_PEEKB( 8, BUF1( P1 ) ) ELSE ADD U_P3, -U_G2P3 IF U_P3 = 1 THEN LO = U_2BITS ELSE IF U_P3 THEN LO = U_3BITS ELSE LO = U_1BITS CALL UNZIP_PEEKB( LO, LO ) HI = 1 IF U_P3 >= U_EXTND THEN CALL UNZIP_PEEKG( HI ) ADD U_P3, P1 FOR P1 = P1 TO U_P3 BUF1( P1 ) = BUF1( P1 - 2 ^ U_3BITS * ( HI - 1 ) - LO - 1 ) NEXT P1 DEC P1 END IF NEXT P1 FOR P1 = 0 TO U_P2 POKE DST_ADR + P1, BUF1( P1 ) NEXT P1 END SUB SUB UNZIP_PEEKB( BITS, VALUE ) BIT2 = BITS VALUE = 0 WHILE BIT2 DEC BIT2 IF PEEK( U_SRC ) AND 2 ^ U_SBIT THEN ADD VALUE, 2 ^ BIT2 IF U_SBIT = 0 THEN INC U_SRC ADD U_SBIT, -1, 0 TO 7 WEND END SUB SUB UNZIP_PEEKG( VALUE ) DIGITS = -1 REPEAT CALL UNZIP_PEEKB( 1, VALUE ) INC DIGITS UNTIL VALUE CALL UNZIP_PEEKB( DIGITS, VALUE ) ADD VALUE, 2 ^ DIGITS END SUB '.~^```^~.,,,.~^```^~., ABOVE: UNZIP CODE (376 TOKENS) ,.~^```^~.,,,.~^```^~. REPEAT GLOBAL P_DST, P_DBIT GLOBAL L_P1,L_P2,L_GAM_0,L_LEN_1,L_1BITS,L_2BITS,L_3BITS,L_EXTND,L_1MAX,L_2MAX,L_3MAX GLOBAL L_WINDOW_LIMIT_CPU, L_BYTE2BIT DIM GLOBAL H_BESTX( 7 ), H_BEST1( 7 ), H_BEST0( 7 ), H_DATABASE$( 15 ) GLOBAL H_SIZE DIM GLOBAL L_LEN($3FFF), L_OFF($3FFF), L_L2B($3FFF), L_O2B($3FFF) DIM GLOBAL D_BUF1($3FFF), D_BUF2($3FFF), D_BUF3($3FFF), D_G2B($3FFF+1) DIM GLOBAL S_P2PW($3FFF), S_P2PB($3FFF) UNTIL 1 DO REPEAT NEW0: FONT 0 'CALL TEST_PEEK_POKE_B_G SRC1 = 0 DST1 = 0 TEMP$ = "" FILES CALL TITLE( "ZIP/UNZIP UTILITY" ) CALL HEADING( 1, "DISK MENU" ) CALL PROMPT( 2, "SRC ROM","0-15" ) CALL PROMPT( 4, "DST ROM","0-15" ) CALL PROMPT( 13, "CONTINUE","Y/N" ) CALL DISP( 15, "BACK", "X" ) SRC0: TEXT 0, 3, " " SRC1: CALL NUM_INPUT( 16, 2, SRC1, 0, 15 ) IF SRC1 = -1 THEN GOTO SRC0 CALL COMMENT( 3, SRC1 ) IF FSIZE( SRC1 ) = 0 OR FSIZE( SRC1 ) > $4000 THEN GOTO SRC1 DST0: TEXT 0, 5, " " CALL NUM_INPUT( 16, 4, DST1, 0, 15 ) IF DST1 = -1 THEN GOTO SRC0 CALL COMMENT( 5, DST1 ) CONTINUE1: CALL STR_INPUT( 16, 13, TEMP$, "Y", "N" ) IF TEMP$ = "X" OR TEMP$ = "N" THEN TEXT 16, 13, " " GOTO DST0 END IF UNTIL 1 IF LEFT$( FILE$( SRC1 ), 1 ) = "*" AND LEN( FILE$( SRC1 ) ) > 1 THEN REPEAT TEXT 0, 8, " ZIP FILE DETECTED" LOAD SRC1, $A000 CALL UNZIP( $A000, $A000 ) SAVE DST1, MID$( FILE$( SRC1 ), 2, 31 ), $A000, U_P2 + 1 PAL 7 TEXT 0, 15, " UNZIP'D FILE SAVED" WAIT 90 UNTIL 1 ELSE REPEAT L_WINDOW_LIMIT_CPU = 0 FOR HI = 4 TO 13 IF FSIZE( SRC1 ) <= 2 ^ HI THEN EXIT NEXT HI CALL TITLE( "ZIP UTILITY" ) CALL HEADING( 1, "SETTINGS" ) CALL PROMPT( 2, "ZIP LEVEL","4-"+STR$(HI) ) CALL PROMPT( 4, "SEARCH/MANUAL","" ) TEXT 0, 4, "S" TEXT 7, 4, "M" CALL PROMPT( 13, "CONTINUE","Y/N" ) CALL DISP( 15, "BACK", "X" ) LVL1: CALL NUM_INPUT( 16, 2, L_WINDOW_LIMIT_CPU, 4, HI ) IF L_WINDOW_LIMIT_CPU = -1 THEN CALL TITLE( "ZIP/UNZIP UTILITY" ) CALL HEADING( 1, "DISK MENU" ) CALL PROMPT( 2, "SRC ROM","0-15" ) TEXT 16, 2, STR$( SRC1 ) CALL COMMENT( 3, SRC1 ) CALL PROMPT( 4, "DST ROM","0-15" ) TEXT 16, 4, STR$( DST1 ) CALL COMMENT( 5, DST1 ) CALL PROMPT( 13, "CONTINUE","Y/N" ) CALL DISP( 15, "BACK", "X" ) GOTO CONTINUE1 END IF L_WINDOW_LIMIT_CPU = 2 ^ L_WINDOW_LIMIT_CPU TYPE1: TYPE$ = "" CALL STR_INPUT( 16, 4, TYPE$, "S", "M" ) IF TYPE$ = "X" THEN GOTO LVL1 IF TYPE$ = "M" THEN GAMMA: CALL PROMPT( 6, "GAMMA=0","Y/N" ) CALL PROMPT( 7, "LO","0-4/N" ) CALL PROMPT( 8, "MD","0-12" ) CALL PROMPT( 9, "HI","0-12" ) CALL PROMPT( 10, "EXTND","0-15" ) CALL STR_INPUT( 16, 6, TEMP$, "Y", "N" ) IF TEMP$ = "X" THEN BG FILL 0, 6 TO 19, 12 CHAR 0 GOTO TYPE1 END IF IF TEMP$ = "Y" THEN L_GAM_0 = 1 ELSE L_GAM_0 = 0 LO1: CALL STR_INPUT6( 16, 7, TEMP$, "0", "1", "2", "3", "4", "N" ) IF TEMP$ = "X" THEN GOTO GAMMA IF TEMP$ = "N" THEN L_LEN_1 = 0 L_1BITS = 0 ELSE L_LEN_1 = 1 L_1BITS = VAL( TEMP$ ) END IF MD1: CALL NUM_INPUT( 16, 8, L_2BITS, 0, 12 ) IF L_2BITS = -1 THEN GOTO LO1 HI1: CALL NUM_INPUT( 16, 9, L_3BITS, 0, 12 ) IF L_3BITS = -1 THEN GOTO MD1 EXTND1: CALL NUM_INPUT( 16, 10, L_EXTND, 0, 15 ) IF L_EXTND = -1 THEN GOTO HI1 END IF CALL STR_INPUT( 16, 13, TEMP$, "Y", "N" ) IF TEMP$ = "X" OR TEMP$ = "N" THEN TEXT 16, 13, " " IF TYPE$ = "M" THEN GOTO EXTND1 ELSE GOTO TYPE1 END IF CALL TITLE( "ZIP UTILITY" ) CALL HEADING( 8, "INDEXING..." ) CALL LZ77_INDEX( SRC1, $A000 ) CALL TITLE( "ZIP UTILITY" ) TEXT 0, 2, "LO=01234N G=YN" TEXT 0, 3, "MD=0123456789ABC" TEXT 0, 4, "HI=0123456789ABC" TEXT 0, 5, "EX=0123456789ABCDEF" CALL HEADING( 7, "BYTES" ) BG TINT 1, 8 TO 11, 14 PAL 4 IF TYPE$ = "M" THEN CALL HEADING( 1, "PARAMETERS" ) CALL LZ77_MANUAL IF L_EXTND = -1 THEN PAUSE GOTO NEW0 END IF ELSE CALL HEADING( 1, "PARAMETER SEARCH" ) CALL LZ77_HEURISTIC END IF PAL 3 TEXT 14, 7, "SIZE" TEXT 14, 11, "HASH" PAL 0 TEXT 13, 8, RIGHT$( " " + STR$( L_P2 + 1 ), 6 ) SRC_HASH = 0 CALL PEARSON3( SRC_HASH, $A000, L_P2 + 1 ) TEXT 13, 12, HEX$( SRC_HASH, 6 ) CALL LZ77_ENCODE( $A000 ) PAL 1 TEXT 13, 9, RIGHT$( " " + STR$( P_DST - $A000 + 1 ), 6 ) FOR P1 = 0 TO P_DST - $A000 + 1 D_BUF1( P1 ) = PEEK( P1 + $A000 ) NEXT P1 CALL UNZIP( $A000, $A000 ) DST_HASH = 0 CALL PEARSON3( DST_HASH, $A000, U_P2 + 1 ) TEXT 13, 13, HEX$( DST_HASH, 6 ) IF SRC_HASH <> DST_HASH THEN PAL 6 TEXT 0, 15, " ERR:HASH FAILED!" ELSE FOR P1 = 0 TO P_DST - $A000 + 1 POKE P1 + $A000, D_BUF1( P1 ) NEXT P1 SAVE DST1, LEFT$( "*" + FILE$( SRC1 ), 32 ), $A000, P_DST - $A000 + 1 PAL 7 TEXT 0, 15, " ZIP FILE SAVED" END IF PAUSE UNTIL 1 END IF LOOP SUB LZ77_INDEX( SRC_ROM, SRC_ADR ) L_P2 = FSIZE( SRC_ROM ) - 1 GAMMA = 1 FOR NN = 1 TO 14 GAM2 = 2 ^ NN - 1 BITS = 2 * NN - 1 FOR GAMMA = GAMMA TO GAM2 D_G2B( GAMMA ) = BITS NEXT GAMMA NEXT NN LOAD SRC_ROM, SRC_ADR DIM W2P0( $7FFF ), W2P1( $7FFF ), B2P( $FF ) D_BUF1( 0 ) = PEEK( SRC_ADR ) FOR L_P1 = 0 TO L_P2 - 1 NEXT_BYTE = PEEK( SRC_ADR + L_P1 + 1 ) D_BUF1( L_P1 + 1 ) = NEXT_BYTE WORD = $100 * D_BUF1( L_P1 ) + NEXT_BYTE D_BUF2( L_P1 ) = WORD IF L_P1 THEN D_BUF3( L_P1 - 1 ) = $10000 * D_BUF1( L_P1 - 1 ) + WORD CALL BYTE2POS( S_P2PB( L_P1 ), B2P() ) CALL WORD2POS( S_P2PW( L_P1 ), W2P0(), W2P1() ) NEXT L_P1 CALL BYTE2POS( S_P2PB( L_P1 ), B2P() ) 'INCREASE DOMAINS OF ARRAYS D_BUF*() AND P2P*() AFTER SUB WORD2POS IS FINISHED. D_BUF2( L_P2 ) = -1 D_BUF3( L_P2 - 1 ) = -1 D_BUF3( L_P2 ) = -1 S_P2PW( L_P2 ) = -1 END SUB SUB BYTE2POS( RET_POS, B2P() ) 'IN: CURRENT BYTE AT L_P1 (L_P1 FROM 0 TO L_P2). OUT: PRIOR NEAREST MATCHING POSITION. BYTE = D_BUF1( L_P1 ) 'REQUIRES $100 ELEMENT 1D ARRAY INITIALIZED TO ALL ZEROS. RET_POS = L_P1 + 1 'REQUIRES EVERY POSITION TO BE EVALUATED SEQUENTIALLY. SWAP RET_POS, B2P( BYTE ) 'IF MULTI-SEQUENCE, THEN RESET ARRAY (TO ZEROS) BETWEEN SEQUENCES (USE LOCAL ARRAYS). DEC RET_POS 'IF BYTE NOT PREVIOUSLY SEEN, THEN RET_POS=-1, OTHERWISE OUT DESCRIBED ABOVE. END SUB SUB WORD2POS( RET_POS, W2P0(), W2P1() ) 'IN: CURRENT WORD AT L_P1 (L_P1 FROM 0 TO L_P2-1). OUT: PRIOR NEAREST MATCHING POSITION. WORD = D_BUF2( L_P1 ) 'REQUIRES BOTH $8000 ELEMENT 1D ARRAYS INITIALIZED TO ALL ZEROS. RET_POS = L_P1 + 1 'REQUIRES EVERY POSITION TO BE EVALUATED SEQUENTIALLY. IF WORD <= $7FFF THEN SWAP RET_POS, W2P0( WORD ) ELSE SWAP RET_POS, W2P1( WORD AND $7FFF ) 'IF MULTI-SEQUENCE, THEN RESET ARRAY (TO ZEROS) BETWEEN SEQUENCES (USE LOCAL ARRAYS). DEC RET_POS 'IF WORD NOT PREVIOUSLY SEEN, THEN RET_POS=-1, OTHERWISE OUT DESCRIBED ABOVE. END SUB SUB LZ77_MANUAL FOR EXTND = 0 TO 15 H_DATABASE$( EXTND ) = "" NEXT EXTND H_BESTX( 6 ) = ( L_P2 + 1 ) * 8 + 1 H_BESTX( 7 ) = 0 CALL LZ77_HEUR1( H_BESTX() ) END SUB SUB LZ77_HEURISTIC FOR EXTND = 0 TO 15 H_DATABASE$( EXTND ) = "" NEXT EXTND 'L_GAM_0 0-1. L_LEN_1 0-1. L_1BITS 0-4. L_2BITS 0-12. L_3BITS 0-12. L_EXTND 0-15. L_GAM_0 = 0 L_LEN_1 = 1 L_1BITS = 0 L_2BITS = 0 L_3BITS = 0 L_EXTND = 2 H_BESTX( 6 ) = ( L_P2 + 1 ) * 8 + 1 H_BESTX( 7 ) = 0 CALL LZ77_HEUR1( H_BESTX() ) REPEAT IS_NEW = 0 CALL LZ77_HEUR_1BITS( H_BESTX(), IS_NEW ) CALL LZ77_HEUR_2BITS( H_BESTX(), IS_NEW ) CALL LZ77_HEUR_3BITS( H_BESTX(), IS_NEW ) CALL LZ77_HEUR_EXTND( H_BESTX(), IS_NEW ) CALL LZ77_HEUR_G0L1( H_BESTX(), IS_NEW ) UNTIL IS_NEW = 0 CALL LZ77_HEUR_LOAD( H_BESTX() ) CALL LZ77_HEUR1( H_BESTX() ) L_EXTND = 1 H_BEST1( 6 ) = ( L_P2 + 1 ) * 8 + 1 H_BEST1( 7 ) = H_BESTX( 7 ) REPEAT IS_NEW = 0 CALL LZ77_HEUR_23BITS( H_BEST1(), IS_NEW ) CALL LZ77_HEUR_1BITS( H_BEST1(), IS_NEW ) CALL LZ77_HEUR_G0L1( H_BEST1(), IS_NEW ) UNTIL IS_NEW = 0 CALL LZ77_HEUR_LOAD( H_BEST1() ) CALL LZ77_HEUR1( H_BEST1() ) L_EXTND = 0 H_BEST0( 6 ) = ( L_P2 + 1 ) * 8 + 1 H_BEST0( 7 ) = H_BEST1( 7 ) REPEAT IS_NEW = 0 CALL LZ77_HEUR_123BITS( H_BEST0(), IS_NEW ) CALL LZ77_HEUR_G0L1( H_BEST0(), IS_NEW ) UNTIL IS_NEW = 0 CALL LZ77_HEUR_LOAD( H_BESTX() ) CALL LZ77_HEUR1( H_BESTX() ) CALL LZ77_HEUR_LOAD( H_BEST1() ) CALL LZ77_HEUR1( H_BEST1() ) CALL LZ77_HEUR_LOAD( H_BEST0() ) CALL LZ77_HEUR1( H_BEST0() ) IF H_BEST0( 6 ) <= H_BEST1( 6 ) AND H_BEST0( 6 ) <= H_BESTX( 6 ) THEN CALL LZ77_HEUR_LOAD( H_BEST0() ) ELSE IF H_BEST1( 6 ) <= H_BESTX( 6 ) THEN CALL LZ77_HEUR_LOAD( H_BEST1() ) ELSE CALL LZ77_HEUR_LOAD( H_BESTX() ) END IF END IF H_BEST0( 6 ) = ( L_P2 + 1 ) * 8 + 1 CALL LZ77_HEUR1( H_BEST0() ) CALL LZ77_INIT CALL LZ77_MAIN END SUB SUB LZ77_HEUR_1BITS( BEST(), IS_NEW ) OLD_1BITS = BEST( 3 ) FOR L_1BITS = 0 TO 4 CALL LZ77_HEUR1( BEST() ) NEXT L_1BITS L_1BITS = BEST( 3 ) IF OLD_1BITS <> L_1BITS THEN IS_NEW = 1 END SUB SUB LZ77_HEUR_2BITS( BEST(), IS_NEW ) OLD_2BITS = BEST( 4 ) FOR L_2BITS = 0 TO 12 CALL LZ77_HEUR1( BEST() ) NEXT L_2BITS L_2BITS = BEST( 4 ) IF OLD_2BITS <> L_2BITS THEN IS_NEW = 1 END SUB SUB LZ77_HEUR_3BITS( BEST(), IS_NEW ) OLD_3BITS = BEST( 5 ) FOR L_3BITS = 0 TO 12 CALL LZ77_HEUR1( BEST() ) NEXT L_3BITS L_3BITS = BEST( 5 ) IF OLD_3BITS <> L_3BITS THEN IS_NEW = 1 END SUB SUB LZ77_HEUR_EXTND( BEST(), IS_NEW ) OLD_EXTND = BEST( 0 ) FOR L_EXTND = 2 TO 15 CALL LZ77_HEUR1( BEST() ) NEXT L_EXTND L_EXTND = BEST( 0 ) IF OLD_EXTND <> L_EXTND THEN IS_NEW = 1 END SUB SUB LZ77_HEUR_G0L1( BEST(), IS_NEW ) OLD_GAM_0 = L_GAM_0 OLD_LEN_1 = L_LEN_1 FOR OVERHEAD_CODE = 0 TO %11 L_GAM_0 = SGN( OVERHEAD_CODE AND %01 ) L_LEN_1 = SGN( OVERHEAD_CODE AND %10 ) CALL LZ77_HEUR1( BEST() ) NEXT OVERHEAD_CODE L_GAM_0 = BEST( 1 ) L_LEN_1 = BEST( 2 ) IF OLD_GAM_0 <> L_GAM_0 OR OLD_LEN_1 <> L_LEN_1 THEN IS_NEW = 1 END SUB SUB LZ77_HEUR_LOAD( BEST() ) L_EXTND = BEST( 0 ) L_GAM_0 = BEST( 1 ) L_LEN_1 = BEST( 2 ) L_1BITS = BEST( 3 ) L_2BITS = BEST( 4 ) L_3BITS = BEST( 5 ) END SUB SUB LZ77_HEUR_23BITS( BEST(), IS_NEW ) OLD_2BITS = BEST( 4 ) OLD_3BITS = BEST( 5 ) FOR L_3BITS = 0 TO 12 L_2BITS = L_3BITS CALL LZ77_HEUR1( BEST() ) NEXT L_3BITS L_2BITS = BEST( 4 ) L_3BITS = BEST( 5 ) IF OLD_2BITS <> L_2BITS OR OLD_3BITS <> L_3BITS THEN IS_NEW = 1 END SUB SUB LZ77_HEUR_123BITS( BEST(), IS_NEW ) OLD_1BITS = BEST( 3 ) OLD_2BITS = BEST( 4 ) OLD_3BITS = BEST( 5 ) FOR L_3BITS = 0 TO 4 L_1BITS = L_3BITS L_2BITS = L_3BITS CALL LZ77_HEUR1( BEST() ) NEXT L_3BITS L_1BITS = BEST( 3 ) L_2BITS = BEST( 4 ) L_3BITS = BEST( 5 ) IF OLD_1BITS <> L_1BITS OR OLD_2BITS <> L_2BITS OR OLD_3BITS <> L_3BITS THEN IS_NEW = 1 END SUB SUB LZ77_HEUR1( BEST() ) IF L_GAM_0 THEN P$ = "Y" ELSE P$ = "N" IF L_LEN_1 THEN P$ = P$ + HEX$( L_1BITS ) ELSE P$ = P$ + "N" P$ = P$ + HEX$( L_2BITS ) + HEX$( L_3BITS ) + HEX$( L_EXTND ) BG SCROLL 1, 8 TO 11, 14 STEP 0, -1 PAL 4 TEXT 1, 14, P$ + " " P1 = INSTR( H_DATABASE$( L_EXTND ), P$ ) IF P1 THEN H_SIZE = VAL( "0X" + MID$( H_DATABASE$( L_EXTND ), P1 + 6, 5 ) ) T$ = "....." WAIT 5 ELSE CALL LZ77_INIT IF L_EXTND = -1 THEN EXIT SUB CALL LZ77_MAIN CALL LZ77_SIZE H_DATABASE$( L_EXTND ) = H_DATABASE$( L_EXTND ) + P$ + HEX$( H_SIZE, 5 ) INC BEST( 7 ) PAL 3 TEXT 1, 7, STR$( BEST( 7 ) ) T$ = " " END IF TEXT 6, 14, RIGHT$( T$ + STR$( ( H_SIZE + 7 ) \ 8), 6 ) IF H_SIZE >= BEST( 6 ) THEN BG TINT 6, 14 TO 11, 14 PAL 4 ELSE BG TINT 1, 14 TO 11, 14 PAL 5 BG TINT 3, 2 TO 19, 5 PAL 0 TINT 19 - L_GAM_0, 2 PAL 1 IF L_LEN_1 THEN TINT L_1BITS + 3, 2 PAL 1 ELSE TINT 5 + 3, 2 PAL 1 TINT L_2BITS + 3, 3 PAL 1 TINT L_3BITS + 3, 4 PAL 1 TINT L_EXTND + 3, 5 PAL 1 BEST( 0 ) = L_EXTND BEST( 1 ) = L_GAM_0 BEST( 2 ) = L_LEN_1 BEST( 3 ) = L_1BITS BEST( 4 ) = L_2BITS BEST( 5 ) = L_3BITS BEST( 6 ) = H_SIZE END IF END SUB SUB LZ77_INIT OLD_EXT = L_EXTND IF L_EXTND = 1 THEN IF L_3BITS <> L_2BITS THEN L_EXTND = 2 ELSE IF L_EXTND = 0 THEN IF L_2BITS <> L_1BITS AND L_LEN_1 THEN L_EXTND = 1 IF L_3BITS <> L_2BITS THEN L_EXTND = 2 END IF IF OLD_EXT <> L_EXTND THEN PAL 6 TEXT 0, 15, " ERR:BAD PARAM!" L_EXTND = -1 EXIT SUB END IF L_1MAX = 2 ^ L_1BITS L_2MAX = 2 ^ L_2BITS L_3MAX = 2 ^ L_3BITS IF L_GAM_0 THEN L_BYTE2BIT = D_G2B( 1 ) + 1 + 8 L_L2B( 0 ) = L_BYTE2BIT IF L_LEN_1 THEN L_L2B( 1 ) = D_G2B( 1 ) + 1 + L_1BITS L_L2B( 2 ) = D_G2B( 2 ) + 0 + L_2BITS L_L2B( 3 ) = D_G2B( 3 ) + 0 + L_3BITS G1 = 4 ELSE L_L2B( 1 ) = -1 L_L2B( 2 ) = D_G2B( 1 ) + 1 + L_2BITS L_L2B( 3 ) = D_G2B( 2 ) + 0 + L_3BITS G1 = 3 END IF ELSE L_BYTE2BIT = D_G2B( 1 ) + 0 + 8 L_L2B( 0 ) = L_BYTE2BIT IF L_LEN_1 THEN L_L2B( 1 ) = D_G2B( 2 ) + 0 + L_1BITS L_L2B( 2 ) = D_G2B( 3 ) + 0 + L_2BITS L_L2B( 3 ) = D_G2B( 4 ) + 0 + L_3BITS G1 = 5 ELSE L_L2B( 1 ) = -1 L_L2B( 2 ) = D_G2B( 2 ) + 0 + L_2BITS L_L2B( 3 ) = D_G2B( 3 ) + 0 + L_3BITS G1 = 4 END IF END IF L_O2B( 1 ) = D_G2B( ( 1 - 1 ) \ L_3MAX + 1 ) L_O2B( 2 ) = D_G2B( ( 2 - 1 ) \ L_3MAX + 1 ) L_O2B( 3 ) = D_G2B( ( 3 - 1 ) \ L_3MAX + 1 ) FOR UNION_LEN1_OFF1 = 4 TO $3FFF L_L2B( UNION_LEN1_OFF1 ) = D_G2B( G1 ) + L_3BITS INC G1 L_O2B( UNION_LEN1_OFF1 ) = D_G2B( ( UNION_LEN1_OFF1 - 1 ) \ L_3MAX + 1 ) NEXT UNION_LEN1_OFF1 END SUB SUB LZ77_MAIN GREEDY_BIT = 0 GREEDY_LEN = 0 GREEDY_OFF = 0 DEFER_BIT = 0 DEFER_LEN = 0 DEFER_OFF = 0 MAX_LEN = L_P2 FOR L_P1 = 0 TO L_P2 SPRITE 0, 164.95 * L_P1 / L_P2 - 4, 122, 64 CALL LZ77_SEARCH( GREEDY_BIT, GREEDY_LEN, GREEDY_OFF, MAX_LEN ) IF GREEDY_LEN THEN IF L_P1 < L_P2 THEN INC L_P1 CALL LZ77_SEARCH( DEFER_BIT, DEFER_LEN, DEFER_OFF, MAX_LEN - 1 ) IF GREEDY_BIT > DEFER_BIT - L_BYTE2BIT THEN DEC L_P1 ELSE L_LEN( L_P1 - 1 ) = 0 DEC MAX_LEN GREEDY_LEN = DEFER_LEN GREEDY_OFF = DEFER_OFF END IF END IF END IF L_LEN( L_P1 ) = GREEDY_LEN L_OFF( L_P1 ) = GREEDY_OFF IF GREEDY_LEN >= 2 THEN ADD MAX_LEN, -GREEDY_LEN ADD L_P1, GREEDY_LEN - 1 ELSE DEC MAX_LEN END IF NEXT L_P1 SPRITE OFF 0 END SUB SUB LZ77_SEARCH( BEST_BIT, BEST_LEN, BEST_OFF, MAX_LEN ) REPEAT IF L_LEN_1 THEN P00 = S_P2PB( L_P1 ) IF P00 >= 0 AND L_P1 - P00 <= L_1MAX THEN BEST_LEN = 1 BEST_OFF = L_P1 - P00 ELSE BEST_LEN = 0 BEST_OFF = 0 END IF ELSE BEST_OFF = 0 BEST_LEN = 0 END IF UNTIL 1 REPEAT BIT1 = 0 CALL MATCH2SAVE( BIT1, BEST_LEN, BEST_OFF ) BEST_BIT = BIT1 P00 = S_P2PW( L_P1 ) P02 = MAX( 0, L_P1 - L_WINDOW_LIMIT_CPU ) WHILE P00 >= P02 FOR LEN2 = 2 TO MAX_LEN STEP 3 IF D_BUF3( L_P1 + LEN2 ) <> D_BUF3( P00 + LEN2 ) THEN EXIT NEXT LEN2 FOR LEN2 = LEN2 TO MAX_LEN IF D_BUF1( L_P1 + LEN2 ) <> D_BUF1( P00 + LEN2 ) THEN EXIT NEXT LEN2 IF LEN2 > BEST_LEN THEN OFF1 = L_P1 - P00 IF LEN2=2 AND OFF1<=L_2MAX OR LEN2>=3 AND OFF1<=L_3MAX OR LEN2>L_EXTND THEN CALL MATCH2SAVE( BIT1, LEN2, OFF1 ) IF BIT1 > BEST_BIT THEN BEST_LEN = LEN2 BEST_OFF = OFF1 BEST_BIT = BIT1 END IF END IF END IF P00 = S_P2PW( P00 ) WEND UNTIL 1 END SUB SUB MATCH2SAVE( SAVE_BITS, LEN1, OFF1 ) IF LEN1 > L_EXTND THEN SAVE_BITS = L_BYTE2BIT * LEN1 - L_L2B( LEN1 ) - L_O2B( OFF1 ) ELSE IF LEN1 THEN SAVE_BITS = L_BYTE2BIT * LEN1 - L_L2B( LEN1 ) ELSE SAVE_BITS = 0 END IF END SUB SUB LZ77_SIZE H_SIZE = 32 FOR P1 = 0 TO L_P2 ADD H_SIZE, L_L2B( L_LEN( P1 ) ) IF L_LEN( P1 ) THEN IF L_LEN( P1 ) > L_EXTND THEN ADD H_SIZE, L_O2B( L_OFF( P1 ) ) ADD P1, L_LEN( P1 ) - 1 END IF NEXT P1 END SUB SUB LZ77_ENCODE( DST_ADR ) P_DST = DST_ADR P_DBIT = 7 CALL POKEB( 14, L_P2 ) IF L_GAM_0 THEN IF L_LEN_1 THEN LEN2G = 0 ELSE LEN2G = -1 ELSE IF L_LEN_1 THEN LEN2G = 1 ELSE LEN2G = 0 END IF G2LEN = -LEN2G G2P3 = G2LEN - 1 CALL POKEB( 2, -G2P3 ) CALL POKEB( 1, L_GAM_0 ) CALL POKEB( 3, L_1BITS ) CALL POKEB( 4, L_2BITS ) CALL POKEB( 4, L_3BITS ) CALL POKEB( 4, L_EXTND ) FOR P1 = 0 TO L_P2 LEN1 = L_LEN( P1 ) IF LEN1 THEN CALL POKEG( LEN1 + LEN2G ) IF L_GAM_0 AND LEN1 + LEN2G = 1 THEN CALL POKEB( 1, %1 ) IF LEN1 = 1 THEN BT = L_1BITS ELSE IF LEN1 = 2 THEN BT = L_2BITS ELSE BT = L_3BITS CALL POKEB( BT, L_OFF( P1 ) - 1 ) IF LEN1 > L_EXTND THEN CALL POKEG( ( L_OFF( P1 ) - 1 ) \ L_3MAX + 1 ) ADD P1, LEN1 - 1 ELSE CALL POKEB( 1, %1 ) IF L_GAM_0 THEN CALL POKEB( 1, %0 ) CALL POKEB( 8, D_BUF1( P1 ) ) END IF NEXT P1 END SUB SUB POKEB( BITS, VALUE ) BIT2 = BITS WHILE BIT2 DEC BIT2 IF VALUE AND 2 ^ BIT2 THEN POKE P_DST, PEEK( P_DST ) OR 2 ^ P_DBIT ELSE POKE P_DST, PEEK( P_DST ) AND NOT 2 ^ P_DBIT END IF IF P_DBIT THEN DEC P_DBIT ELSE INC P_DST P_DBIT = 7 END IF WEND END SUB SUB POKEG( VALUE ) DIGITS = 0 TEMP = VALUE WHILE TEMP INC DIGITS TEMP = TEMP \ 2 WEND DST1 = P_DST CALL POKEB( DIGITS - 1, 0 ) CALL POKEB( DIGITS , VALUE ) T$ = "" FOR DST1 = DST1 TO P_DST T$ = T$ + BIN$( PEEK( DST1 ), 8 ) + " " NEXT DST1 END SUB SUB SPACE( NUM, T$, LENGTH ) T$ = STR$( NUM ) WHILE LEN( T$ ) < LENGTH T$ = " " + T$ WEND END SUB SUB PEARSON3( H, SRC0, BYTES ) SRC = SRC0 R2 = BYTES DIM X1111( 15 ), X1_1( 7 ) 'PERMUTATION TABLE IS A 24-BIT LFSR. TAP BITMASK IS $A0000F. RESTORE PEARSO1 PEARSO1: DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 READ X1111(%0001),X1111(%0010),X1111(%0100),X1111(%0111),X1111(%1000),X1111(%1011) READ X1111(%1101),X1111(%1110),X1_1(%001),X1_1(%011),X1_1(%100),X1_1(%110) H = 0 WHILE R2 >= 3 H = H XOR ( $10000 * PEEK( SRC + 2 ) + ( PEEKW( SRC ) + $10000 AND $FFFF ) ) IF X1_1( H \ $200000 ) XOR X1111( H AND $F ) THEN H = H \ 2 + $800000 ELSE H = H \ 2 ADD SRC, 3 ADD R2, -3 WEND IF R2 = 2 THEN H = H XOR ( PEEKW( SRC ) + $10000 AND $FFFF ) IF X1_1( H \ $200000 ) XOR X1111( H AND $F ) THEN H = H \ 2 + $800000 ELSE H = H \ 2 ELSE IF R2 = 1 THEN H = H XOR PEEK ( SRC ) IF X1_1( H \ $200000 ) XOR X1111( H AND $F ) THEN H = H \ 2 + $800000 ELSE H = H \ 2 IF X1_1( H \ $200000 ) XOR X1111( H AND $F ) THEN H = H \ 2 + $800000 ELSE H = H \ 2 END IF END SUB SUB TITLE( S$ ) L$ = LEFT$( " ", INT( ( 20 - LEN( S$ ) ) / 2 ) ) R$ = LEFT$( " ", INT( ( 20 - LEN( S$ ) ) / 2 + 0.5 ) ) PAL 0 CLS 0 WINDOW 0, 0, 20, 16, 0 PAL 2 PRINT L$ + S$ + R$; PAL 0 END SUB SUB HEADING( CY, S$ ) L$ = LEFT$( " ", INT( ( 20 - LEN( S$ ) ) / 2 ) ) R$ = LEFT$( " ", INT( ( 20 - LEN( S$ ) ) / 2 + 0.5 ) ) PAL 3 LOCATE 0, CY PRINT L$ + S$ + R$; PAL 0 END SUB SUB PROMPT( CY, TERM$, RANGE$ ) PAL 1 TEXT 14, CY, "?" TEXT 0, CY, TERM$ PAL 0 TEXT 14 - LEN( RANGE$ ), CY, RANGE$ END SUB SUB DISP( CY, TERM$, VALUE$ ) PAL 1 TEXT 14, CY, " " TEXT 0, CY, TERM$ PAL 0 TEXT 14 - LEN( VALUE$ ), CY, VALUE$ END SUB SUB STR_INPUT( CX, CY, RET_STR$, CHOICE_A$, CHOICE_B$ ) REPEAT TEXT CX, CY, LEFT$( " ", 20 - CX ) LOCATE CX, CY INPUT RET_STR$ UNTIL RET_STR$ = CHOICE_A$ OR RET_STR$ = CHOICE_B$ OR RET_STR$ = "X" IF RET_STR$ = "X" THEN TEXT CX, CY, " " END SUB SUB STR_INPUT6( CX, CY, RET_STR$, A$, B$, C$, D$, E$, F$ ) REPEAT TEXT CX, CY, LEFT$( " ", 20 - CX ) LOCATE CX, CY INPUT RET_STR$ UNTIL LEN(RET_STR$)=1 AND INSTR(A$+B$+C$+D$+E$+F$+"X",RET_STR$) IF RET_STR$ = "X" THEN TEXT CX, CY, " " END SUB SUB NUM_INPUT( CX, CY, RET_VAL, LO, HI ) D$ = "0123456789" REPEAT TEXT CX, CY, LEFT$( " ", 20 - CX ) LOCATE CX, CY INPUT S$ IF LEN( S$ ) > 0 THEN IS_NUM = -1 ELSE IS_NUM = 0 FOR P = 1 TO LEN( S$ ) IS_NUM = IS_NUM AND ( INSTR( D$, MID$( S$, P, 1 ) ) <> 0 ) NEXT P IF IS_NUM THEN RET_VAL = VAL( S$ ) ELSE RET_VAL = -2 IF S$ = "X" THEN RET_VAL = -1 UNTIL RET_VAL = -1 OR LO <= RET_VAL AND RET_VAL <= HI IF RET_VAL = -1 THEN TEXT CX, CY, " " END SUB SUB HEX_INPUT( CX, CY, RET_VAL, LO, HI ) D$ = "0123456789ABCDEF" REPEAT TEXT CX, CY, LEFT$( " ", 20 - CX ) LOCATE CX, CY INPUT S$ IF LEN( S$ ) > 0 THEN IS_NUM = -1 ELSE IS_NUM = 0 FOR P = 1 TO LEN( S$ ) IS_NUM = IS_NUM AND ( INSTR( D$, MID$( S$, P, 1 ) ) <> 0 ) NEXT P IF IS_NUM THEN RET_VAL = VAL( "0X" + S$ ) ELSE RET_VAL = -2 IF S$ = "X" THEN RET_VAL = -1 UNTIL RET_VAL = -1 OR LO <= RET_VAL AND RET_VAL <= HI IF RET_VAL = -1 THEN TEXT CX, CY, " " END SUB SUB COMMENT( CY, R ) IF FILE$( R ) = "" OR FSIZE( R ) = 0 THEN C$ = "(EMPTY)" ELSE C$ = FILE$( R ) IF FSIZE( R ) > $4000 THEN C$ = LEFT$( C$ + " ", 20 ) MID$( C$, 6, 13 ) = "...16KB MAX!" END IF C$ = "#" + STR$( R ) + ":" + LEFT$( C$, 18 - LEN( STR$( R ) ) ) TEXT 0, CY, " " TEXT 0, CY, C$ END SUB 'PALETTES: 0 RANGE/VALUE/IO, 1 DISP/PROMPT TERM, 2 TITLE, 3 HEADING #1:MAIN PALETTES 2A152A00003F2A00000F0500000A2A00 002A1500003F151500202A0000082A00 #2:MAIN CHARACTERS 0000000000000000FFFFFFFFFFFFFFFF 0018181818001800FFE7E7E7E7FFE7FF 006C6C2400000000FF9393DBFFFFFFFF 00247E24247E2400FFDB81DBDB81DBFF 00083E380E3E0800FFF7C1C7F1C1F7FF 0062640810264600FF9D9BF7EFD9B9FF 001C34386E643A00FFE3CBC7919BC5FF 0018183000000000FFE7E7CFFFFFFFFF 000C183030180C00FFF3E7CFCFE7F3FF 0030180C0C183000FFCFE7F3F3E7CFFF 000024187E182400FFFFDBE781E7DBFF 000018187E181800FFFFE7E781E7E7FF 0000000018183000FFFFFFFFE7E7CFFF 000000007E000000FFFFFFFF81FFFFFF 0000000000181800FFFFFFFFFFE7E7FF 00060C1830604000FFF9F3E7CF9FBFFF 003C666E76663C00FFC399918999C3FF 0018381818187E00FFE7C7E7E7E781FF 003C660C18307E00FFC399F3E7CF81FF 003C660C06663C00FFC399F3F999C3FF 0066667E06060600FF999981F9F9F9FF 007E607C06067C00FF819F83F9F983FF 001C307C66663C00FFE3CF839999C3FF 007E060C18303000FF81F9F3E7CFCFFF 003C663C66663C00FFC399C39999C3FF 003C663E06663C00FFC399C1F999C3FF 0000001800180000FFFFFFE7FFE7FFFF 0000001800183000FFFFFFE7FFE7CFFF 00000C1830180C00FFFFF3E7CFE7F3FF 0000007E007E0000FFFFFF81FF81FFFF 000030180C183000FFFFCFE7F3E7CFFF 003C660C18001800FFC399F3E7FFE7FF 003C666E6E603C00FFC39991919FC3FF 00183C667E666600FFE7C399819999FF 007C667C66667C00FF839983999983FF 003C666060663C00FFC3999F9F99C3FF 00786C66666C7800FF879399999387FF 007E607860607E00FF819F879F9F81FF 007E607860606000FF819F879F9F9FFF 003C606E66663C00FFC39F919999C3FF 0066667E66666600FF999981999999FF 003C181818183C00FFC3E7E7E7E7C3FF 001E060606663C00FFE1F9F9F999C3FF 00666C78786C6600FF999387879399FF 0060606060607E00FF9F9F9F9F9F81FF 0042667E7E666600FFBD9981819999FF 0066767E6E666600FF998981919999FF 003C666666663C00FFC399999999C3FF 007C667C60606000FF8399839F9F9FFF 003C66666A6C3E00FFC399999593C1FF 007C667C786C6600FF839983879399FF 003E603C06067C00FFC19FC3F9F983FF 007E181818181800FF81E7E7E7E7E7FF 0066666666663C00FF9999999999C3FF 00666666663C1800FF99999999C3E7FF 0066667E7E664200FF9999818199BDFF 00663C183C666600FF99C3E7C39999FF 0066663C18181800FF9999C3E7E7E7FF 007E0C1830607E00FF81F3E7CF9F81FF 003C303030303C00FFC3CFCFCFCFC3FF 006030180C060200FF9FCFE7F3F9FDFF 003C0C0C0C0C3C00FFC3F3F3F3F3C3FF 00183C6600000000FFE7C399FFFFFFFF 0000000000007E00FFFFFFFFFFFF81FF 60F0F060000000000000000000000000