[SOLVED] RLE help

[Espectr0]

Hola,

In my project I need to load/save a compressed image using RLE.

Code: Pascal  [Select][+][-]

1. // The Run-length encoding method is defined in the US 7912305 B1 patent.
2. // Here’s a quick and dirty definition to this method:
3. //
4. // Code                                   Meaning
5. // CCCCCCCC                               One pixel in color C
6. // 00000000 00LLLLLL                      L pixels in color 0 (L between 1 and 63)
7. // 00000000 01LLLLLL LLLLLLLL             L pixels in color 0 (L between 64 and 16383)
8. // 00000000 10LLLLLL CCCCCCCC             L pixels in color C (L between 3 and 63)
9. // 00000000 11LLLLLL LLLLLLLL CCCCCCCC    L pixels in color C (L between 64 and 16383)
10. // 00000000 00000000                      End of line
11.  

To Encode:

Code: Pascal  [Select][+][-]

1. function EncodeImage(const AImage: TBGRABitmap; out ABuffer: TBytes; out APalette: TFPPalette): Integer;
2. var
3.   bmp : TBGRABitmap;
4.   quant : TBGRAColorQuantizer;
5.   x, y, i, len : Integer;
6.   p, r : PBGRAPixel;
7.   bytes : TBytesStream;
8.   clr : Integer;
9. begin
10.   // Reduce image
11.   bmp := TBGRABitmap.Create(AImage);
12.   quant := TBGRAColorQuantizer.Create(bmp, acFullChannelInPalette, 256); // reduce colors
13.   try
14.     quant.ApplyDitheringInplace(daNearestNeighbor, bmp);
15.     bmp.UsePalette := True;
16.     APalette := TFPPalette.Create(quant.ReducedPalette.Count);
17.     bmp.Palette.Count := APalette.Count;
18.     for i := 0 to quant.ReducedPalette.Count-1 do // copy reduced colors to palette
19.     begin
20.       bmp.Palette[i] := (quant.ReducedPalette.Color[i].ToFPColor);
21.       APalette.Color[i] := bmp.Palette[i];
22.     end;
23.  
24.     // RLE compress image
25.     bytes := TBytesStream.Create;
26.     try
27.       for y := 0 to bmp.Height-1 do
28.       begin
29.         p := bmp.Scanline[y];
30.         x := 0;
31.         while x < bmp.Width do
32.         begin
33.           i := quant.ReducedPalette.IndexOfColor(p[x]);
34.           if i >= 0 then
35.             clr := i
36.           else
37.             clr := quant.ReducedPalette.FindNearestColorIndex(p[x]);
38.  
39.           r := bmp.Scanline[y];
40.           len := 1;
41.           while (x + len < bmp.Width) and (len < $3FFF) do
42.           begin
43.             if r[x + len] <> p[x] then Break;
44.             Inc(len);
45.           end;
46.  
47.           if (len <= 2) and (clr <> 0) then // One pixel in color C
48.           begin
49.             bytes.WriteByte(clr);
50.             if len = 2 then bytes.WriteByte(clr);
51.           end
52.           else
53.           begin
54.             // rle id
55.             bytes.WriteByte(0);
56.  
57.             if (clr = 0) and (len < $40) then // L pixels in color 0 (L between 1 and 63)
58.               bytes.WriteByte(len)
59.             else if (clr = 0) then  // L pixels in color 0 (L between 64 and 16383)
60.             begin
61.               bytes.WriteByte($40 or (len shr 8));
62.               bytes.WriteByte(len);
63.             end
64.             else if len < $40 then // L pixels in color C (L between 3 and 63)
65.             begin
66.               bytes.WriteByte($80 or len);
67.               bytes.WriteByte(clr);
68.             end
69.             else // L pixels in color C (L between 64 and 16383)
70.             begin
71.               bytes.WriteByte($C0 or (len shr 8));
72.               bytes.WriteByte(len);
73.               bytes.WriteByte(clr);
74.             end;
75.           end;
76.           Inc(x, len);
77.         end;
78.         // end rle id
79.         bytes.WriteByte(0);
80.         bytes.WriteByte(0);
81.       end;
82.     finally
83.       Result := bytes.Size;
84.       SetLength(ABuffer, Result);
85.       Move(bytes.Bytes[0], ABuffer[0], Result);
86.       bytes.Free;
87.     end;
88.   finally
89.     quant.Free;
90.     bmp.Free;
91.   end;
92. end;
93.  

To Decode:

Code: Pascal  [Select][+][-]

