RLE Compression

Blitz3D Forums/Blitz3D Userlibs/RLE Compression

Nexinarus

(Posted 2015) [#1]

here is my attempt at RLE Compression for 24-Bit BMPs.

It converts the RGB Values to a single integer.
First each value R,G, & B get converted to Multiples of 8 (0,8,16,24,etc...) then combined into an integer 0-32767
(this reduces the quality i know. But i still think it looks good.

Integers 32768-65535 are the counters.

Note:32768=3 65535=32770
The reason is that when saving only 2 identical colors side by side it is still 2 integers.

And in some cases, the file will not be compressed depending on the order of the colors.

I know it is 2 bytes per integer. But when comparing the final result to the 24-bit BMP Image, its 2 bytes per pixel instead of 3.

I dunno if this is useful at all. Probably not. I just wanted to see if i could do it.

it is on the following link in the code archeives. It is with this particular code arc thread because it is yet another RLE Compression.

http://www.blitzbasic.com/codearcs/codearcs.php?code=556

;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

just input your inputfilename$ and outputfilename$.

-------------------------

Sorry that this is in the Userlibs section. I thought I clicked the programming section. I did not realize that i was In the Userlib thread until I posted this. Sorry about that. If the Admin can remove this thread. Please do so. I am going to put it in the programming section where i meant to put it all along.