It's not what I'd call 'complete', but it works really well on the screens I gave it. Less well on the poncy stuff you find on ZXArt!
The packer isn't the slickest but I don't think that matters much. The depacker could probably be optimised A LOT, but it's not worth it just yet while the algorithm could still do with a few tweaks. I'm thinking of adding code to let it declare a block of literals like I've just added blocks of zeros, though that means look-ahead code which is harder to do within the Spectrum code. And back-tracking and copying previous data works for generic data packers, but it doesn't seem to serve graphics so well.
My 'MiniDict' technique is to XOR each attribute with the one before, which turns repetitions into zeros.
I then XOR each pixel line with the one above, which again reduces blocks of pixels to just lines and dots around the edges. (What it's not good at is stipples).
Then I do a frequency analysis of what's left, and pick out the 16 most commonly used bytes (other than 0). Again, this takes advantage of the dots that are left by the XOR process.
The encoding is a bitstream (bit #7 of each byte handled first) as follows:
16 x bytes - common byte mini-dictionary
- then -
0 bit -> 0 byte
1,0 bit -> read next four bits (hi first), look up byte in mini-dicitonary
1,1 bit -> read next 8 bits (hi first) as literal byte
I've just added a refinement that after six 0 bits, it then either flags a 1 to continue otherwise it contains a binary number of how many more zero bytes to skip. This is encoded as a number of 0 bits to tell it how many data bits are coming up, then a 1 and subsequent n-bits make up that number, and this is how many zeros to write out. This helps it skip over large blank areas of the screen.
Then it just keeps going until it's unpacked 6912 bytes in total.
Code: Select all
;MINIDICT COMPRESSOR 3
;by Jason J Railton
;
;v3.2 dated 17/10/2019
;
;Whole-screen compressor with XOR pre-processing and
;minimal dictionary for the ZX Spectrum.
;
; 1. Compile in PASMO with --TAPBAS option and Run in an emulator.
;
; 2. At first pause, import your .SCR file into the emulation RAM
; at 16384, then press a key and wait.
;
; 3. When compression is complete, the screen is cleared to a pattern
; of blue stripes. Press a key to test un-packing.
; *** Please report any errors along with the example screen! ***
;
; 4. If all goes OK, press a key and it will display the address and
; size of the compressed data to save as a binary, and return
; to BASIC.
;
; 5. The de-packer code is self-contained at the end of this listing
; and can be cut-out and used seprately. Remove the ';' to enable
; the duplicate of the 'MD_MAX_ZEROES EQU 6' definition. This must
; always be the same as the definition of 'ZERO_COUNT' in the
; packer code.
;
;Free to use as-is, in Spectrum games without credit.
;
;If you modify it, please share your modifications publicly
;and in that instance credit me with the original algorithm.
;
;Works very well on distinct line art and large blocks of colour.
;Some images may be edited to have more consistent INK/PAPER pairings
;and avoid swapping between solid/inverse video so much; this can
;improve the compression.
;
;Anything highly detailed with lots of stippling will probably end
;up bigger than you started with! You have been warned!
FREQ EQU 34000
DATA EQU 35000
SCREEN EQU 16384
ATTRS EQU 22528
SCREEN_SIZE EQU 6144
SCREEN_LINES EQU 192
ATTRS_SIZE EQU 768
ZERO_COUNT EQU 6
MD_MAX_ZEROES EQU 6
org 32768
entry_point
;----------------
ld a,0
out (254),a
;----------------
;PRINT to screen:
ld a,2
call 5633
;Instructions to load screen:
ld de,instruct
ld bc,endinstruct-instruct
call 8252
call waitkey
;----------------
ld a,6
out (254),a
;----------------
;Store to enable safe return to BASIC:
di
exx
push hl
push iy
;----------------
;XOR the attr lines
;Note that the first byte of the attributes is XORed
;with the last byte of the pixels, so we must do the
;attributes first, while the pixels are unchanged:
ld de,ATTRS+ATTRS_SIZE-1
ld hl,ATTRS+ATTRS_SIZE
ld bc,ATTRS_SIZE
xorloop1
dec hl
dec de
ld a,(de)
xor (hl)
ld (hl),a
dec bc
ld a,b
or c
jr nz,xorloop1
;----------------
ld a,5
out (254),a
;----------------
;XOR the screen lines:
ld ixl,SCREEN_LINES-1
xorloop2
call lineaddr
ex de,hl
dec ixl
call lineaddr
call xordown32
ld a,ixl
and a
jr nz,xorloop2
;----------------
ld a,4
out (254),a
;----------------
;Prepare a frequency table (8-bit, capped):
ld hl,FREQ
ld a,0
indexloop1
ld (hl),a
inc hl
ld (hl),0
inc hl
add a,1
jr nz,indexloop1
;Calculate the (value,count) frequency table:
ld de,SCREEN
ld ix,SCREEN_SIZE+ATTRS_SIZE
ld iyl,0
statsloop1
ld a,(de)
;Increase freq count:
ld b,0
ld c,a
ld hl,FREQ+1
add hl,bc
add hl,bc
ld a,(hl)
add a,1
jr c,skipstats1
ld (hl),a
skipstats1
inc de
dec ix
ld a,ixh
or ixl
jr nz,statsloop1
;----------------
ld a,3
out (254),a
;----------------
;Sort the frequency table (assume 0 is most common):
sort
ld ix,FREQ+2
ld b,254
sortloop1
ld a,(ix+1)
cp (ix+3)
jr nc,sortloopnext
ld c,(ix+3)
ld (ix+3),a
ld (ix+1),c
ld a,(ix+0)
ld c,(ix+2)
ld (ix+0),c
ld (ix+2),a
dec ix
dec ix
inc b
jr nz,sortloop1
sortloopnext
inc ix
inc ix
djnz sortloop1
;----------------
ld a,2
out (254),a
;----------------
;Prepare compressed data.
;Copy quick value dictionary (16 values,
; skip first entry, assume always the 0s):
ld hl,FREQ+2
ld de,DATA
ld b,16
copydictloop
ld a,(hl)
ld (de),a
inc hl
inc hl
inc de
djnz copydictloop
;----------------
;Bitstream pixels:
ld hl,DATA+16
ld b,8
ld c,0
;Multi-zero counter:
ex af,af'
ld a,ZERO_COUNT
ex af,af'
;Do 192 pixel lines in order:
ld ixl,0
streamloop1
push bc
call lineaddr
pop bc
;Do 32 bytes per line:
ld ixh,32
streamloop2
;Do a byte:
ld a,(de)
call streambyte
;Next byte:
inc de
dec ixh
jr nz,streamloop2
inc ixl
ld a,ixl
cp SCREEN_LINES
jr nz,streamloop1
;Bitstream ATTRs:
ld de,ATTRS
ld ix,ATTRS_SIZE
streamloop3
ld a,(de)
call streambyte
inc de
dec ix
ld a,ixl
or ixh
jr nz,streamloop3
;Finished, check for a zero count to stream:
ex af,af'
and a
call z,end_stream_multi_zeroes
;Check for any spare bits to fill the last byte:
check_sparebits
ld a,b
cp 8
jr z,streamskipend
call streambit0
jr check_sparebits
streamskipend
;Pass on compressed data length for report:
and a
ld bc,DATA
sbc hl,bc
ld (exit+1),hl
;----------------
ld a,1
out (254),a
;----------------
;Clear screen:
ld hl,SCREEN
ld de,SCREEN+1
ld bc,SCREEN_SIZE-1
ld (hl),15
ldir
ld hl,ATTRS
ld de,ATTRS+1
ld bc,ATTRS_SIZE-1
ld (hl),79
ldir
;----------------
ld a,0
out (254),a
;----------------
;Retore to enable safe return to BASIC:
pop iy
pop hl
exx
ei
;Instructions to test unpacking:
ld de,unpack
ld bc,endunpack-unpack
call 8252
call waitkey
;----------------
ld a,6
out (254),a
;----------------
;Unpack screen:
di
exx
push hl
push iy
ld hl,DATA
ld de,SCREEN
call UNPACK_MINIDICT_3
pop iy
pop hl
exx
ei
;----------------
ld a,0
out (254),a
;----------------
call waitkey
;Report compressed data size:
ld hl,(exit+1)
call printlen
;Return to BASIC:
exit
ld bc,0000
ret
;----------------
;Common subroutines:
waitkey
wait0
xor a
in a,(254)
and 00011111b
xor 00011111b
jr nz,wait0
wait1
xor a
in a,(254)
and 00011111b
xor 00011111b
jr z,wait1
wait2
xor a
in a,(254)
and 00011111b
xor 00011111b
jr nz,wait2
ret
;----------------
printlen
ld bc,10000
ld de,midstring
call div10s
ld bc,1000
inc de
call div10s
ld bc,100
inc de
call div10s
ld bc,10
inc de
call div10s
ld a,l
inc de
add a,'0'
ld (de),a
ld de,string
ld bc,endstring-string
call 8252
ret
;----------------
div10s
ld a,'0'
div10srpt
ld (de),a
add a,1
sbc hl,bc
jr nc,div10srpt
add hl,bc
ret
;----------------
;XORing subroutines:
lineaddr
;Get the address in DE of the pixel line number in IXL.
;Uses A, BC:
ex de,hl
ld a,ixl
and 56
rlca
rlca
ld c,a
ld a,ixl
and 7
ld b,a
ld a,ixl
and 192
rrca
rrca
rrca
or b
ld b,a
ld hl,SCREEN
add hl,bc
ex de,hl
ret
xordown32
ld b,32
xordownloop
ld a,(de)
xor (hl)
ld (hl),a
inc de
inc hl
djnz xordownloop
ret
;----------------
;Bitstreaming subroutines:
;Encode a byte in A:
streambyte
;Test for zero:
and a
jr z,streambyte0
;Handle non-zero:
push af
ex af,af'
and a
call z,end_stream_multi_zeroes
ld a,ZERO_COUNT
ex af,af'
pop af
streambyte1
;Mini-dictionary look-up:
exx
ld hl,DATA
ld c,0
ld b,16
dictloop1
cp (hl)
jr z,streamdict
inc hl
inc c
djnz dictloop1
exx
;Last option, flag another 1 and stream the whole byte:
jr streamlit
;Mini-dictionary entries encoded by
; a 1, a 0, then the 4-bit index:
streamdict
ld a,c
exx
rla
rla
rla
rla
call streambit1
call streambit0
rla
call streambit
rla
call streambit
rla
call streambit
rla
call streambit
ret
;Literal bytes encoded by
; a 1, a 1, then 8 bits of raw data:
streamlit
call streambit1
call streambit1
rla
call streambit
rla
call streambit
rla
call streambit
rla
call streambit
rla
call streambit
rla
call streambit
rla
call streambit
rla
call streambit
ret
;Zeroes encoded by a zero bit:
streambyte0
ex af,af'
and a
jr z,stream_multi_zeroes
dec a
jr z,init_stream_multi_zeroes
call streambit0
ex af,af'
ret
init_stream_multi_zeroes
;This zero:
call streambit0
;Start counting zeroes:
exx
ld bc,0
exx
ex af,af'
ret
stream_multi_zeroes
exx
inc bc
exx
ex af,af'
ret
end_stream_multi_zeroes
ex af,af'
exx
ld a,b
and a
jr nz,stream_zero_count
ld a,c
cp 2
jr nc,stream_zero_count
ld a,c
exx
call streambit1
and a
jr z,zeroes_corrected
correct_zeroes
call streambit0
dec a
jr nz,correct_zeroes
zeroes_corrected
ld a,ZERO_COUNT
ex af,af'
ret
stream_zero_count
dec bc
ld l,0
stream_zero_count_bits
srl b
rr c
rr d
rr e
inc l
ld a,b
or c
jr nz,stream_zero_count_bits
ld a,l
exx
stream_num_bits
call streambit0
dec a
jr nz,stream_num_bits
exx
ld a,l
stream_count_bits
sla e
rl d
exx
call streambit
exx
dec a
jr nz,stream_count_bits
exx
ld a,ZERO_COUNT
ex af,af'
ret
;Set a 0 or a 1 in the data stream:
streambit1
scf
jr streambit
streambit0
and a
streambit
rl c
dec b
ret nz
ld (hl),c
inc hl
ld c,0
ld b,8
ret
;----------------
;Text Strings:
instruct
defb 13,'Load screen to compress', 13, 'and press any key',13
endinstruct equ $
unpack
defb 13,'Press any key to test unpacking',13
endunpack equ $
string
defb 13, 'Compressed: 35000,'
midstring
defb '00000', 13
endstring equ $
;----------------
;---------------------------
;UNPACK FUNCTION STARTS HERE
;---------------------------
;HL = Compressed data source
;DE = Target address
;
;Uses all registers, alternates, and stack.
;PUSH and POP IY for safety if calling from BASIC.
;MD_MAX_ZEROES EQU 6
UNPACK_MINIDICT_3
;Dictionary address into IX:
push hl
pop ix
;Data address into IY:
ld bc,16
add hl,bc
push hl
pop iy
;Set first line to do no XOR operation:
xor a
ld (xor_func),a
;Set zeroes counter to max, in A':
ex af,af'
ld a,MD_MAX_ZEROES
ex af,af'
;First byte of bitstream:
call unstreaminit
;Do 3 screen thirds:
ld a,3
unstreamloop1
push af
;Do 8 character rows per third:
ld a,8
unstreamloop2
push af
;Do 8 pixel lines per character row:
ld a,8
unstreamloop3
push af
;Save this line's address for the next XOR:
push de
;Do one pixel line, possibly XORing with the
;previous line:
ld a,32
unstreamloop4
push af
;Unpack a byte and XOR with previous line:
call unstreambyte
xor_func
xor (hl)
ld (de),a
inc hl
inc de
;Repeat for 32 bytes:
pop af
dec a
jr nz,unstreamloop4
;Next pixel line:
;Put XOR (HL) function back in:
ld a,$AE
ld (xor_func),a
;Retrieve address to be XORed:
pop hl
;Next pixel line address:
ld d,h
ld e,l
inc d
;Repeat for 8 pixel lines:
pop af
dec a
jr nz,unstreamloop3
;Adjust DE pointer for next character row:
push bc
ex de,hl
ld bc,32-(256*8)
add hl,bc
ex de,hl
pop bc
;Repeat for 8 character rows:
pop af
dec a
jr nz,unstreamloop2
;Adjust DE pointer for next screen third:
push bc
ex de,hl
ld bc,2048-(32*8)
add hl,bc
ex de,hl
pop bc
;Repeat for 3 screen thirds:
pop af
dec a
jr nz,unstreamloop1
;Unpack ATTRs:
;Put the target address in HL:
ex de,hl
dec hl
ld de,768
unstreamloop5
;Each ATTR byte XORed with the one before, including the
;last byte of the pixel data XORed with the first attribute:
call unstreambyte
xor (hl)
inc hl
ld (hl),a
dec de
ld a,e
or d
jr nz,unstreamloop5
ret
;----------------
;Unpacker subroutines:
;Unstream one byte.
;0 in the bitstream is a zero byte:
unstreambyte
;Are we in multi-zeroes mode:
ex af,af'
and a
jr z,multi_zeroes
;Note still using AF', but A is safe from change:
;0 in the bitstream means another 0 byte,
;1 means something to decode:
call unstreambit
jr c,unstreamdecode
;Got another zero. Does this tip us over into
;multi-zero mode:
dec a
jr z,init_multi_zeroes
;If not, just return one zero byte:
ex af,af'
xor a
ret
;Start multi-zero mode by extracting the count:
init_multi_zeroes
;A 1 means don't actually enter multi-zero mode:
call unstreambit
jr c,end_multi_zeroes
ex af,af'
;How many bits in count?
xor a
multi_zero_bit_count
inc a
call unstreambit
jr nc,multi_zero_bit_count
;Fetch n bits into BC', so we will
;supply BC+1 zeroes:
exx
ld bc,1
multi_zero_bit_fetch
dec a
jr z,multi_zero_bit_fetch_done
exx
call unstreambit
exx
rl c
rl b
jr multi_zero_bit_fetch
multi_zero_bit_fetch_done
inc bc
exx
;Return a first zero:
xor a
ret
;Multi-zero mode. Keep returning zeroes
;until BC' is exhausted:
multi_zeroes
ex af,af'
exx
dec bc
ld a,b
or c
exx
jr nz,multi_zeroes_do_one
end_multi_zeroes:
ex af,af'
ld a,MD_MAX_ZEROES
ex af,af'
multi_zeroes_do_one
xor a
ret
;Further decoding of bitstream.
;1,0,Hi,n,n,Lo in the bitstream is a dictionary lookup:
unstreamdecode
;Reset zeroes counter:
ld a,MD_MAX_ZEROES
ex af,af'
;Decode either a dictionary or a literal:
call unstreambit
jr c,unstreamliteral
xor a
call unstreamnyb
ld (unstreamdict+2),a
unstreamdict
ld a,(ix+0)
ret
;Last resort decoding bitstream.
;1,1,Hi,n,n,n,n,n,n,Lo in the bitstream is a literal byte:
unstreamliteral
call unstreamnyb
call unstreamnyb
ret
;Stream bits from C until counter B runs out,
;then fetch a new byte in C:
unstreambit
rl c
dec b
ret nz
unstreaminit
ld c,(iy)
ld b,8
inc iy
ret
;Stream 4 bits to make a nybble:
unstreamnyb
call unstreambit
rla
call unstreambit
rla
call unstreambit
rla
call unstreambit
rla
ret
;---------------------------
;UNPACK FUNCTION ENDS HERE
;---------------------------
END entry_point