1. function DecodeImage(const ABuffer: TBytes; const APalette: TFPPalette; const AWidth, AHeight: Integer): TBGRABitmap;
2. var
3.   bmp : TBGRABitmap;
4.   x, y, idx, i : Integer;
5.   b, len : Byte;
6.   clr : TBGRAPixel;
7. begin
8.   bmp := TBGRABitmap.Create(AWidth, AHeight);
9.   idx := 0;
10.   for y := 0 to bmp.Height-1 do
11.   begin
12.     x := 0;
13.     while x < bmp.Width do
14.     begin
15.       b := ABuffer[idx] and $FF;
16.       Inc(idx);
17.  
18.       if (b = 0) and (idx < Length(ABuffer)) then // rle id
19.       begin
20.         b := ABuffer[idx] and $FF;
21.         Inc(idx);
22.  
23.         if b = 0 then // next line
24.         begin
25.           Inc(idx);
26.           Break;
27.         end
28.         else if (b and $C0) = $40 then // L pixels in color 0 (L between 1 and 63)
29.         begin
30.           if (idx < Length(ABuffer)) then
31.           begin
32.             len := ((b - $40) shl 8) or (ABuffer[idx] and $FF);
33.             Inc(idx);
34.             clr := FPColorToBGRA(APalette.Color[0]);
35.             for i := 1 to len do
36.             begin
37.               bmp.Scanline[y][x] := clr;
38.               Inc(x);
39.             end;
40.           end;
41.         end
42.         else if (b and $C0) = $80 then // L pixels in color C (L between 64 and 16383)
43.         begin
44.           if (idx < Length(ABuffer)) then
45.           begin
46.             len := (b - $80);
47.             b := ABuffer[idx] and $FF;
48.             Inc(idx);
49.             clr := FPColorToBGRA(APalette.Color[b]);
50.             for i := 1 to len do
51.             begin
52.               bmp.Scanline[y][x] := clr;
53.               Inc(x);
54.             end;
55.           end;
56.         end
57.         else if (b and $C0) <> 0 then // L pixels in color C (L between 3 and 63)
58.         begin
59.           if (idx < Length(ABuffer)) then
60.           begin
61.             len := ((b - $C0) shl 8) or (ABuffer[idx] and $FF);
62.             Inc(idx);
63.             b := ABuffer[idx] and $FF;
64.             Inc(idx);
65.             clr := FPColorToBGRA(APalette.Color[b]);
66.             for i := 1 to len do
67.             begin
68.               bmp.Scanline[y][x] := clr;
69.               Inc(x);
70.             end;
71.           end;
72.         end
73.         else // L pixels in color 0 (L between 64 and 16383)
74.         begin
75.           clr := FPColorToBGRA(APalette.Color[0]);
76.           for i := 1 to b do
77.           begin
78.             bmp.Scanline[y][x] := clr;
79.             Inc(x);
80.           end;
81.         end;
82.       end
83.       else // One pixel in color C
84.       begin
85.         bmp.Scanline[y][x] := FPColorToBGRA(APalette.Color[b]);
86.         Inc(x);
87.       end;
88.     end;
89.   end;
90.  
91.   Result := bmp;
92. end;
93.  

But I have problems loading the compressed image, I am attaching the original and the restored one.
Can you guide me what is the fault?

Gracias!!

[speter]

I have a program which reads Utah RLE images.

I am attaching a Zipped RLE image (the forum doesn't allow .RLE files) and a PNG version.

Is this the same format as you are using?

cheers
S.

[Leledumbo]

Since you're too lazy to write a MRE, I'll be too lazy to properly test, too.

From what I can read, since the decoded image looks similar, it's not the (de)compression problem (if it's wrong, it would be garbage instead of looking similar). You intentionally reduce the colors by using a TBGRAColorQuantizer.

You have two ways to verify:

• Instead of using your decoder, use an existing image viewer capable of reading RLE compressed bitmaps
• Remove the quantization part and solely compress the image

[circular]

I don't see any obvious problem with the code.

The output seems to have only 2 colors. I suggest to write the details to the console when a non black pixel is written, to see where this may happen.

[Espectr0]

I made some changes and uploaded a demo to decode the image, one of the problems I have is the transparency of the image, the black background should be transparent.
Any help is welcome


https://github.com/URUWorks/UW_BlurayPGSParser

[TRon]

I made some changes and uploaded a demo to decode the image, one of the problems I have is the transparency of the image, the black background should be transparent.

Assuming that the original image you posted (original.bmp) is the result of your decoding then there does not seem to be an issue (see attached picture).

In case there is an issue then your issue does not seem related to the RLE decoding rather how the pixels are currently set in BRGABitmap and/or how you have setup your image.

The picture shows a image placed on a panel (which background was set to white) that gets loaded (original.bmp) when pressing the button (using the same bitmap assignment as your code).

BTW: it is nice you have setup a demo project but... I do not have any blurays anymore (let alone a reader) so can't test. Do you happen to have a (portion) of a sup file that you can share for testing purpose (perhaps a single decoded image will do as well, if only for comparison to the original bmp in case that bmp was not a result of your decoding) ?

