[bb] RLE compression by Zenith [ 1+ years ago ]

[BlitzBot]

Title : RLE compression
Author : Zenith
Posted : 1+ years ago

Description : Wow, am I the first to put RLE compression on here?
Pretty simple to use, 2 small functions.

This kind of compression is really good for cleaning up files that repeat the same character over and over again alot.

Using it for my hardware projects..

Code :

Code: BlitzBasic

1. Function RLE_compress(in_file$,out_file$)
2.         Local temp$
3.         ifile = ReadFile(in_file)
4.         ofile = WriteFile(out_file)
5.         oldbyte = -1
6.         While Not Eof(ifile)
7.        
8.                 newbyte = ReadByte(ifile)
9.                
10.                 If newbyte = oldbyte                            ; another byte! Lets add it to the list :)
11.                         If rcount = 255                                 ; we have TOO many in the list :)
12.                                 WriteByte(ofile,rcount)
13.                                 WriteByte(ofile,newbyte)
14.                                 rcount = 0
15.                         ElseIf rcount = 0 And Len(temp)>0
16.                                 WriteByte(ofile,0)
17.                                 WriteByte(ofile,Len(temp))
18.                                 For i=1 To Len(temp)
19.                                         WriteByte(ofile,Asc(Mid(temp,i,1)))
20.                                 Next
21.                                 temp=""
22.                                 rcount = rcount + 1
23.                         Else
24.                                 rcount = rcount + 1
25.                         EndIf
26.                 Else                                                            ; new byte type! Lets write off the old byte list      
27.                         If oldbyte>-1
28.                                 If rcount>0
29.                                         WriteByte(ofile,rcount)
30.                                         WriteByte(ofile,oldbyte)
31.                                 Else
32.                                         If Len(temp)=255
33.                                                 WriteByte(ofile,0)
34.                                                 WriteByte(ofile,Len(temp))
35.                                                 For i=1 To Len(temp)
36.                                                         WriteByte(ofile,Asc(Mid(temp,i,1)))
37.                                                 Next
38.                                                 temp = Chr(oldbyte)
39.                                         Else
40.                                                 temp = temp + Chr(oldbyte)
41.                                         EndIf
42.                                 EndIf
43.                         EndIf
44.                         oldbyte = newbyte
45.                         rcount = 0
46.                 EndIf
47.                
48.         Wend
49.        
50.         If rcount>0
51.                 WriteByte(ofile,rcount)
52.                 WriteByte(ofile,oldbyte)
53.         EndIf
54.        
55.         CloseFile(ifile)
56.         CloseFile(ofile)
57. End Function
58.  
59. Function RLE_uncompress(in_file$,out_file$)
60.         ifile = ReadFile(in_file)
61.         ofile = WriteFile(out_file)
62.         While Not Eof(ifile)
63.                 rcount = ReadByte(ifile)
64.                 If rcount = 0
65.                         length = ReadByte(ifile)
66.                         For i=1 To length
67.                                 WriteByte ofile,ReadByte(ifile)
68.                         Next
69.                 Else
70.                         arg        = ReadByte(ifile)
71.                         For i=0 To rcount
72.                                 WriteByte ofile,arg
73.                         Next
74.                 EndIf
75.         Wend
76.         CloseFile(ifile)
77.         CloseFile(ofile)
78. End Function

Comments :


Damien Sturdy(Posted 1+ years ago)

 excelent. Il be number two, Im no expert in file compression but i was chuffed to see this work quite nicely!:Function simplecompress(name$,outputname$)fs=WriteFile(outputname$)fs2=ReadFile(name$)bt=0Repeatcount=0Repeatobt=btbt=ReadByte(fs2)count=count+1Until (bt<>obt And obt<>-1) Or count>254 Or Eof(fs2)WriteByte fs,countWriteByte fs,obtUntil Eof(fs2)CloseFile fs2CloseFile fsDeleteFile name$End FunctionFunction simpledecompress(name$,tempname$)fs=WriteFile(tempname$)fs2=ReadFile(name$)dn=0Repeatcount=ReadByte(fs2)Char=ReadByte(fs2)If dn>0 Then For z=1 To count:WriteByte fs,char:Nextdn=1Until Eof(fs2)CloseFile fs2CloseFile fsEnd FunctionProblem being with mine, a file with every char different ends up twice the size.... ..and....Anyone tell me how to put that into a code box???


puki(Posted 1+ years ago)

 "Cygnus" the various codes are in here:<a href="../faq/faq_entry0b30.html?id=2" target="_blank">http://www.blitzbasic.com/faq/faq_entry.php?id=2[/url]


