diff --git a/applications/draw_test/draw_test_fast/fastbitmap.pas b/applications/draw_test/draw_test_fast/fastbitmap.pas
new file mode 100644
index 000000000..a47daf718
--- /dev/null
+++ b/applications/draw_test/draw_test_fast/fastbitmap.pas
@@ -0,0 +1,125 @@
+unit FastBitmap;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes;
+
+type
+
+ TFastBitmapPixel = integer;
+ (*TFastBitmapPixel = record
+ Blue: Byte;
+ Green: Byte;
+ Red: Byte;
+ end;*)
+ PFastBitmapPixel = ^TFastBitmapPixel;
+
+ TFastBitmapPixelComponents = packed record
+ B, G, R, A: byte;
+ end;
+
+const
+ FastPixelSize = SizeOf(TFastBitmapPixel);
+
+type
+ { TFastBitmap }
+
+ TFastBitmap = class
+ private
+ FPixelsData: PByte;
+ FSize: TPoint;
+ function GetPixel(X, Y: integer): TFastBitmapPixel; inline;
+ procedure SetPixel(X, Y: integer; const AValue: TFastBitmapPixel); inline;
+ procedure SetSize(const AValue: TPoint);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure RandomImage;
+ property Size: TPoint read FSize write SetSize;
+ property Pixels[X, Y: integer]: TFastBitmapPixel read GetPixel write SetPixel;
+ property PixelsData: PByte read FPixelsData;
+ end;
+
+function RGBA(red, green, blue, alpha: byte): integer;
+function SwapBRComponent(Value: integer): integer; inline;
+function NoSwapBRComponent(Value: integer): integer; inline;
+
+implementation
+
+function RGBA(red, green, blue, alpha: byte): integer;
+var
+ tmp: TFastBitmapPixelComponents;
+begin
+ tmp.R := red;
+ tmp.G := green;
+ tmp.B := blue;
+ tmp.A := alpha;
+ Result := TFastBitmapPixel(tmp);
+end;
+
+function SwapBRComponent(Value: integer): integer;
+begin
+ // Result := (Value and $00ff00) or ((Value shr 16) and $ff) or ((Value and $ff) shl 16);
+ Result := Value;
+ TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).B;
+ TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).R;
+end;
+
+function NoSwapBRComponent(Value: integer): integer;
+begin
+ // Result := (Value and $00ff00) or ((Value shr 16) and $ff) or ((Value and $ff) shl 16);
+ Result := Value;
+ TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).B;
+ TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).R;
+end;
+
+{ TFastBitmap }
+
+function TFastBitmap.GetPixel(X, Y: integer): TFastBitmapPixel;
+begin
+ Result := PFastBitmapPixel(FPixelsData + (Y * FSize.X + X) * FastPixelSize)^;
+end;
+
+procedure TFastBitmap.SetPixel(X, Y: integer; const AValue: TFastBitmapPixel);
+begin
+ PFastBitmapPixel(FPixelsData + (Y * FSize.X + X) * FastPixelSize)^ := AValue;
+end;
+
+procedure TFastBitmap.SetSize(const AValue: TPoint);
+begin
+ if (FSize.X = AValue.X) and (FSize.Y = AValue.X) then
+ Exit;
+ FSize := AValue;
+ FPixelsData := ReAllocMem(FPixelsData, FSize.X * FSize.Y * FastPixelSize);
+end;
+
+constructor TFastBitmap.Create;
+begin
+ Size := Point(0, 0);
+end;
+
+destructor TFastBitmap.Destroy;
+begin
+ FreeMem(FPixelsData);
+ inherited Destroy;
+end;
+
+procedure TFastBitmap.RandomImage;
+var
+ I, X, Y: integer;
+begin
+ for I := 0 to 2 do
+ for Y := 0 to (Size.Y div 2) - 1 do
+ for X := 0 to (Size.X div 3) - 1 do
+ Pixels[X + (I * (Size.X div 3)), Y] := 255 shl (I * 8);
+
+ for Y := (Size.Y div 2) to Size.Y - 1 do
+ for X := 0 to Size.X - 1 do
+ Pixels[X, Y] := Random(256) or (Random(256) shl 16) or (Random(256) shl 8);
+end;
+
+
+end.
diff --git a/applications/draw_test/draw_test_fast/filecache.pas b/applications/draw_test/draw_test_fast/filecache.pas
new file mode 100644
index 000000000..6b69abef1
--- /dev/null
+++ b/applications/draw_test/draw_test_fast/filecache.pas
@@ -0,0 +1,92 @@
+unit FileCache;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Graphics, FastBitmap;
+
+type
+ TFileCacheItem = record
+ start: longint;
+ length: longint;
+ number: integer;
+ end;
+
+ { TFileCache }
+
+ TFileCache = class
+ private
+ cache_stream: TFileStream;
+ FCount: integer;
+ FCacheList: array of TFileCacheItem;
+ public
+ constructor Create(AFileName: string);
+ destructor Destroy; override;
+
+ property Count: integer read FCount;
+ function GetData(Number: integer; var Bitmap: TFastBitmap): boolean;
+ procedure Add(Number: integer; Bitmap: TFastBitmap);
+ procedure Clear;
+ end;
+
+implementation
+
+{ TFileCache }
+
+constructor TFileCache.Create(AFileName: string);
+begin
+ FCount := 0;
+ cache_stream := TFileStream.Create(AFileName, fmCreate);
+end;
+
+destructor TFileCache.Destroy;
+begin
+ Clear;
+ cache_stream.Free;
+
+ inherited Destroy;
+end;
+
+function TFileCache.GetData(Number: integer; var Bitmap: TFastBitmap): boolean;
+var
+ i: integer;
+begin
+ Result := False;
+ for i := 0 to FCount - 1 do
+ if FCacheList[i].number = Number then
+ begin
+ cache_stream.Position := FCacheList[i].start;
+ cache_stream.Read(Bitmap.PixelsData^, FCacheList[i].length);
+ Result := True;
+ exit;
+ end;
+end;
+
+procedure TFileCache.Add(Number: integer; Bitmap: TFastBitmap);
+begin
+ if Bitmap = nil then
+ exit;
+
+ Inc(FCount);
+ SetLength(FCacheList, FCount);
+
+ FCacheList[FCount - 1].number := Number;
+
+ //move to the end of the stream
+ cache_stream.Position := cache_stream.Size;
+
+ FCacheList[FCount - 1].start := cache_stream.Position;
+ cache_stream.Write(Bitmap.PixelsData^, Bitmap.Size.x * Bitmap.Size.y * 4);
+ FCacheList[FCount - 1].length := cache_stream.Position - FCacheList[FCount - 1].start;
+end;
+
+procedure TFileCache.Clear;
+begin
+ FCount := 0;
+ SetLength(FCacheList, FCount);
+end;
+
+end.
+
diff --git a/applications/draw_test/draw_test_fast/project1.lpi b/applications/draw_test/draw_test_fast/project1.lpi
new file mode 100644
index 000000000..4c7e1bb17
--- /dev/null
+++ b/applications/draw_test/draw_test_fast/project1.lpi
@@ -0,0 +1,102 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/applications/draw_test/draw_test_fast/project1.lpr b/applications/draw_test/draw_test_fast/project1.lpr
new file mode 100644
index 000000000..bf96d7a4e
--- /dev/null
+++ b/applications/draw_test/draw_test_fast/project1.lpr
@@ -0,0 +1,21 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, { this includes the LCL widgetset}
+ Forms, Unit1, FileCache, FastBitmap
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/applications/draw_test/draw_test_fast/project1.lps b/applications/draw_test/draw_test_fast/project1.lps
new file mode 100644
index 000000000..f1be94847
--- /dev/null
+++ b/applications/draw_test/draw_test_fast/project1.lps
@@ -0,0 +1,209 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/applications/draw_test/draw_test_fast/project1.res b/applications/draw_test/draw_test_fast/project1.res
new file mode 100644
index 000000000..e66ecf85f
Binary files /dev/null and b/applications/draw_test/draw_test_fast/project1.res differ
diff --git a/applications/draw_test/draw_test_fast/unit1.lfm b/applications/draw_test/draw_test_fast/unit1.lfm
new file mode 100644
index 000000000..dfe5dfa5d
--- /dev/null
+++ b/applications/draw_test/draw_test_fast/unit1.lfm
@@ -0,0 +1,89 @@
+object Form1: TForm1
+ Left = 342
+ Height = 555
+ Top = 135
+ Width = 569
+ Caption = 'Form1'
+ ClientHeight = 535
+ ClientWidth = 569
+ Menu = MainMenu1
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ LCLVersion = '0.9.31'
+ object PageControl1: TPageControl
+ Left = 0
+ Height = 535
+ Top = 0
+ Width = 362
+ ActivePage = ImageTabSheet
+ Align = alClient
+ TabIndex = 0
+ TabOrder = 0
+ object ImageTabSheet: TTabSheet
+ Caption = 'TImage'
+ ClientHeight = 509
+ ClientWidth = 354
+ object Image1: TImage
+ Left = 0
+ Height = 509
+ Top = 0
+ Width = 354
+ Align = alClient
+ end
+ end
+ end
+ object ListView1: TListView
+ Left = 367
+ Height = 535
+ Top = 0
+ Width = 202
+ Align = alRight
+ Columns = <
+ item
+ Caption = 'Method'
+ Width = 100
+ end
+ item
+ Caption = 'FPS'
+ Width = 100
+ end>
+ TabOrder = 1
+ ViewStyle = vsReport
+ end
+ object Splitter1: TSplitter
+ Left = 362
+ Height = 535
+ Top = 0
+ Width = 5
+ Align = alRight
+ ResizeAnchor = akRight
+ end
+ object MainMenu1: TMainMenu
+ left = 447
+ top = 88
+ object MenuItem1: TMenuItem
+ Caption = 'Cache'
+ object MenuItem9: TMenuItem
+ Caption = 'Use cache'
+ object mnuHD50: TMenuItem
+ Caption = '50% HD (940x540)'
+ Checked = True
+ RadioItem = True
+ OnClick = mnuHD50Click
+ end
+ object mnuHD: TMenuItem
+ Caption = 'HD (1920x1050)'
+ RadioItem = True
+ OnClick = mnuHDClick
+ end
+ end
+ end
+ object MenuItem2: TMenuItem
+ Caption = 'Run tests'
+ object mnuTImage: TMenuItem
+ Caption = 'TImage'
+ OnClick = mnuTImageClick
+ end
+ end
+ end
+end
diff --git a/applications/draw_test/draw_test_fast/unit1.pas b/applications/draw_test/draw_test_fast/unit1.pas
new file mode 100644
index 000000000..95f63723d
--- /dev/null
+++ b/applications/draw_test/draw_test_fast/unit1.pas
@@ -0,0 +1,168 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
+ ExtCtrls, ComCtrls, Menus, FileCache, FastBitmap;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ ListView1: TListView;
+ MainMenu1: TMainMenu;
+ MenuItem1: TMenuItem;
+ mnuHD50: TMenuItem;
+ mnuHD: TMenuItem;
+ MenuItem2: TMenuItem;
+ mnuTImage: TMenuItem;
+ MenuItem9: TMenuItem;
+ PageControl1: TPageControl;
+ Splitter1: TSplitter;
+ ImageTabSheet: TTabSheet;
+ Image1: TImage;
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure MenuItem5Click(Sender: TObject);
+ procedure mnuHD50Click(Sender: TObject);
+ procedure mnuHDClick(Sender: TObject);
+ procedure mnuTImageClick(Sender: TObject);
+ private
+ { private declarations }
+ FileCache50: TFileCache;
+
+ procedure AddTestToListBox(AName: string; FPS: double);
+ public
+ { public declarations }
+ end;
+
+var
+ Form1: TForm1;
+ png: TPortableNetworkGraphic;
+ bmp: TFastBitmap;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ GraphType;
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+var
+ i: integer;
+ RawImage: TRawImage;
+ RowPtr: PInteger;
+ BytePerRow: PtrUInt;
+begin
+ FileCache50 := TFileCache.Create('./images50.cache');
+
+ png := TPortableNetworkGraphic.Create;
+
+ bmp := TFastBitmap.Create;
+ bmp.Size := Point(1920, 1080);
+
+ //load all images to the caches
+ for i := 1 to 23 do
+ begin
+ png.LoadFromFile(Format('../images/%.4d.png', [i]));
+ RawImage := png.RawImage;
+ RowPtr := PInteger(RawImage.Data);
+ BytePerRow := RawImage.Description.BytesPerLine;
+ Move(RowPtr^, bmp.PixelsData^, bmp.Size.Y * BytePerRow);
+ FileCache50.Add(i, bmp);
+ end;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+ FileCache50.Free;
+
+ png.Free;
+ bmp.Free;
+end;
+
+procedure TForm1.MenuItem5Click(Sender: TObject);
+begin
+ mnuTImageClick(nil);
+end;
+
+procedure TForm1.mnuHD50Click(Sender: TObject);
+begin
+ mnuHD50.Checked := True;
+end;
+
+procedure TForm1.mnuHDClick(Sender: TObject);
+begin
+ mnuHD.Checked := True;
+end;
+
+procedure TForm1.mnuTImageClick(Sender: TObject);
+var
+ RowPtr: PInteger;
+ RawImage: TRawImage;
+ BytePerRow: integer;
+ s: TDateTime;
+ i: integer;
+ j: integer;
+begin
+ PageControl1.ActivePage := ImageTabSheet;
+
+ s := Now;
+ for j := 1 to 10 do
+ for i := 1 to 23 do
+ begin
+ if FileCache50.GetData(i, bmp) then
+ begin
+ with bmp do
+ try
+ Image1.Picture.Bitmap.Width := 1920;
+ Image1.Picture.Bitmap.Height := 1080;
+ Image1.Picture.Bitmap.PixelFormat := pf32bit;
+ Image1.Picture.Bitmap.BeginUpdate(False);
+ RawImage := Image1.Picture.Bitmap.RawImage;
+ RowPtr := PInteger(RawImage.Data);
+ BytePerRow := RawImage.Description.BytesPerLine;
+ Move(bmp.PixelsData^, RowPtr^, Size.Y * BytePerRow);
+ finally
+ Image1.Picture.Bitmap.EndUpdate(False);
+ end;
+ //Image1.Picture.Bitmap.LoadFromRawImage(png.RawImage, False);
+ Application.ProcessMessages;
+ end;
+ end;
+
+ AddTestToListBox('TImage', 230 / ((Now - s) * 24 * 3600));
+end;
+
+procedure TForm1.AddTestToListBox(AName: string; FPS: double);
+var
+ i: integer;
+ found: boolean = False;
+begin
+ //first check if test is already added earlier
+ for i := 0 to ListView1.Items.Count - 1 do
+ begin
+ if ListView1.Items[i].Caption = AName then
+ begin
+ found := True;
+ ListView1.Items[i].SubItems.Clear;
+ ListView1.Items[i].SubItems.Add(FloatToStr(FPS));
+ end;
+ end;
+
+ if not found then
+ with ListView1.Items.Add do
+ begin
+ Caption := AName;
+ SubItems.Add(FloatToStr(FPS));
+ end;
+end;
+
+end.
diff --git a/applications/draw_test/filecache.pas b/applications/draw_test/filecache.pas
index 1e3f5ee5c..0e0b8f0b2 100644
--- a/applications/draw_test/filecache.pas
+++ b/applications/draw_test/filecache.pas
@@ -53,11 +53,14 @@ function TFileCache.GetData(Number: integer; var Bitmap: TPortableNetworkGraphic
var
i: integer;
begin
+ Result := False;
for i := 0 to FCount - 1 do
if FCacheList[i].number = Number then
begin
cache_stream.Position := FCacheList[i].start;
Bitmap.LoadFromStream(cache_stream, FCacheList[i].length);
+ Result := True;
+ exit;
end;
end;
diff --git a/applications/draw_test/untitled.blend b/applications/draw_test/untitled.blend
new file mode 100644
index 000000000..c763475b7
Binary files /dev/null and b/applications/draw_test/untitled.blend differ