Skip to content

Commit ac5172b

Browse files
ollydevollydev
committed
Improve TSimbaImage.SaveToString using LZMA
1 parent 04eee29 commit ac5172b

2 files changed

Lines changed: 193 additions & 51 deletions

File tree

‎Source/simba.encoding.pas‎

Lines changed: 32 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,13 @@ interface
1919
EBaseEncoding = (b64URL, b64, b32, b32Hex, b16);
2020
{$POP}
2121

22-
function BaseEncode(Encoding: EBaseEncoding; const Data: String): String;
23-
function BaseDecode(Encoding: EBaseEncoding; const Data: String): String;
22+
function BaseEncode(Encoding: EBaseEncoding; const Data: String): String; overload;
23+
function BaseEncode(Encoding: EBaseEncoding; Stream: TStream): String; overload;
24+
function BaseDecode(Encoding: EBaseEncoding; const Data: String): String; overload;
25+
procedure BaseDecode(Encoding: EBaseEncoding; const Data: String; Stream: TStream); overload;
2426

25-
function BaseEncodeBytes(Encoding: EBaseEncoding; Bytes: TBytes): String;
26-
function BaseDecodeBytes(Encoding: EBaseEncoding; const Data: String): TBytes;
27+
function BaseEncodeBytes(Encoding: EBaseEncoding; Bytes: TByteArray): String;
28+
function BaseDecodeBytes(Encoding: EBaseEncoding; const Data: String): TByteArray;
2729

2830
function HOTPCalculateToken(const aSecret: String; const Counter: Integer): Integer;
2931
function TOTPCalculateToken(const aSecret: String): Integer;
@@ -49,7 +51,7 @@ function BaseEncode(Encoding: EBaseEncoding; const Data: String): String;
4951
Result := '';
5052
end;
5153

52-
function BaseEncodeBytes(Encoding: EBaseEncoding; Bytes: TBytes): String;
54+
function BaseEncodeBytes(Encoding: EBaseEncoding; Bytes: TByteArray): String;
5355
begin
5456
if (Length(Bytes) > 0) then
5557
begin
@@ -66,7 +68,7 @@ function BaseEncodeBytes(Encoding: EBaseEncoding; Bytes: TBytes): String;
6668

6769
function BaseDecode(Encoding: EBaseEncoding; const Data: String): String;
6870
var
69-
Bytes: TBytes;
71+
Bytes: TByteArray;
7072
begin
7173
if (Length(Data) > 0) then
7274
begin
@@ -83,7 +85,7 @@ function BaseDecode(Encoding: EBaseEncoding; const Data: String): String;
8385
Result := '';
8486
end;
8587

86-
function BaseDecodeBytes(Encoding: EBaseEncoding; const Data: String): TBytes;
88+
function BaseDecodeBytes(Encoding: EBaseEncoding; const Data: String): TByteArray;
8789
begin
8890
if (Length(Data) > 0) then
8991
begin
@@ -98,6 +100,28 @@ function BaseDecodeBytes(Encoding: EBaseEncoding; const Data: String): TBytes;
98100
Result := [];
99101
end;
100102

103+
// Encodes from the stream's current position to the end.
104+
function BaseEncode(Encoding: EBaseEncoding; Stream: TStream): String;
105+
var
106+
Bytes: TByteArray;
107+
begin
108+
SetLength(Bytes, Stream.Size - Stream.Position);
109+
if (Length(Bytes) > 0) then
110+
Stream.ReadBuffer(Bytes[0], Length(Bytes));
111+
112+
Result := BaseEncodeBytes(Encoding, Bytes);
113+
end;
114+
115+
// Decodes and writes the bytes at the stream's current position.
116+
procedure BaseDecode(Encoding: EBaseEncoding; const Data: String; Stream: TStream);
117+
var
118+
Bytes: TByteArray;
119+
begin
120+
Bytes := BaseDecodeBytes(Encoding, Data);
121+
if (Length(Bytes) > 0) then
122+
Stream.WriteBuffer(Bytes[0], Length(Bytes));
123+
end;
124+
101125
// https://gitlab.com/freepascal.org/fpc/source/-/blob/main/packages/fcl-hash/src/onetimepass.pp
102126
function HOTPCalculateToken(const aSecret: String; const Counter: Integer): Integer;
103127
const
@@ -120,7 +144,7 @@ function HOTPCalculateToken(const aSecret: String; const Counter: Integer): Inte
120144
Key: UInt32;
121145
Offset: Longint;
122146
Part1, Part2, Part3, Part4: UInt32;
123-
SecretBinBuf: TBytes;
147+
SecretBinBuf: TByteArray;
124148
STime, SSecretBin: RawbyteString;
125149
Time: Longint;
126150
begin

‎Source/simba.image_stringconv.pas‎