TomToad(Posted 1+ years ago)

 RLE is best used with images that have huge blocks of the same color, such as cartoon characters or illustrations.  Terrible for photographs or highly detailed images.  If your interested in learning more about compression, a google search brings up a lot of relavent info.  Try looking at huffman compression or LZH compression, among others.  If there's a specific reason why you want to use RLE, a modification will help to improve it.  Not only have repeat next byte n times, but also write next n bytes as is.  The format would look something like this:read countbyte.if countbyte is 0 - 127, then write next byte countbyte+1 timesif countbyte is 128-255, then write the next countbyte-127 bytes as is.So1 2 3 3 3 3 3 4 3 4 5 4 4 4 4 4 4 4would encode as129 1 2 4 3 131 4 3 4 5 6 4


Zenith(Posted 1+ years ago)

 Yeah, that's what I have.


Nexinarus(Posted 1+ years ago)

 I think this is really Cool.I did something like this for images with Palettes of course.  I tried doing stuff with 24-bit.... Didn't quite work out well.To the point.  I tried it again ... 24-bit image but instead of every color attribute 0-255 i did multiples of 8 for the rgb values. It reduced the quality but it still looked ok to me.

Code: [Select]


;This is my version of RLE for 24-bit colors (converted to 15-bit colors)
;In some cases, and depending on the lack of color repetition... the image
;may not be compressed. But it will be smaller in one way. In a 24-bit BMP,
;3 bytes is 1 pixel... in this, 2 bytes are 1 pixel)

;Note: Depending the Size of the Image, The saving can easily take a bit of time.

inputfile$="Your BMP File"
outputfile$="Your RLE ImageFile"

Dim imagesize(1)
Graphics 800,600,16,2
Dim loadarray(GraphicsWidth(),GraphicsHeight())

Global image=LoadImage(inputfile$)
SetBuffer FrontBuffer()
DrawBlock IMAGE,0,0
AppTitle "Press Any Key to Continue..."
FlushKeys
WaitKey
Cls

Save_True2(outputfile$);save
Load_True2(outputfile$);load

;remove image from memory
If image>0 FreeImage image
image=0

SetBuffer FrontBuffer()
maxx=imagesize(0);imagewidth
maxy=imagesize(1);imageheight
If maxx>GraphicsWidth() maxx=GraphicsWidth()
If maxy>GraphicsHeight() maxy=GraphicsHeight()
AppTitle "Displaying..."
For imgy=0 To maxy
For imgx=0 To maxx
Color16_clr(loadARRAY(IMGX,IMGY))
Plot imgx,imgy
Next
Next
imgx=0
imgy=0
AppTitle "Press any key to exit."
FlushKeys
WaitKey

End


