Ok, lets begin:
This is a color compression I've been working on. It saves 1/4 of a 32-bit bitmap size and around 1/3 of a 24-bit one.
Here's the manual version:
sync on
sync rate 0
sync
dim colors(256,3)
do
print "Image converter"
input "Create or compare: ", c$
pallete = 0
for a=1 to 6
for b=1 to 6
for c=1 to 6
inc pallete
colors(pallete,1)=(a-1)*42
colors(pallete,2)=(b-1)*42
colors(pallete,3)=(c-1)*42
next c
next b
next a
colors(217,1)=255
colors(217,2)=255
colors(217,3)=255
if lower$(c$) = "create"
input "Image: ", img$
input "Name for .256 file (do not include .256): ", fl$
print ""
print "- Palette mode -"
print "Standard [1]"
print "Customize [2]"
print "Quick [3]"
print ""
input "Palette: ", p$
if p$ = "4" then input "Color vibrance: ", cvib
cls
if file exist(img$)=1
load image img$, 1, 1
paste image 1,1,1,0
sprite 1, 0,0, 1
hide sprite 1
set sprite 1, 0, 0
if file exist(fl$+".256")=0
open to write 1, fl$+".256"
else
delete file fl$+".256"
open to write 1, fl$+".256"
endif
sync
if p$ = "2"
text sprite width(1)+5,5,"Select 256 colors"
while mclick < 256
inc mclick
ink rgb(255,255,255),0
text sprite width(1)+5,20,"Nr. "+str$(mclick)+"/256"
while mouseclick() = 0
bf = point(mousex(),mousey())
colors(mclick,1)=rgbr(bf)
colors(mclick,2)=rgbg(bf)
colors(mclick,3)=rgbb(bf)
ink rgb(255,255,255),0
box sprite width(1)+4, 24+mclick*10, sprite width(1)+47,32+mclick*10
ink rgb(colors(mclick,1),colors(mclick,2),colors(mclick,3)),0
box sprite width(1)+6, 27+mclick*10, sprite width(1)+44,29+mclick*10
sync
endwhile
while mouseclick() = 1
sync
endwhile
ink 0,0
box sprite width(1)+5,20,sprite width(1)+100,34
endwhile
endif
if p$ = "3"
bf = point(1,1)
colors(1,1)=rgbr(bf)
colors(1,2)=rgbg(bf)
colors(1,3)=rgbb(bf)
found = 1
for a=1 to sprite width(1)+1
lock pixels
for b=1 to sprite height(1)+1
bf = point(a,b)
result = 0
for c=1 to found
v = abs(colors(c,1)-rgbr(bf)) + abs(colors(c,2)-rgbg(bf)) + abs(colors(c,3)-rgbb(bf))
if v < cvib then inc result
next c
if result = 0 and found < 256
inc found
colors(found,1)=rgbr(bf)
colors(found,2)=rgbg(bf)
colors(found,3)=rgbb(bf)
endif
next b
unlock pixels
ink 0,0
box sprite width(1)+4, 24, sprite width(1)+147,60
ink rgb(255,255,255),0
text sprite width(1)+6,26,"Colors: "+str$(found)+"/256"
sync
if found = 256 then a = sprite width(1)
next a
endif
write word 1, sprite width(1)
write word 1, sprite height(1)
write byte 1, asc(p$)
if p$ <> "1"
for a=1 to 256
for b=1 to 3
write byte 1,colors(a,b)
next b
next a
endif
lock pixels
for a=1 to sprite width(1)
for b=1 to sprite height(1)
color = point(a,b)
if color <> old_color
bmatch = 1
for q=1 to 256
bmatch = dif(color,bmatch,q)
next q
endif
write byte 1,bmatch-1
old_color = color
next b
if escapekey()=1 then close file 1 : unlock pixels : end
next a
unlock pixels
close file 1
endif
endif
if lower$(c$) = "compare"
input " Image: ", img$
input "256 file (without .256): ", img2$
cls
load image img$, 1,1
if file exist(img2$+".256")=1
open to read 1, img2$+".256"
read word 1, width
read word 1, height
read byte 1, buffer
if chr$(buffer)<>"1"
for a=1 to 256
for b=1 to 3
read byte 1,buf
colors(a,b)=buf
next b
next a
endif
for a=1 to width
lock pixels
for b=1 to height
read byte 1, match
dot a,b,rgb(colors(match+1,1),colors(match+1,2),colors(match+1,3))
next b
unlock pixels
sync
next a
close file 1
endif
get image 2,1,1,width+1,height+1,1
cls
sync
paste image 1,1,1,0
paste image 2,width+1,1,0
if file exist(img2$+".bmp")=1 then delete file img2$+".bmp"
center text width/2,height+5,"Uncompressed: "+str$(file size(img$))+"b"
center text width/2,height+20,"Colors: 16777216"
center text width+(width/2),height+5,"Compressed: "+str$(file size(img2$+".256"))+"b"
center text width+(width/2),height+20,"Colors: 256"
center text width+(width/2),height+35,"Custom pallete: "+chr$(buffer)
center text width,height+95,"Compression by Emperor-Baal"
while spacekey()=0 : sync : endwhile
endif
cls
loop
function dif(color,match,q)
r = rgbr(color)
g = rgbg(color)
b = rgbb(color)
dif1 = abs(colors(match,1)-r) + abs(colors(match,2)-g) + abs(colors(match,3)-b)
dif2 = abs(colors(q,1)-r) + abs(colors(q,2)-g) + abs(colors(q,3)-b)
if dif2 < dif1 then exitfunction q
endfunction match
Here's the automatic version:
sync on
sync rate 0
sync
dim colors(256,3)
stri$ = cl$()
if (mid$(stri$,len(stri$)-3)+mid$(stri$,len(stri$)-2)+mid$(stri$,len(stri$)-1))="256" then c$ = "compare"
if (mid$(stri$,len(stri$)-3)+mid$(stri$,len(stri$)-2)+mid$(stri$,len(stri$)-1))="bmp" then c$ = "create"
if (mid$(stri$,len(stri$)-3)+mid$(stri$,len(stri$)-2)+mid$(stri$,len(stri$)-1))="jpg" then c$ = "create"
if (mid$(stri$,len(stri$)-3)+mid$(stri$,len(stri$)-2)+mid$(stri$,len(stri$)-1))="png" then c$ = "create"
pallete = 0
b$ = ""
for a=2 to len(stri$)-1
b$ = b$ + mid$(stri$,a)
next a
stri$ = b$
for a=1 to 6
for b=1 to 6
for c=1 to 6
inc pallete
colors(pallete,1)=(a-1)*42
colors(pallete,2)=(b-1)*42
colors(pallete,3)=(c-1)*42
next c
next b
next a
colors(217,1)=255
colors(217,2)=255
colors(217,3)=255
if lower$(c$) = "create"
cvib = 20
fl$ = ""
for a=1 to len(stri$)-4
fl$ = fl$ + mid$(stri$,a)
next a
img$ = stri$
load image img$, 1, 1
paste image 1,1,1,0
sprite 1, 0,0, 1
hide sprite 1
set sprite 1, 0, 0
if file exist(fl$+".256")=0
open to write 1, fl$+".256"
else
delete file fl$+".256"
open to write 1, fl$+".256"
endif
sync
bf = point(1,1)
colors(1,1)=rgbr(bf)
colors(1,2)=rgbg(bf)
colors(1,3)=rgbb(bf)
found = 1
for a=1 to sprite width(1)+1
if found < 256
lock pixels
for b=1 to sprite height(1)+1
bf = point(a,b)
result = 0
for c=1 to found
v = abs(colors(c,1)-rgbr(bf)) + abs(colors(c,2)-rgbg(bf)) + abs(colors(c,3)-rgbb(bf))
if v < cvib then inc result
next c
if result = 0 and found < 256
inc found
colors(found,1)=rgbr(bf)
colors(found,2)=rgbg(bf)
colors(found,3)=rgbb(bf)
endif
next b
unlock pixels
ink 0,0
box sprite width(1)+4, 24, sprite width(1)+147,60
ink rgb(255,255,255),0
text sprite width(1)+6,26,"Colors: "+str$(found)+"/256"
sync
endif
next a
write word 1, sprite width(1)
write word 1, sprite height(1)
write byte 1, asc("4")
for a=1 to 256
for b=1 to 3
write byte 1,colors(a,b)
next b
next a
for a=1 to sprite width(1)
lock pixels
for b=1 to sprite height(1)
color = point(a,b)
if color <> old_color
bmatch = 1
for q=1 to 256
bmatch = dif(color,bmatch,q)
next q
endif
write byte 1,bmatch-1
old_color = color
next b
unlock pixels
ink 0,0
box sprite width(1)+4, 1, sprite width(1)+447,600
ink rgb(255,255,255),0
found$ = str$(100.0 / ( ( sprite width(1)^2 ) / ( a * sprite width(1) ) ))
text sprite width(1)+6,26,"Percentage: "+found$+"%"
sync
next a
close file 1
end
endif
if lower$(c$) = "compare"
open to read 1, stri$
read word 1, width
read word 1, height
read byte 1, buffer
if chr$(buffer)<>"1"
for a=1 to 256
for b=1 to 3
read byte 1,buf
colors(a,b)=buf
next b
next a
endif
for a=1 to width
lock pixels
for b=1 to height
read byte 1, match
dot a,b,rgb(colors(match+1,1),colors(match+1,2),colors(match+1,3))
next b
unlock pixels
sync
next a
close file 1
while escapekey()=0
sync
endwhile
end
endif
function dif(color,match,q)
r = rgbr(color)
g = rgbg(color)
b = rgbb(color)
dif1 = abs(colors(match,1)-r) + abs(colors(match,2)-g) + abs(colors(match,3)-b)
dif2 = abs(colors(q,1)-r) + abs(colors(q,2)-g) + abs(colors(q,3)-b)
if dif2 < dif1 then exitfunction q
endfunction match
Manual:
Create a new one, type the image path and a filename. Next select a compression mode:
Standard, uses 217 color palette. Low / normal quality
Customize, select 256 colors to compile with. Best quality
Quick, finds 256 colors to use. Good / Very good quality, depends on color vibrance value. Default CV value = 20
Compiling takes some time though.
Automatic:
To create a new .256 file: Drag the image on the executable, the file handles the rest.
To view a .256 file: Drag the .256 file on the executable
Example of the automatic version:
256 colors
24-bit colors:
This shows the color vibrance value. When it's set too low, the image will not have all three main colors (R,G,B) but more tints of one/two color(s) like green in this one.
Setting it too high, will make the image compile with all colors, but not with enough tints. This causes the image to look horrific
.
I don't know how to implent Dithering, but im sure it's a handy feature for this compression. Any clues?