Lines changed: 161 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -3,88 +3,206 @@
33
Project: Simba (https://github.com/MerlijnWajer/Simba)
44
License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
55
--------------------------------------------------------------------------
6+
Save/Load images from/to a base64 string.
67
7-
Save/Load bitmaps from/to a base64 string.
8-
9-
Strings are generated as PNG with a small header.
8+
A string is "IMG:" + base64(header + name + LZMA-compressed BGRA pixels).
9+
Version 1 stored a PNG which is still supported for reading
1010
}
1111
unit simba.image_stringconv;
1212

13-
{$i simba.inc}
13+
{$I simba.inc}
1414

1515
interface
1616

1717
uses
1818
Classes, SysUtils,
19-
simba.base, simba.image;
19+
simba.base,
20+
simba.image;
21+
22+
procedure SimbaImage_FromString(Image: TSimbaImage; Str: String);
23+
function SimbaImage_ToString(Image: TSimbaImage): String;
24+
25+
implementation
26+
27+
uses
28+
FPReadPNG,
29+
simba.encoding,
30+
simba.compress,
31+
simba.image_lazbridge,
32+
simba.vartype_string;
2033

2134
const
2235
HeaderPrefix = 'IMG:';
2336

37+
VERSION_PNG = 1; // legacy: header with fixed name String[128] then PNG data
38+
VERSION_LZMA = 2; // header + LZMA(interleaved BGRA)
39+
VERSION_LZMA_SPLIT = 3; // header + LZMA(channel-split BGRA)
40+
2441
type
25-
TImageStringHeader = packed record
26-
Version: Integer;
27-
Width, Height: Integer;
42+
THeaderLegacy = packed record
43+
Version: Int32;
44+
Width, Height: Int32;
2845
Name: String[128];
2946
end;
3047

31-
procedure SimbaImage_FromString(Image: TSimbaImage; Str: String);
32-
function SimbaImage_ToString(Image: TSimbaImage): String;
48+
THeader = packed record
49+
Version: Int32;
50+
Width, Height: Int32;
51+
NameLen: Int32; // length of the name that follows the header
52+
end;
3353

34-
implementation
54+
function ReadName(Stream: TStream; Len: SizeInt): String;
55+
begin
56+
Result := '';
57+
if (Len > 0) and (Stream.Position + Len <= Stream.Size) then
58+
begin
59+
SetLength(Result, Len);
60+
Stream.ReadBuffer(Result[1], Len);
61+
end;
62+
end;
3563

36-
uses
37-
FPReadPNG, FPWritePNG,
38-
simba.encoding, simba.image_lazbridge, simba.vartype_string;
64+
function SplitBGRA(Src: PByte; PixelCount: SizeInt): TByteArray;
65+
var
66+
I: SizeInt;
67+
ptrB, ptrG, ptrR, ptrA: PByte;
68+
begin
69+
SetLength(Result, PixelCount * 4);
70+
71+
ptrB := Pointer(Result);
72+
ptrG := ptrB + PixelCount;
73+
ptrR := ptrG + PixelCount;
74+
ptrA := ptrR + PixelCount;
75+
76+
for I := 1 to PixelCount do
77+
begin
78+
ptrB^ := Src[0];
79+
ptrG^ := Src[1];
80+
ptrR^ := Src[2];
81+
ptrA^ := Src[3];
82+
83+
Inc(ptrB);
84+
Inc(ptrG);
85+
Inc(ptrR);
86+
Inc(ptrA);
87+
Inc(Src, 4);
88+
end;
89+
end;
90+
91+
procedure UnsplitBGRA(Src, Dst: PByte; PixelCount: SizeInt);
92+
var
93+
I: SizeInt;
94+
ptrB, ptrG, ptrR, ptrA: PByte;
95+
begin
96+
ptrB := Src;
97+
ptrG := ptrB + PixelCount;
98+
ptrR := ptrG + PixelCount;
99+
ptrA := ptrR + PixelCount;
100+
101+
for I := 1 to PixelCount do
102+
begin
103+
Dst[0] := ptrB^;
104+
Dst[1] := ptrG^;
105+
Dst[2] := ptrR^;
106+
Dst[3] := ptrA^;
107+
108+
Inc(ptrB);
109+
Inc(ptrG);
110+
Inc(ptrR);
111+
Inc(ptrA);
112+
Inc(Dst, 4);
113+
end;
114+
end;
39115

40116
procedure SimbaImage_FromString(Image: TSimbaImage; Str: String);
41117
var
42-
Stream: TStringStream;
43-
Header: TImageStringHeader;
118+
Stream: TBytesStream;
119+
DecompressedData: TByteArray;
120+
Header: THeader;
121+
HeaderLegacy: THeaderLegacy;
44122
begin
45123
if not Str.StartsWith(HeaderPrefix, True) then
46-
SimbaException('TImage.FromString: Invalid string, should begin with "IMG:"');
124+
SimbaException('TImage.FromString: Invalid string. Must start with "IMG:"');
47125
Str.DeleteRange(1, Length(HeaderPrefix));
48126

