|
- unit utsImage;
-
- {$IFDEF FPC}
- {$mode objfpc}{$H+}
- {$ENDIF}
-
- interface
-
- uses
- Classes, SysUtils,
- utsTypes, utsUtils, utsContext;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TtsImage = class;
- TtsImageLoadFunc = procedure(const aImage: TtsImage; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer);
- TtsImageBlendFunc = function (const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f;
- TtsImage = class(TtsRefManager)
- private
- fContext: TtsContext;
-
- fWidth: Integer;
- fHeight: Integer;
- fDataSize: Integer;
- fLineSize: Integer;
- fFormat: TtsFormat;
-
- fData: Pointer;
- fHasScanlines: Boolean;
- fScanlines: array of Pointer;
-
- function GetScanline(const aIndex: Integer): Pointer;
- function GetIsEmpty: Boolean;
- procedure UpdateScanlines;
- procedure SetData(
- const aData: Pointer;
- const aFormat: TtsFormat = tsFormatEmpty;
- const aWidth: Integer = 0;
- const aHeight: Integer = 0;
- const aLineSize: Integer = 0;
- const aDataSize: Integer = 0);
- public
- property Context: TtsContext read fContext;
- property IsEmpty: Boolean read GetIsEmpty;
- property Width: Integer read fWidth;
- property Height: Integer read fHeight;
- property LineSize: Integer read fLineSize;
- property DataSize: Integer read fDataSize;
- property Format: TtsFormat read fFormat;
- property Data: Pointer read fData;
- property Scanline[const aIndex: Integer]: Pointer read GetScanline;
-
- function GetPixelAt(const x, y: Integer; out aColor: TtsColor4f): Boolean;
-
- procedure Assign(const aImage: TtsImage);
- procedure CreateEmpty(const aFormat: TtsFormat; const aWidth, aHeight: Integer);
- procedure LoadFromFunc(const aFunc: TtsImageLoadFunc; const aArgs: Pointer);
-
- procedure Resize(const aNewWidth, aNewHeight, X, Y: Integer);
- procedure FindMinMax(out aRect: TtsRect);
-
- procedure FillColor(const aColor: TtsColor4f; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes);
- procedure FillPattern(const aPattern: TtsImage; X, Y: Integer; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes);
- procedure Blend(const aImage: TtsImage; const X, Y: Integer; const aFunc: TtsBlendColorFunc);
- procedure Blend(const aImage: TtsImage; const X, Y: Integer; const aFunc: TtsImageBlendFunc; const aArgs: Pointer);
- procedure Blur(const aHorzKernel, aVertKernel: TtsKernel1D; const aChannelMask: TtsColorChannels);
-
- constructor Create(const aContext: TtsContext);
- destructor Destroy; override;
- end;
-
- implementation
-
- uses
- Math,
- utsConstants;
-
- type
- PBlendProxyArgs = ^TBlendProxyArgs;
- TBlendProxyArgs = packed record
- callback: TtsBlendColorFunc;
- end;
-
- function tsImageBlendCallbackProxy(const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f;
- var
- p: PBlendProxyArgs;
- begin
- p := PBlendProxyArgs(aArgs);
- result := p^.callback(aSrc, aDst);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TtsImage//////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TtsImage.GetScanline(const aIndex: Integer): Pointer;
- begin
- if not fHasScanlines then
- UpdateScanlines;
-
- if fHasScanlines and (aIndex >= 0) and (aIndex <= High(fScanlines)) then
- result := fScanlines[aIndex]
- else
- result := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TtsImage.GetIsEmpty: Boolean;
- begin
- result := not Assigned(fData);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.UpdateScanlines;
- var
- i: Integer;
- tmp: PByte;
- begin
- SetLength(fScanlines, fHeight);
- for i := 0 to fHeight-1 do begin
- tmp := fData;
- inc(tmp, i * fLineSize);
- fScanlines[i] := tmp;
- end;
- fHasScanlines := true;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.SetData(const aData: Pointer; const aFormat: TtsFormat;
- const aWidth: Integer; const aHeight: Integer;
- const aLineSize: Integer; const aDataSize: Integer);
- begin
- fHasScanlines := false;
- if Assigned(fData) then
- FreeMemory(fData);
-
- fData := aData;
- if Assigned(fData) then begin
- fWidth := aWidth;
- fHeight := aHeight;
- fFormat := aFormat;
- fLineSize := aLineSize;
- fDataSize := aDataSize;
- end else begin
- fWidth := 0;
- fHeight := 0;
- fLineSize := 0;
- fDataSize := 0;
- fFormat := tsFormatEmpty;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TtsImage.GetPixelAt(const x, y: Integer; out aColor: TtsColor4f): Boolean;
- var
- p: PByte;
- begin
- result := (x >= 0) and (x < Width) and (y >= 0) and (y < Height);
- if result then begin
- p := Scanline[y];
- inc(p, x * tsFormatSize(Format));
- tsFormatUnmap(Format, p, aColor);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.Assign(const aImage: TtsImage);
- var
- ImgData: Pointer;
- begin
- GetMem(ImgData, aImage.DataSize);
- if Assigned(ImgData) then
- Move(aImage.Data^, ImgData^, aImage.DataSize);
- SetData(ImgData, aImage.Format, aImage.Width, aImage.Height, aImage.LineSize, aImage.DataSize);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.CreateEmpty(const aFormat: TtsFormat; const aWidth, aHeight: Integer);
- var
- ImgData: PByte;
- lSize, dSize: Integer;
- begin
- lSize := aWidth * tsFormatSize(aFormat);
- lSize := lSize + ((4 - (lSize mod 4)) mod 4);
- dSize := aHeight * lSize;
- ImgData := AllocMem(dSize);
- FillChar(ImgData^, dSize, #0);
- SetData(ImgData, aFormat, aWidth, aHeight, lSize, dSize);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.LoadFromFunc(const aFunc: TtsImageLoadFunc; const aArgs: Pointer);
- var
- X, Y: Integer;
- c: TtsColor4f;
- p, tmp: PByte;
- begin
- for Y := 0 to Height - 1 do begin
- p := ScanLine[Y];
- for X := 0 to Width - 1 do begin
- tmp := p;
- tsFormatUnmap(fFormat, tmp, c);
- aFunc(Self, X, Y, c, aArgs);
- tsFormatMap(fFormat, p, c);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.Resize(const aNewWidth, aNewHeight, X, Y: Integer);
- var
- ImgData: PByte;
- pSize, lSize, dSize: Integer;
-
- src, dst: PByte;
- YStart, YEnd, YPos, XStart, XEnd: Integer;
- begin
- if (aNewHeight = 0) or (aNewWidth = 0) then begin
- SetData(nil);
- exit;
- end;
-
- pSize := tsFormatSize(Format);
- lSize := pSize * aNewWidth;
- lSize := lSize + ((4 - (lSize mod 4)) mod 4);
- dSize := lSize * aNewHeight;
-
- GetMem(ImgData, dSize);
- try
- FillChar(ImgData^, dSize, 0);
-
- // positions
- YStart := Max(0, Y);
- YEnd := Min(aNewHeight, Y + Height);
- XStart := Max(0, X);
- XEnd := Min(aNewWidth, X + Width);
-
- // copy data
- for YPos := YStart to YEnd -1 do begin
- dst := ImgData;
- Inc(dst, lSize * YPos + pSize * XStart);
-
- src := fData;
- Inc(src, fLineSize * (YPos - Y) + pSize * (XStart - X));
-
- Move(src^, dst^, (XEnd - XStart) * pSize);
- end;
-
- // assign
- SetData(ImgData, Format, aNewWidth, aNewHeight, lSize, dSize);
- except
- FreeMem(ImgData);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.FindMinMax(out aRect: TtsRect);
- var
- X, Y: Integer;
- c: TtsColor4f;
- p: PByte;
- begin
- aRect.Top := -1;
- aRect.Left := -1;
- aRect.Right := -1;
- aRect.Bottom := -1;
-
- // Search for MinMax
- for Y := 0 to Height-1 do begin
- p := ScanLine[Y];
- for X := 0 to Width-1 do begin
- tsFormatUnmap(Format, p, c);
- if c.a > 0 then begin
- if (X < aRect.Left) or (aRect.Left = -1) then
- aRect.Left := X;
-
- if (X+1 > aRect.Right) or (aRect.Right = -1) then
- aRect.Right := X+1;
-
- if (Y < aRect.Top) or (aRect.Top = -1) then
- aRect.Top := Y;
-
- if (Y+1 > aRect.Bottom) or (aRect.Bottom = -1) then
- aRect.Bottom := Y+1;
- end;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.FillColor(const aColor: TtsColor4f; const aChannelMask: TtsColorChannels;
- const aModes: TtsImageModes);
- var
- x, y: Integer;
- rp, wp: PByte;
- c: TtsColor4f;
- ch: TtsColorChannel;
- i: Integer;
- begin
- for y := 0 to Height-1 do begin
- rp := Scanline[y];
- wp := rp;
- for x := 0 to Width-1 do begin
- tsFormatUnmap(Format, rp, c);
- for i := 0 to 3 do begin
- ch := TtsColorChannel(i);
- if (ch in aChannelMask) then
- c.arr[i] := TS_IMAGE_MODE_FUNCTIONS[aModes[ch]](aColor.arr[i], c.arr[i]);
- end;
- tsFormatMap(Format, wp, c);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.FillPattern(const aPattern: TtsImage; X, Y: Integer;
- const aChannelMask: TtsColorChannels; const aModes: TtsImageModes);
- var
- _x, _y, posX, i: Integer;
- src, dst, tmp: PByte;
- cSrc, cDst: TtsColor4f;
- ch: TtsColorChannel;
- begin
- if x < 0 then
- x := Random(aPattern.Width);
- if y < 0 then
- y := Random(aPattern.Height);
-
- for _y := 0 to Height-1 do begin
- src := aPattern.Scanline[(y + _y) mod aPattern.Height];
- dst := Scanline[_y];
-
- inc(src, x);
- posX := x;
-
- for _x := 0 to Width-1 do begin
- if (posX >= aPattern.Width) then begin
- src := aPattern.Scanline[(y + _y) mod aPattern.Height];
- posX := 0;
- end;
-
- tmp := dst;
- tsFormatUnmap(aPattern.Format, src, cSrc);
- tsFormatUnmap(Format, tmp, cDst);
- for i := 0 to 3 do begin
- ch := TtsColorChannel(i);
- if (ch in aChannelMask) then
- cDst.arr[i] := TS_IMAGE_MODE_FUNCTIONS[aModes[ch]](cSrc.arr[i], cDst.arr[i]);
- end;
- tsFormatMap(Format, dst, cDst);
- inc(posX);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.Blend(const aImage: TtsImage; const X, Y: Integer; const aFunc: TtsBlendColorFunc);
- var
- args: TBlendProxyArgs;
- begin
- args.callback := aFunc;
- Blend(aImage, X, Y, @tsImageBlendCallbackProxy, @args);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.Blend(const aImage: TtsImage; const X, Y: Integer; const aFunc: TtsImageBlendFunc; const aArgs: Pointer);
- var
- _x, _y, x1, x2, y1, y2: Integer;
- src, dst, tmp: PByte;
- srcColor, dstColor: TtsColor4f;
- srcPixelSize, dstPixelSize: Integer;
- begin
- x1 := Max(X, 0);
- x2 := Min(X + aImage.Width , Width);
- y1 := Max(Y, 0);
- y2 := Min(Y + aImage.Height, Height);
- srcPixelSize := tsFormatSize(aImage.Format);
- dstPixelSize := tsFormatSize(Format);
- for _y := y1 to y2-1 do begin
- src := aImage.Scanline[_y - min(y1, y)];
- dst := Scanline[_y];
- inc(src, (x1 - x) * srcPixelSize);
- inc(dst, x1 * dstPixelSize);
- tmp := dst;
- for _x := x1 to x2-1 do begin
- tsFormatUnmap(aImage.Format, src, srcColor);
- tsFormatUnmap( Format, dst, dstColor);
- tsFormatMap(aImage.Format, tmp, aFunc(srcColor, dstColor, aArgs));
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsImage.Blur(const aHorzKernel, aVertKernel: TtsKernel1D; const aChannelMask: TtsColorChannels);
- var
- tmpImage: TtsImage;
-
- procedure DoBlur(const aSrc, aDst: TtsImage; const aKernel: TtsKernel1D; const ShiftX, ShiftY: Integer);
- var
- x, y, i, j: Integer;
- src, dst: PByte;
- v: Single;
- c, tmp: TtsColor4f;
- begin
- for y := 0 to Height-1 do begin
- src := aSrc.Scanline[y];
- dst := aDst.Scanline[y];
- for x := 0 to Width-1 do begin
-
- // read color and clear channels
- v := 0;
- tsFormatUnmap(aSrc.Format, src, c);
- for i := 0 to 3 do
- if (TtsColorChannel(i) in aChannelMask) then
- c.arr[i] := 0;
-
- // do blur
- for i := 0 to aKernel.ItemCount-1 do with aKernel.Items[i] do begin
- if aSrc.GetPixelAt(x + Offset * ShiftX, y + Offset * ShiftY, tmp) then begin
- for j := 0 to 3 do begin
- if (TtsColorChannel(j) in aChannelMask) then
- c.arr[j] := c.arr[j] + tmp.arr[j] * Value;
- end;
- v := v + Value;
- end;
- end;
-
- // calc final color and write
- for i := 0 to 3 do
- if (TtsColorChannel(i) in aChannelMask) then
- c.arr[i] := c.arr[i] / v;
- tsFormatMap(aDst.Format, dst, c);
- end;
- end;
- end;
-
- begin
- tmpImage := TtsImage.Create(fContext);
- try
- tmpImage.CreateEmpty(Format, Width, Height);
- tmpImage.FillColor(tsColor4f(1, 1, 1, 0), TS_COLOR_CHANNELS_RGBA, TS_IMAGE_MODES_REPLACE_ALL);
-
- DoBlur(self, tmpImage, aHorzKernel, 1, 0);
- DoBlur(tmpImage, self, aVertKernel, 0, 1);
- finally
- FreeAndNil(tmpImage);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TtsImage.Create(const aContext: TtsContext);
- begin
- inherited Create(aContext);
- fContext := aContext;
- SetData(nil);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TtsImage.Destroy;
- begin
- SetData(nil);
- inherited Destroy;
- end;
-
-
- end.
|