RLE compression

This code has been declared by its author to be Public Domain code.

RLE compression by Zenith

2003

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..

Function RLE_compress(in_file$,out_file$)
	Local temp$
	ifile = ReadFile(in_file)
	ofile = WriteFile(out_file)
	oldbyte = -1
	While Not Eof(ifile)
	
		newbyte = ReadByte(ifile)
		
		If newbyte = oldbyte				; another byte! Lets add it to the list :)
			If rcount = 255					; we have TOO many in the list :)
				WriteByte(ofile,rcount)
				WriteByte(ofile,newbyte)
				rcount = 0
			ElseIf rcount = 0 And Len(temp)>0
				WriteByte(ofile,0)
				WriteByte(ofile,Len(temp))
				For i=1 To Len(temp)
					WriteByte(ofile,Asc(Mid(temp,i,1)))
				Next
				temp=""
				rcount = rcount + 1
			Else
				rcount = rcount + 1
			EndIf
		Else								; new byte type! Lets write off the old byte list	
			If oldbyte>-1
				If rcount>0
					WriteByte(ofile,rcount)
					WriteByte(ofile,oldbyte)
				Else
					If Len(temp)=255
						WriteByte(ofile,0)
						WriteByte(ofile,Len(temp))
						For i=1 To Len(temp)
							WriteByte(ofile,Asc(Mid(temp,i,1)))
						Next
						temp = Chr(oldbyte)
					Else
						temp = temp + Chr(oldbyte)
					EndIf
				EndIf
			EndIf
			oldbyte = newbyte
			rcount = 0
		EndIf
		
	Wend
	
	If rcount>0
		WriteByte(ofile,rcount)
		WriteByte(ofile,oldbyte)
	EndIf
	
	CloseFile(ifile)
	CloseFile(ofile)
End Function

Function RLE_uncompress(in_file$,out_file$)
	ifile = ReadFile(in_file)
	ofile = WriteFile(out_file)
	While Not Eof(ifile)
		rcount = ReadByte(ifile)
		If rcount = 0
			length = ReadByte(ifile)
			For i=1 To length
				WriteByte ofile,ReadByte(ifile)
			Next
		Else
			arg	   = ReadByte(ifile)
			For i=0 To rcount
				WriteByte ofile,arg
			Next
		EndIf
	Wend
	CloseFile(ifile)
	CloseFile(ofile)
End Function

Comments

Damien Sturdy

2004

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=0
Repeat
count=0
Repeat
obt=bt
bt=ReadByte(fs2)
count=count+1
Until (bt<>obt And obt<>-1) Or count>254 Or Eof(fs2)
WriteByte fs,count
WriteByte fs,obt
Until Eof(fs2)
CloseFile fs2
CloseFile fs
DeleteFile name$
End Function

Function simpledecompress(name$,tempname$)
fs=WriteFile(tempname$)
fs2=ReadFile(name$)
dn=0
Repeat
count=ReadByte(fs2)
Char=ReadByte(fs2)
If dn>0 Then For z=1 To count:WriteByte fs,char:Next
dn=1
Until Eof(fs2)
CloseFile fs2
CloseFile fs
End Function

Problem 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

2004

"Cygnus" the various codes are in here:

http://www.blitzbasic.com/faq/faq_entry.php?id=2

TomToad

2004

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 times
if countbyte is 128-255, then write the next countbyte-127 bytes as is.

So
1 2 3 3 3 3 3 4 3 4 5 4 4 4 4 4 4 4
would encode as
129 1 2 4 3 131 4 3 4 5 6 4

Zenith

2004

Yeah, that's what I have. :)

Nexinarus

2015

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.


;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

2015

I did some searching, .... here are some good links on variations of RLE.

http://mattmahoney.net/dc/dce.html#Section_51
http://www.fadden.com/techmisc/hdc/lesson02.htm
http://michael.dipperstein.com/rle/
http://michael.dipperstein.com/rle/#download
http://oldwww.rasip.fer.hr/research/compress/algorithms/fund/rl/

http://bit.ly/1Jw6NY4 (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?
------------------------------------------------------------------

read countbyte.
if countbyte is 0 - 127, then write next byte countbyte+1 times
if countbyte is 128-255, then write the next countbyte-127 bytes as is.

Now that is clever...

------------------------------------------------------------------
PinBoard search for compression: http://bit.ly/1Jwcc1c
Delicious search for compression: http://bit.ly/1JwaPQe

Guy Fawkes

2015

Cool!

Code Archives Forum