|
- unit ultsImage;
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils,
- utsTextSuite,
- ultsTypes;
-
- type
- TltsImageLoadFunc = procedure(aHandle: TltsImageHandle; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer); stdcall;
- TltsImageBlendFunc = procedure(aHandle: TltsImageHandle; aSrc, aDst: TtsColor4f; out aResult: TtsColor4f; aArgs: Pointer); stdcall;
-
- function ltsImageCreate (aContext: TltsContextHandle): TltsImageHandle; stdcall;
- function ltsImageIsEmpty (aHandle: TltsImageHandle; out aValue: Boolean): TltsErrorCode; stdcall;
- function ltsImageGetWidth (aHandle: TltsImageHandle): Integer; stdcall;
- function ltsImageGetHeight (aHandle: TltsImageHandle): Integer; stdcall;
- function ltsImageGetLineSize (aHandle: TltsImageHandle): Integer; stdcall;
- function ltsImageGetDataSize (aHandle: TltsImageHandle): Integer; stdcall;
- function ltsImageGetFormat (aHandle: TltsImageHandle; out aValue: TtsFormat): TltsErrorCode; stdcall;
- function ltsImageGetData (aHandle: TltsImageHandle): Pointer; stdcall;
- function ltsImageGetScanline (aHandle: TltsImageHandle; aIndex: Integer): Pointer; stdcall;
- function ltsImageGetPixelAt (aHandle: TltsImageHandle; aX, aY: Integer; out aColor: TtsColor4f): TltsErrorCode; stdcall;
- function ltsImageAssign (aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall;
- function ltsImageCreateEmpty (aHandle: TltsImageHandle; aFormat: TtsFormat; aWidth, aHeight: Integer): TltsErrorCode; stdcall;
- function ltsImageLoadFromFunc (aHandle: TltsImageHandle; aCallback: TltsImageLoadFunc; aArgs: Pointer): TltsErrorCode; stdcall;
- function ltsImageResize (aHandle: TltsImageHandle; aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall;
- function ltsImageFillColor (aHandle: TltsImageHandle; aColor: TtsColor4f; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
- function ltsImageFillPattern (aHandle, aPattern: TltsImageHandle; aX, aY: Integer; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
- function ltsImageBlend (aHandle, aSource: TltsImageHandle; aX, aY: Integer; aBlendFunc: TltsImageBlendFunc; aArgs: Pointer): TltsErrorCode; stdcall;
- function ltsImageBlur (aHandle: TltsImageHandle; aHorzRad, aHorzStr, aVertRad, aVertStr: Single; aMask: TtsColorChannels): TltsErrorCode; stdcall;
- function ltsImageDestroy (aHandle: TltsImageHandle): TltsErrorCode; stdcall;
-
- implementation
-
- uses
- ultsUtils, utsUtils {$IFDEF DEBUG}, uutlLogger{$ENDIF};
-
- type
- PLoadArgs = ^TLoadArgs;
- TLoadArgs = packed record
- args: Pointer;
- handle: TltsImageHandle;
- callback: TltsImageLoadFunc
- end;
-
- PBlendArgs = ^TBlendArgs;
- TBlendArgs = packed record
- args: Pointer;
- handle: TltsImageHandle;
- callback: TltsImageBlendFunc;
- end;
-
- procedure ImageLoadCallback(const aImage: TtsImage; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer);
- var
- p: PLoadArgs;
- begin
- p := PLoadArgs(aArgs);
- p^.callback(p^.handle, X, Y, aPixel, p^.args);
- end;
-
- function ImageBlendCallback(const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f;
- var
- p: PBlendArgs;
- begin
- p := PBlendArgs(aArgs);
- p^.callback(p^.handle, aSrc, aDst, result, p^.args);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //ltsImage//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageCreate(aContext: TltsContextHandle): TltsImageHandle; stdcall;
- var
- img: TtsImage;
- c: TtsContext;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreate(Context=%p)', [Pointer(aContext)]);{$ENDIF}
- result := nil;
- if not CheckContextHandle(aContext, c) then
- exit;
- img := TtsImage.Create(c);
- AddReference(ltsObjTypeImage, img);
- result := img;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := nil;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreate=%p', [Pointer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageIsEmpty(aHandle: TltsImageHandle; out aValue: Boolean): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageIsEmpty(Handle=%p; Value=%p)', [Pointer(aHandle), Pointer(@aValue)]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img)
- then aValue := img.IsEmpty
- else result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageIsEmpty=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetWidth(aHandle: TltsImageHandle): Integer; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetWidth(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
- if CheckImageHandle(aHandle, img)
- then result := img.Width
- else result := -1;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := -1;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetWidth=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetHeight(aHandle: TltsImageHandle): Integer; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetHeight(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
- if CheckImageHandle(aHandle, img)
- then result := img.Height
- else result := -1;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := -1;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetHeight=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetLineSize(aHandle: TltsImageHandle): Integer; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetLineSize(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
- if CheckImageHandle(aHandle, img)
- then result := img.LineSize
- else result := -1;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := -1;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetLineSize=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetDataSize(aHandle: TltsImageHandle): Integer; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetDataSize(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
- if CheckImageHandle(aHandle, img)
- then result := img.DataSize
- else result := -1;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := -1;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetDataSize=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetFormat(aHandle: TltsImageHandle; out aValue: TtsFormat): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetFormat(Handle=%p; Value=%p)', [Pointer(aHandle), Pointer(@aValue)]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img)
- then aValue := img.Format
- else result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetFormat=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetData(aHandle: TltsImageHandle): Pointer; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetData(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
- if CheckImageHandle(aHandle, img)
- then result := img.Data
- else result := nil;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := nil;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetData=%p', [Pointer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetScanline(aHandle: TltsImageHandle; aIndex: Integer): Pointer; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetScanline(Handle=%p; Index=%d)', [Pointer(aHandle), aIndex]);{$ENDIF}
- if CheckImageHandle(aHandle, img) then begin
- result := img.Scanline[aIndex];
- if not Assigned(result) then
- SetLastError(ltsErrInvalidValue, Format('index (%d) is out of range', [aIndex]));
- end else
- result := nil;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := nil;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetScanline=%p', [Pointer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageGetPixelAt(aHandle: TltsImageHandle; aX, aY: Integer; out aColor: TtsColor4f): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetPixelAt(Handle=%p; X=%d; Y=%d; Color=%p)', [Pointer(aHandle), aX, aY, Pointer(@aColor)]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img) then begin
- if not img.GetPixelAt(aX, aY, aColor) then begin
- SetLastError(ltsErrInvalidValue, Format('x (%d) or y (%d) is out of range', [aX, aY]));
- result := LastErrorCode;
- end;
- end else
- result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageGetPixelAt=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageAssign(aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall;
- var
- img, src: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageAssign(Handle=%p; Source=%p)', [Pointer(aHandle), Pointer(aSource)]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img) and CheckImageHandle(aSource, src)
- then img.Assign(src)
- else result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageAssign=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageCreateEmpty(aHandle: TltsImageHandle; aFormat: TtsFormat; aWidth, aHeight: Integer): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreateEmpty(Handle=%p; Format=%d; Width=%d; Height=%d)', [Pointer(aHandle), Integer(aFormat), aWidth, aHeight]);{$ENDIF}
- result := ltsErrNone;
- if not ValidateFormat(aFormat) then begin
- result := LastErrorCode;
- end else if (aWidth < 0) then begin
- SetLastError(ltsErrInvalidValue, 'width must be a positive value');
- result := LastErrorCode;
- end else if (aHeight < 0) then begin
- SetLastError(ltsErrInvalidValue, 'height must be a positive value');
- result := LastErrorCode;
- end else if not CheckImageHandle(aHandle, img) then begin
- result := LastErrorCode;
- end else
- img.CreateEmpty(aFormat, aWidth, aHeight);
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageCreateEmpty=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageLoadFromFunc(aHandle: TltsImageHandle; aCallback: TltsImageLoadFunc; aArgs: Pointer): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- la: TLoadArgs;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageLoadFromFunc(Handle=%p; Callback=%p; Args=%p)', [Pointer(aHandle), Pointer(aCallback), aArgs]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img) then begin
- la.args := aArgs;
- la.callback := aCallback;
- la.handle := aHandle;
- img.LoadFromFunc(@ImageLoadCallback, @la);
- end else
- result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageLoadFromFunc=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageResize(aHandle: TltsImageHandle; aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageResize(Handle=%p; Width=%d; Height=%d; X=%d; Y=%d)', [Pointer(aHandle), aWidth, aHeight, aX, aY]);{$ENDIF}
- result := ltsErrNone;
- if (aWidth < 0) then begin
- SetLastError(ltsErrInvalidValue, 'width must be a positive value');
- result := LastErrorCode;
- end else if (aHeight < 0) then begin
- SetLastError(ltsErrInvalidValue, 'height must be a positive value');
- result := LastErrorCode;
- end else if not CheckImageHandle(aHandle, img) then begin
- result := LastErrorCode;
- end else
- img.Resize(aWidth, aHeight, aX, aY);
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageResize=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageFillColor(aHandle: TltsImageHandle; aColor: TtsColor4f; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillColor(Handle=%p; Color=(%f;%f;%f;%f); Mask=%d; Modes=(%d;%d;%d;%d))', [Pointer(aHandle), aColor.r, aColor.g, aColor.b, aColor.a, Integer(aMask), Integer(aModes[TtsColorChannel.tsChannelRed]), Integer(aModes[TtsColorChannel.tsChannelGreen]), Integer(aModes[TtsColorChannel.tsChannelBlue]), Integer(aModes[TtsColorChannel.tsChannelAlpha])]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img)
- then img.FillColor(aColor, aMask, aModes)
- else result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillColor=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageFillPattern(aHandle, aPattern: TltsImageHandle; aX, aY: Integer; aMask: TtsColorChannels; aModes: TtsImageModes): TltsErrorCode; stdcall;
- var
- img, pattern: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillPattern(Handle=%p; Pattern=%p; X=%d; Y=%d; Mask=%d; Modes=(%d;%d;%d;%d))', [Pointer(aHandle), Pointer(aPattern), aX, aY, Integer(aMask), Integer(aModes[TtsColorChannel.tsChannelRed]), Integer(aModes[TtsColorChannel.tsChannelGreen]), Integer(aModes[TtsColorChannel.tsChannelBlue]), Integer(aModes[TtsColorChannel.tsChannelAlpha])]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img) and CheckImageHandle(aPattern, pattern)
- then img.FillPattern(pattern, aX, aY, aMask, aModes)
- else result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageFillPattern=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageBlend(aHandle, aSource: TltsImageHandle; aX, aY: Integer; aBlendFunc: TltsImageBlendFunc; aArgs: Pointer): TltsErrorCode; stdcall;
- var
- img, src: TtsImage;
- ba: TBlendArgs;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlend(Handle=%p; Source=%p; X=%d; Y=%d; BlendFunc=%p; Args=%p)', [Pointer(aHandle), Pointer(aSource), aX, aY, Pointer(aBlendFunc), aArgs]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img) and CheckImageHandle(aSource, src) then begin
- ba.args := aArgs;
- ba.handle := aHandle;
- ba.callback := aBlendFunc;
- img.Blend(src, aX, aY, @ImageBlendCallback, @ba);
- end else
- result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlend=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageBlur(aHandle: TltsImageHandle; aHorzRad, aHorzStr, aVertRad, aVertStr: Single; aMask: TtsColorChannels): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- horz, vert: TtsKernel1D;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlur(Handle=%p; HorzRad=%f; HorzStr=%f; VertRad=%f; VertStr=%f; Mask=%d)', [Pointer(aHandle), aHorzRad, aHorzStr, aVertRad, aVertStr, Integer(aMask)]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img) then begin
- horz := TtsKernel1D.Create(aHorzRad, aHorzStr);
- vert := TtsKernel1D.Create(aVertRad, aVertStr);
- try
- img.Blur(horz, vert, aMask);
- finally
- FreeAndNil(horz);
- FreeAndNil(vert);
- end;
- end else
- result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageBlur=%d', [Integer(result)]);{$ENDIF}
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function ltsImageDestroy(aHandle: TltsImageHandle): TltsErrorCode; stdcall;
- var
- img: TtsImage;
- begin
- try
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageDestroy(Handle=%p)', [Pointer(aHandle)]);{$ENDIF}
- result := ltsErrNone;
- if CheckImageHandle(aHandle, img) then begin
- DelReference(ltsObjTypeImage, img);
- FreeAndNil(img);
- end else
- result := LastErrorCode;
- except
- on ex: Exception do begin
- SetLastError(ex);
- result := LastErrorCode;
- end;
- end;
- {$IFDEF DEBUG}utlLogger.Log(nil, 'ltsImageDestroy=%d', [Integer(result)]);{$ENDIF}
- end;
-
- end.
-
|