// SPDX-License-Identifier: LGPL-3.0-linking-exception { Created by BGRA Controls Team Dibo, Circular, lainz (007) and contributors. For detailed information see readme.txt Site: https://sourceforge.net/p/bgra-controls/ Wiki: http://wiki.lazarus.freepascal.org/BGRAControls Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html } unit BGRAScript; {$I bgracontrols.inc} { $define debug} interface uses Classes, SysUtils, BGRABitmap, BGRABitmapTypes, Dialogs; {Template} procedure SynCompletionList(itemlist: TStrings); {Scripting} function ScriptCommand(command: string; var bitmap: TBGRABitmap; var variables: TStringList; var line: integer): boolean; function ScriptCommandList(commandlist: TStrings; var bitmap: TBGRABitmap): boolean; {Tools} function StrToDrawMode(mode: string): TDrawMode; implementation procedure SynCompletionList(itemlist: TStrings); begin with itemlist do begin {Assign key values} Add('let key "value"'); {Goto line} Add('goto 10'); {Messages} Add('print "Message"'); Add('input "Title","Message","Default value",result'); {Read Values} Add('GetWidth width'); Add('GetHeight height'); {TFPCustomImage override} Add('SetSize 320,240'); {Loading functions} Add('SaveToFile "file.png"'); {Loading functions} Add('SetHorizLine 0,0,100,"rgba(0,0,0,1)"'); Add('XorHorizLine 0,0,100,"rgba(0,0,0,1)"'); Add('DrawHorizLine 0,0,100,"rgba(0,0,0,1)"'); Add('FastBlendHorizLine 0,0,100,"rgba(0,0,0,1)"'); Add('AlphaHorizLine 0,0,100,"rgba(0,0,0,1)"'); Add('SetVertLine 0,0,100,"rgba(0,0,0,1)"'); Add('XorVertLine 0,0,100,"rgba(0,0,0,1)"'); Add('DrawVertLine 0,0,100,"rgba(0,0,0,1)"'); Add('FastBlendVertLine 0,0,100,"rgba(0,0,0,1)"'); Add('AlphaVertLine 0,0,100,"rgba(0,0,0,1)"'); Add('DrawHorizLinediff 0,0,100,"rgba(0,0,0,1)","rgba(255,255,255,1)",128'); //-- Add('FillTransparent'); Add('Rectangle 0,0,100,100,"rgba(0,0,0,1)","rgba(255,255,255,1)","dmDrawWithTransparency"'); Add('RectangleAntiAlias "0,5","0,5","99,5","99,5","rgba(0,0,0,1)","1,5","rgba(255,255,255,1)"'); {BGRA bitmap functions} Add('RotateCW'); Add('RotateCCW'); Add('Negative'); Add('NegativeRect 0,0,100,100'); Add('LinearNegative'); Add('LinearNegativeRect 0,0,100,100'); Add('InplaceGrayscale'); Add('InplaceGrayscaleRect 0,0,100,100'); Add('SwapRedBlue'); Add('GrayscaleToAlpha'); Add('AlphaToGrayscale'); Add('ApplyGlobalOpacity 128'); Add('ConvertToLinearRGB'); Add('ConvertFromLinearRGB'); Add('DrawCheckers 0,0,100,100,"rgba(100,100,100,255)","rgba(0,0,0,0)"'); {Custom functions} Add('VerticalFlip 0,0,100,100'); Add('HorizontalFlip 0,0,100,100'); Add('BlendBitmap 0,0,"file.png","boTransparent"'); Add('BlendBitmapOver 0,0,"file.png","boTransparent",255,"False"'); Add('ApplyBitmapMask "file.png",0,0,100,100,0,0'); {Filters} Add('FilterFastBlur 5,"False"'); Add('FilterSmooth "False"'); Add('FilterSharpen 5,"False"'); Add('FilterContour'); Add('FilterEmboss "1,5"'); Add('FilterNormalize "True"'); Add('FilterSphere "True"'); Add('FilterCylinder "True"'); Add('FilterPlane "True"'); end; end; function ScriptCommand(command: string; var bitmap: TBGRABitmap; var variables: TStringList; var line: integer): boolean; function ParamCheck(passed, mustbe: integer): boolean; begin Result := True; if passed <> mustbe then Result := False; {$IFDEF INDEBUG} if not Result then begin writeln('>> Wrong number of parameters: ' + IntToStr(passed)); writeln('>> Must be: ' + IntToStr(mustbe)); end; {$endif} end; function ParamCheckAtLeast(passed, mustbe: integer): boolean; begin Result := True; if passed < mustbe then Result := False; {$IFDEF INDEBUG} if not Result then begin writeln('>> Wrong number of parameters: ' + IntToStr(passed)); writeln('>> At least must be: ' + IntToStr(mustbe)); end; {$endif} end; var list: TStringList; passed: integer; tmpbmp1: TBGRABitmap; i: integer; a: string; begin { $ifdef debug} //writeln('---Script-Command---'); { $endif} Result := True; list := TStringList.Create; list.CommaText := command; passed := list.Count; {Replace values in variable names} for i := 0 to list.Count - 1 do if variables.Values[list[i]] <> '' then list[i] := variables.Values[list[i]]; case LowerCase(list[0]) of {Assign key values} 'let': begin Result := ParamCheck(passed, 3); if Result then variables.Add(list[1] + '=' + list[2]); end; {Messages} 'input': begin Result := ParamCheck(passed, 5); if Result then begin a := InputBox(list[1],list[2],list[3]); variables.Add(list[4] + '=' + a); end; end; 'print': begin Result := ParamCheckAtLeast(passed, 2); if Result then begin a := ''; for i:=1 to passed -1 do a := a + list[i]; ShowMessage(a); end; end; {GoTo} 'goto': begin Result := ParamCheck(passed,2); if Result then begin line := StrToInt(list[1]) - 2; if line < 0 then line := -1; end; end; {Read values} 'getwidth': begin Result := ParamCheck(passed, 2); if Result then variables.Add(list[1] + '=' + IntToStr(bitmap.Width)); end; 'getheight': begin Result := ParamCheck(passed, 2); if Result then variables.Add(list[1] + '=' + IntToStr(bitmap.Height)); end; {TFPCustomImage override} 'setsize': begin Result := ParamCheck(passed, 3); if Result then bitmap.SetSize(StrToInt(list[1]), StrToInt(list[2])); end; {Loading functions} 'savetofile': begin Result := ParamCheck(passed, 2); if Result then bitmap.SaveToFile(list[1]); end; {Pixel functions} {Loading functions} {* Horiz *} 'sethorizline': begin Result := ParamCheck(passed, 5); if Result then bitmap.SetHorizLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'xorhorizline': begin Result := ParamCheck(passed, 5); if Result then bitmap.XorHorizLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'drawhorizline': begin Result := ParamCheck(passed, 5); if Result then bitmap.DrawHorizLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'fastblendhorizline': begin Result := ParamCheck(passed, 5); if Result then bitmap.FastBlendHorizLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'alphahorizline': begin Result := ParamCheck(passed, 5); if Result then bitmap.AlphaHorizLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4])); end; {* Vert *} 'setvertline': begin Result := ParamCheck(passed, 5); if Result then bitmap.SetVertLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'xorvertline': begin Result := ParamCheck(passed, 5); if Result then bitmap.XorVertLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'drawvertline': begin Result := ParamCheck(passed, 5); if Result then bitmap.DrawVertLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'fastblendvertline': begin Result := ParamCheck(passed, 5); if Result then bitmap.FastBlendVertLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4])); end; 'alphavertline': begin Result := ParamCheck(passed, 5); if Result then bitmap.AlphaVertLine(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4])); end; {* Misc *} 'drawhorizlinediff': begin Result := ParamCheck(passed, 7); if Result then bitmap.DrawHorizLineDiff(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToBGRA(list[4]), StrToBGRA(list[5]), StrToInt(list[6])); end; //--- 'filltransparent': begin Result := ParamCheck(passed, 1); if Result then bitmap.FillTransparent; end; 'rectangle': begin Result := ParamCheck(passed, 8); if Result then bitmap.Rectangle(StrToInt(list[1]), StrToInt(list[2]), StrToInt( list[3]), StrToInt(list[4]), StrToBGRA(list[5]), StrToBGRA(list[6]), StrToDrawMode(list[7])); end; 'rectangleantialias': begin Result := ParamCheck(passed, 8); if Result then bitmap.RectangleAntialias(StrToFloat(list[1]), StrToFloat(list[2]), StrToFloat(list[3]), StrToFloat(list[4]), StrToBGRA(list[5]), StrToFloat(list[6]), StrToBGRA(list[7])); end; {BGRA bitmap functions} 'verticalflip': begin Result := ParamCheck(passed, 5); if Result then bitmap.VerticalFlip(Rect(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4]))); end; 'horizontalflip': begin Result := ParamCheck(passed, 5); if Result then bitmap.HorizontalFlip(Rect(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4]))); end; 'rotatecw': begin Result := ParamCheck(passed, 1); if Result then try tmpbmp1 := bitmap.RotateCW as TBGRABitmap; bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); finally tmpbmp1.Free; end; end; 'rotateccw': begin Result := ParamCheck(passed, 1); if Result then try tmpbmp1 := bitmap.RotateCCW as TBGRABitmap; bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); finally tmpbmp1.Free; end; end; 'negative': begin Result := ParamCheck(passed, 1); if Result then bitmap.Negative; end; 'negativerect': begin Result := ParamCheck(passed, 5); if Result then bitmap.NegativeRect(Rect(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4]))); end; 'linearnegative': begin Result := ParamCheck(passed, 1); if Result then bitmap.LinearNegative; end; 'linearnegativerect': begin Result := ParamCheck(passed, 5); if Result then bitmap.LinearNegativeRect(Rect(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4]))); end; 'inplacegrayscale': begin Result := ParamCheck(passed, 1); if Result then bitmap.InplaceGrayscale; end; 'inplacegrayscalerect': begin Result := ParamCheck(passed, 5); if Result then bitmap.InplaceGrayscale(Rect(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4]))); end; 'swapredblue': begin Result := ParamCheck(passed, 1); if Result then bitmap.SwapRedBlue; end; 'grayscaletoalpha': begin Result := ParamCheck(passed, 1); if Result then bitmap.GrayscaleToAlpha; end; 'alphatograyscale': begin Result := ParamCheck(passed, 1); if Result then bitmap.AlphaToGrayscale; end; 'applyglobalopacity': begin Result := ParamCheck(passed, 2); if Result then bitmap.ApplyGlobalOpacity(StrToInt(list[1])); end; 'converttolinearrgb': begin Result := ParamCheck(passed, 1); if Result then bitmap.ConvertToLinearRGB; end; 'convertfromlinearrgb': begin Result := ParamCheck(passed, 1); if Result then bitmap.ConvertFromLinearRGB; end; 'drawcheckers': begin Result := ParamCheck(passed, 7); if Result then bitmap.DrawCheckers(Rect(StrToInt(list[1]), StrToInt(list[2]), StrToInt(list[3]), StrToInt(list[4])), StrToBGRA(list[5]), StrToBGRA(list[6])); end; {Filters} {Custom Functions} 'blendbitmap': begin Result := ParamCheck(passed, 5); if Result then try tmpbmp1 := TBGRABitmap.Create(list[3]); bitmap.BlendImage(StrToInt(list[1]), StrToInt(list[2]), tmpbmp1, StrToBlendOperation(list[4])); finally tmpbmp1.Free; end; end; 'blendbitmapover': begin Result := ParamCheck(passed, 7); if Result then try tmpbmp1 := TBGRABitmap.Create(list[3]); bitmap.BlendImageOver(StrToInt(list[1]), StrToInt(list[2]), tmpbmp1, StrToBlendOperation(list[4]), StrToInt(list[5]), StrToBool(list[6])); finally tmpbmp1.Free; end; end; 'applybitmapmask': begin Result := ParamCheck(passed, 8); if Result then try tmpbmp1 := TBGRABitmap.Create(list[1]); bitmap.ApplyMask(tmpbmp1, Rect(StrToInt(list[2]), StrToInt( list[3]), StrToInt(list[4]), StrToInt(list[5])), Point( StrToInt(list[6]), StrToInt(list[7]))); finally tmpbmp1.Free; end; end; 'filterfastblur': begin Result := ParamCheck(passed, 3); if Result then begin tmpbmp1 := bitmap.FilterBlurRadial(StrToInt(list[1]), rbFast) as TBGRABitmap; if StrToBool(list[2]) then bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filtersmooth': begin Result := ParamCheck(passed, 2); if Result then begin tmpbmp1 := bitmap.FilterSmooth as TBGRABitmap; if StrToBool(list[1]) then bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filtersharpen': begin Result := ParamCheck(passed, 3); if Result then begin tmpbmp1 := bitmap.FilterSharpen(StrToInt(list[1])) as TBGRABitmap; if StrToBool(list[2]) then bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filtercontour': begin Result := ParamCheck(passed, 1); if Result then begin tmpbmp1 := bitmap.FilterContour as TBGRABitmap; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filteremboss': begin Result := ParamCheck(passed, 2); if Result then begin tmpbmp1 := bitmap.FilterEmboss(StrToFloat(list[1])) as TBGRABitmap; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filternormalize': begin Result := ParamCheck(passed, 2); if Result then begin tmpbmp1 := bitmap.FilterNormalize(StrToBool(list[1])) as TBGRABitmap; bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filtersphere': begin Result := ParamCheck(passed, 2); if Result then begin tmpbmp1 := bitmap.FilterSphere as TBGRABitmap; if StrToBool(list[1]) then bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filtercylinder': begin Result := ParamCheck(passed, 2); if Result then begin tmpbmp1 := bitmap.FilterCylinder as TBGRABitmap; if StrToBool(list[1]) then bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; 'filterplane': begin Result := ParamCheck(passed, 2); if Result then begin tmpbmp1 := bitmap.FilterPlane as TBGRABitmap; if StrToBool(list[1]) then bitmap.FillTransparent; bitmap.BlendImage(0, 0, tmpbmp1, boLinearBlend); tmpbmp1.Free; end; end; '//': begin // comment end; '{': begin { comment } end; else begin {$IFDEF INDEBUG} writeln('>> Command "' + list[0] + '" not found.'); {$endif} Result := False; end; end; {$IFDEF INDEBUG} if not Result then writeln('>> ERROR'); for i := 0 to list.Count - 1 do writeln(' ' + list[i]); writeln('____________________'); {$endif} list.Free; end; function ScriptCommandList(commandlist: TStrings; var bitmap: TBGRABitmap): boolean; var line: integer; variables: TStringList; begin {$IFDEF INDEBUG} //writeln('----SCRIPT--LIST----'); writeln(' Executing ' + IntToStr(commandlist.Count) + ' lines...'); writeln('____________________'); {$endif} variables := TStringList.Create; {Result := True; for i := 0 to commandlist.Count - 1 do if commandlist[i] <> '' then ScriptCommand(commandlist[i], bitmap, variables); } Result := True; line := 0; repeat if commandlist[line] <> '' then ScriptCommand(commandlist[line], bitmap, variables, line); Inc(line); until line > commandList.Count; variables.Free; {$IFDEF INDEBUG} //writeln('----SCRIPT--LIST----'); writeln(' END'); writeln('____________________'); {$endif} end; function StrToDrawMode(mode: string): TDrawMode; begin case LowerCase(mode) of 'dmset': Result := dmSet; 'dmsetexcepttransparent': Result := dmSetExceptTransparent; 'dmlinearblend': Result := dmLinearBlend; 'dmdrawwithtransparency': Result := dmDrawWithTransparency; 'dmxor': Result := dmXor; else Result := dmDrawWithTransparency; end; end; end.