49-
Stream := nil;
127+
Stream := TBytesStream.Create();
50128
try
51-
Stream := TStringStream.Create(BaseDecode(EBaseEncoding.b64, Str));
52-
Stream.Read(Header, SizeOf(TImageStringHeader));
53-
54-
Image.Name := Header.Name;
55-
56-
SimbaImage_FromFPImageReader(Image, TFPReaderPNG, Stream);
129+
BaseDecode(EBaseEncoding.b64, Str, Stream);
130+
if (Stream.Size < SizeOf(THeader)) then
131+
SimbaException('TImage.FromString: Invalid string. Too small');
132+
133+
Stream.Position := 0;
134+
Stream.Read(Header, SizeOf(THeader));
135+
136+
case Header.Version of
137+
VERSION_LZMA,
138+
VERSION_LZMA_SPLIT:
139+
begin
140+
Image.Name := ReadName(Stream, Header.NameLen);
141+
Image.SetSize(Header.Width, Header.Height);
142+
143+
DecompressedData := DecompressStream(ESimbaCompressAlgo.LZMA, Stream);
144+
if (Header.Version = VERSION_LZMA_SPLIT) then
145+
UnsplitBGRA(@DecompressedData[0], PByte(Image.Data), Header.Width * Header.Height)
146+
else
147+
Move(DecompressedData[0], Image.Data^, (Header.Width * Header.Height) * SizeOf(TColorBGRA));
148+
end;
149+
150+
VERSION_PNG:
151+
begin
152+
Stream.Position := 0;
153+
Stream.Read(HeaderLegacy, SizeOf(THeaderLegacy));
154+
Image.Name := HeaderLegacy.Name;
155+
SimbaImage_FromFPImageReader(Image, TFPReaderPNG, Stream);
156+
end;
157+
else
158+
SimbaException('TImage.FromString: Unsupported version (%d)', [Header.Version]);
159+
end;
57160
finally
58161
Stream.Free();
59162
end;
60163
end;
61164

62165
function SimbaImage_ToString(Image: TSimbaImage): String;
63166
var
64-
HeaderStream, ImageStream: TStringStream;
65-
Header: TImageStringHeader;
167+
Interleaved, Split, CompressedData: TByteArray;
168+
Buffer: TBytesStream;
169+
Header: THeader;
170+
PixelCount, DataSize: SizeInt;
66171
begin
67-
HeaderStream := nil;
68-
ImageStream := nil;
69-
70-
try
71-
Header.Version := 1;
72-
Header.Width := Image.Width;
73-
Header.Height := Image.Height;
74-
Header.Name := Image.Name;
75-
76-
HeaderStream := TStringStream.Create();
77-
HeaderStream.Write(Header, SizeOf(TImageStringHeader));
78-
ImageStream := TStringStream.Create();
172+
PixelCount := Image.Width * Image.Height;
173+
DataSize := PixelCount * SizeOf(TColorBGRA);
174+
175+
// pick the smaller output, and store in version field
176+
Interleaved := CompressData(ESimbaCompressAlgo.LZMA, PByte(Image.Data), DataSize);
177+
Split := CompressBytes(ESimbaCompressAlgo.LZMA, SplitBGRA(PByte(Image.Data), PixelCount));
178+
179+
if (Length(Split) < Length(Interleaved)) then
180+
begin
181+
Header.Version := VERSION_LZMA_SPLIT;
182+
CompressedData := Split;
183+
end else
184+
begin
185+
Header.Version := VERSION_LZMA;
186+
CompressedData := Interleaved;
187+
end;
79188

80-
SimbaImage_ToFPImageWriter(Image, TFPWriterPNG, ImageStream);
189+
Header.Width := Image.Width;
190+
Header.Height := Image.Height;
191+
Header.NameLen := Length(Image.Name);
81192

82-
Result := HeaderPrefix + BaseEncode(EBaseEncoding.b64, HeaderStream.DataString + ImageStream.DataString);
193+
Buffer := TBytesStream.Create();
194+
try
195+
Buffer.Write(Header, SizeOf(Header));
196+
if (Length(Image.Name) > 0) then
197+
Buffer.Write(Image.Name[1], Length(Image.Name));
198+
if (Length(CompressedData) > 0) then
199+
Buffer.Write(CompressedData[0], Length(CompressedData));
200+
201+
Buffer.Position := 0;
202+
Result := HeaderPrefix + BaseEncode(EBaseEncoding.b64, Buffer);
83203
finally
84-
HeaderStream.Free();
85-
ImageStream.Free();
204+
Buffer.Free();
86205
end;
87206
end;
88207

89208
end.
90-

0 commit comments

Comments
 (0)