Function Save_TRUE2(Savefilename$);RLE COMPRESSION 2BYTES/COLOR 2BYTES/COUNTER HORIZONTAL
SetBuffer ImageBuffer(image)
file=WriteFile(Savefilename$)
COUNT=0;KEEP TRACK OF HOW TIMES A COLOR IS USED IN A ROW.
TOTALCOUNT=0;TOTAL BYTES PROCESSED ALREADY (IN THIS CASE (1-32768)
CURRENTCOLOR=0;CURRENT COLOR BEING PROCESSED
TEMPWIDTH=ImageWidth(IMAGE);get image width
TEMPHEIGHT=ImageHeight(IMAGE);get image height
WRITE2BYTES(FILE,TEMPWIDTH);save image width
WRITE2BYTES(FILE,TEMPHEIGHT);save image height
AppTitle "Saving..."
For VERTICAL=0 To TEMPHEIGHT-1
For HORIZONTAL=0 To tempwidth-1
;get color from every pixel and convert it to a single integer (not single byte... integer)
GetColor horizontal,vertical
TempRed=ColorRed()
TempGreen=ColorGreen()
TempBlue=ColorBlue()
TempColor=Color2Clr16(TempRed,TempGreen,TempBlue)
If count>0;continue with manipulating image.
If currentcolor=TempColor;if the currentcolor = the newly loaded temporary color increase the count.
count=count+1
ElseIf currentcolor<>TempColor;if they do not match
If(count/32770)>0;if the count exceeds the maximum hold...
;32770.  0-32767=colors 32768-65535 counters
;if you have 1 color (save color)
;if you have 2 colors that equal (save color,color) no sense doing a counting integer. it is still 2 integers.
;if you have 3+colors that equal (save count,color)
;therefore 32768=3-----65536=32770
For RepeatedCounting=1 To (count/32770)
write2bytes(file,65535);put biggest integer into file (32770+32765=65535) got rid of the math. Did not need it here.
write2bytes(file,currentcolor);put current color into file
TotalCount=TotalCount+32770;increase the total count by MaximumHold
Next
End If
If count Mod 32770>0;if the counter is more than 0 but less than the maximum hold...
If count Mod 32770>2;if the count is 3 or more...
write2bytes(file,((count Mod 32770)+32765));include the count+(LastColor-2) where LastColor=32767
TotalCount=TotalCount+(count Mod 32770);increase the total count
ElseIf count Mod 32770=2;if the count is 2...
write2bytes(file,currentcolor);put color into file
TotalCount=TotalCount+2;increase total count by 2
ElseIf count Mod 32770=1;if the count is 1...
TotalCount=TotalCount+1;increase total count by 1
End If
write2bytes(file,currentcolor);put color into file (this works for all previous options.
End If
currentcolor=TempColor
count=1
End If
If vertical=tempheight-1;if you are at the bottom
If horizontal=tempwidth-1;if you are at the right
If totalcount<>Int(tempwidth*tempheight);if your total count does not match the imagesize
;include remaining data to the file
If(count/32770)>0
For RepeatedCounting=1 To (count/32770)
write2bytes(file,65535)
write2bytes(file,currentcolor)
TotalCount=TotalCount+32770
Next
End If
If count Mod 32770>0
If count Mod 32770>2
write2bytes(file,((count Mod 32770)+32765))
TotalCount=TotalCount+(count Mod 32770)
ElseIf count Mod 32770=2
write2bytes(file,currentcolor)
TotalCount=TotalCount+2
ElseIf count Mod 32770=1
TotalCount=TotalCount+1
End If
write2bytes(file,currentcolor)
End If
End If
End If
End If
ElseIf count=0;beginning of image
currentcolor=TempColor
count=1
End If
Next
Next
;close file
CloseFile(file)
DebugLog(totalcount)+" :Pixel Total";24-BIT BMPS 3 BYTES=1 PIXEL, HENSE TOTALCOUNT*3
DebugLog(tempwidth*tempheight*3)+" :BMP TrueColor ImageSize";24-BIT BMPS 3 BYTES=1 PIXEL, HENSE TOTALCOUNT*3
;variable cleanup
FILE=0
Savefilename$=""
TOTALCOUNT=0
CURRENTCOLOR=0
COUNT=0
VERTICAL=0
HORIZONTAL=0
REPEATEDCOUNTING=0
TempRed=0
TempGreen=0
TempBlue=0
TempColor=0
tempwidth=0
tempheight=0
SetBuffer BackBuffer()
End Function

Function Load_TRUE2(LOADfilename$);RLE COMPRESSION 2BYTES/COLOR 2BYTES/COUNTER HORIZONTAL
;set start and finish integers to 0
start=0
finish=0
COUNT=1;initialize color counter
DebugLog FileSize(loadfilename$)+" :"+loadfilename$
DebugLog String$(" ",Len(FileSize(loadfilename$))+6)+" FileSize"
file=ReadFile(LOADfilename$);open file
tempwidth=read2bytes(file);read width
tempheight=read2bytes(file);read height
imagesize(0)=tempwidth
imagesize(1)=tempheight
AppTitle "Loading..."
Repeat
;load integer (0-255)
MYNUMBER=READ2bytes(file)
If MYNUMBER>32767;maxmum color 32767
COUNT=MYNUMBER-32765;get count number
;...otherwise calculate the x,y postions and paste the pixels.
ElseIf MYNUMBER<32768;maxmum color 32767
START=FINISH;set new starting point to previous finish
FINISH=FINISH+COUNT;increase finish by adding the new count of color
TEMPC=MYNUMBER;set color with new integer.
For PIXELING=START To FINISH-1;paste new color from start to finish
;calculate x,y coordinates.
TEMPX=PIXELING Mod tempwidth
TEMPY=PIXELING/tempwidth
;set coordinates in an array.
If((TEMPX/GraphicsWidth())+(TEMPY/GraphicsHeight()))=0 loadarray(tempx,tempy)=tempc
Next
PIXELING=0
COUNT=1
End If
;when you have reached the maximum image size, leave this loop.
Until FINISH=Int(tempwidth*tempheight)
;close the file
CloseFile(file)
;variable cleanup
file=0
START=0
FINISH=0
COUNT=0
MYNUMBER=0
TEMPC=0
TEMPX=0
TEMPY=0
PIXELING=0
LOADFILENAME$=""
tempwidth=0
tempheight=0
End Function

Function read2bytes(prompthandle)
;read 2 bytes instead of 1.
For PromptReadPal=0 To 1
promptint=ReadByte(prompthandle)
If PromptReadPal=0 PromptResult=promptint Shl 8
If PromptReadPal=1 PromptResult=promptresult+promptint
promptint=0
Next
PromptReadPal=0
Promptint=0
If PromptResult<0 PromptResult=0
If PromptResult>65535 PromptResult=65535
Return PromptResult
End Function

Function write2bytes(prompthandle,promptint)
;write 2 bytes instead of 1.
If promptint<0 promptint=0
If promptint>65535 promptint=65535
WriteByte(prompthandle,(promptint Shr 8)Mod 256)
WriteByte(prompthandle,promptint Mod 256)
promptint=0
End Function

Function Color16_Clr(OctInteger)
;show the color to be displayed. Let the function do all the work.
If OctInteger<0 OctInteger=0
If OctInteger>32767 OctInteger=32767
Color ((OctInteger Shr 10)Mod 32)*8,((OctInteger Shr 5)Mod 32)*8,(OctInteger Mod 32)*8
OctInteger=0
End Function

Function Color2Clr16(CORed,COGreen,COBlue)
;RED MANIPULATION
CoRed=((CoRed Mod 256)+256)Mod 256;keep red within 0 and 255
OCRED=CORED/8
If ocred<1 ocred=0
If OcRed>30 OcRed=31
;GREEN MANIPULATION
CoGreen=((CoGreen Mod 256)+256)Mod 256;keep green within 0 and 255
OCGREEN=COGREEN/8
If ocGREEN<1 ocGREEN=0
If OcGreen>30 OcGreen=31
;BLUE MANIPULATION
CoBlue=((CoBlue Mod 256)+256)Mod 256;keep blue within 0 and 255
OCBLUE=COBLUE/8
If ocBLUE<1 ocBLUE=0
If OcBlue>30 OcBlue=31
;convert rgb color to a useful single integer between 0-32767
If OcRed+OcGreen+OcBlue=0 OcPromptResult=0 Else OcPromptResult=Int(Int(OcRed Shl 10)+Int(OcGreen Shl 5)+OcBlue);give the appropriate final result depending on the transparent color and the normal colors.
CoRed=0:OcRed=0:CoGreen=0:OcGreen=0:CoBlue=0:OcBlue=0;cleanup
Return OcPromptResult;return result to the main program
End Function






this should work.  All you have to do is state your inputfilename and your outputfilename


virtlands(Posted 1+ years ago)

 I did some searching, ....  here are some good links on variations of RLE.<font class="tiny"><a href="http://mattmahoney.net/dc/dce.html#Section_51" target="_blank">http://mattmahoney.net/dc/dce.html#Section_51[/url]<a href="http://www.fadden.com/techmisc/hdc/lesson02.htm" target="_blank">http://www.fadden.com/techmisc/hdc/lesson02.htm[/url]<a href="http://michael.dipperstein.com/rle/" target="_blank">http://michael.dipperstein.com/rle/[/url]<a href="http://michael.dipperstein.com/rle/#download" target="_blank">http://michael.dipperstein.com/rle/#download[/url]<a href="http://oldwww.rasip.fer.hr/research/compress/algorithms/fund/rl/" target="_blank">http://oldwww.rasip.fer.hr/research/compress/algorithms/fund/rl/[/url]<a href="http://bit.ly/1Jw6NY4" target="_blank">http://bit.ly/1Jw6NY4[/url] </font> (Rosetta Code)------------------------------------------------------------------One interesting complication is that 'Escape' bytes (or signals) may be embedded inside an RLE sequence.--Then what if the actual 'escape' character occurs (rarely) as part of the source?  ------------------------------------------------------------------<div class="quote"> read countbyte.if countbyte is 0 - 127, then write next byte countbyte+1 timesif countbyte is 128-255, then write the next countbyte-127 bytes as is. </div>Now that is clever...------------------------------------------------------------------PinBoard search for compression: <font class="tiny"> <a href="http://bit.ly/1Jwcc1c" target="_blank">http://bit.ly/1Jwcc1c[/url] </font>Delicious search for compression: <font class="tiny"> <a href="http://bit.ly/1JwaPQe" target="_blank">http://bit.ly/1JwaPQe[/url] </font>


Guy Fawkes(Posted 1+ years ago)

 Cool! [/i]