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.