[Thaddy]

I once wrote an RLE implementation in TurboBASIC/PowerBASIC.
If I can find it, it is probably easy to translate to Pascal.

[Espectr0]

The "original.bmp" file was generated with BGRABitmap, I encoded that file with RLE and then decoded it into the "restored.bmp" file but it doesn't look exactly the same, could it be my mistake with the palette?

About the demo project, in the same folder is the "test.sup" (big) and/or "test1ds.sup" (small) file to test it.
I couldn't leave the background transparent when decoding :S

PS: I attached the png of the "test1ds.sup" resulting from other software, so the encoding is fine?

[TRon]

The "original.bmp" file was generated with BGRABitmap, I encoded that file with RLE and then decoded it into the "restored.bmp" file but it doesn't look exactly the same, could it be my mistake with the palette?

I have to admit that i do not know how BGRABitmap and palettes work icw transparency. I would have to figure that out (so will take me some time).

About the demo project, in the same folder is the "test.sup" (big) and/or "test1ds.sup" (small) file to test it.

Thank you for that as that allows me to tinker with your code.

PS: I attached the png of the "test1ds.sup" resulting from other software, so the encoding is fine?

Yes, the encoding seems more than adequate. It is the 'drawing' that does not seem to go as planned/intended. Though having said that, I am not familiar with PGR so perhaps there is more to it than you already did with your code. My first thought is that it is (still) the 'drawing' that goes wrong.

[circular]

Most image readers don't support an alpha channel for BMP files. If you want to keep the transparency, better to use a format that has solid alpha support.

[TRon]

Most image readers don't support an alpha channel for BMP files. If you want to keep the transparency, better to use a format that has solid alpha support.

Yes, thank you for the reminder as I am/was aware.

The situation is:
- palette colors and image data is stored raw in a stream
- palette colors are stored in YCbCr format
- (indexed) pixel data is stored as RLE encoded

The process that TS follows is:
- read palette colors, convert from YCbCr to FPColor and store into an array (using custom function YCbCr2FPColor)
- 'retrieve' image from raw (RLE encoded) data-stream but in that process the color array gets converted into a TFPPalette first
- then read raw RLE encoded data into a temp buffer
- RLE decode temp buffer, using the palette and use decoded bytes as index to the palette.
- in that process the color of the pixel (TBGRAPixel) is retrieved (using the colorindex to the the palette's index) with TBGRAPixel's function FromFPColor
- that 'color' is then used to set the corresponding pixel to that color.

That all seems to work as intended.

However, the code now uses the following assignment:

Code: Pascal  [Select][+][-]

1.   { dummy for better understanding } bmp := retrieveBGRABitmapFromRawData
2.   image1.Picture.Assign(bmp.Bitmap);
3.  

Where image1 is a TImage component placed on the form and bmp is a TBGRABitmap. The TImage picture stays (visible) empty.

When I replace that with:

Code: Pascal  [Select][+][-]

1.   { dummy for better understanding } bmp := retrieveBGRABitmapFromRawData
2.   bmp.draw (Image1.canvas,0,0, true);
3.  

The picture becomes visible in the TImage component.

afaik that would indicate that something did go wrong with the alpha channel but I haven't been able to figure out yet what exactly.

PS: attached is a BGRABitmap saved as BMP that the (original) code produces.

[circular]

Ah, the last parameter of Draw here is True, specifying opaque drawing.

[TRon]

Thank you @circular.

I finally managed to locate the culprit...

@Espectr0:
At least you got an error inside this:

Code: Pascal  [Select][+][-]

1. function YCbCr2FPColor(Y, Cb, Cr, A: Byte): TFPColor;
2. begin
3.   Result := TColorToFPColor(YCbCr2RGB(Y, Cb, Cr));
4.   Result.Alpha := A;
5. end;
6.  

Do you note that the alpha of the TFPColor result is set to the alpha value that was passed to the function ?

The original value is a 8 bit ranged value while TPFColor makes use of 16-bit ranged values so your code would have to compensate for that.

When corrected:

Code: Pascal  [Select][+][-]

1. function YCbCr2FPColor(Y, Cb, Cr, A: Byte): TFPColor;
2. begin
3.   Result := TColorToFPColor(YCbCr2RGB(Y, Cb, Cr));
4.   Result.Alpha := A * $101;  // <-- scale up the byte value to 16-bit word value.
5. end;
6.  

Then the image displays correctly (e.g. at least better, as it looks like there is still something wrong with semi-transparent pixels but have no idea how/why/what) .

PS: The attached picture has a white background because I changed the panel's color to clWhite (I forgot to change that before taking a picture).

[Espectr0]

Thank you @TRon.

It works correctly now, the problem was the alpha value