浏览代码

basic support for python scripts

circular17 5 年之前
父节点
当前提交
0ea1d53d09

+ 3 - 3
lazpaint/dialog/usaveoption.pas

@@ -106,7 +106,7 @@ type
     property PngStreamNeeded: boolean read GetPngStreamNeeded;
   end;
 
-function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string): boolean;
+function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean;
 
 implementation
 
@@ -114,11 +114,11 @@ uses UGraph, FPWriteJPEG, UResourceStrings, FPWriteBMP, BMPcomn,
   UMySLV, BGRAWriteBmpMioMap, BGRADithering, UFileSystem, LCScaleDPI,
   BGRAThumbnail, BGRAIconCursor, BGRAWinResource;
 
-function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string): boolean;
+function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean;
 var f: TFSaveOption;
 begin
   result := false;
-  if SuggestImageFormat(AOutputFilenameUTF8) in[ifBmp,ifJpeg,ifPng,ifIco,ifCur] then
+  if not ASkipOptions and (SuggestImageFormat(AOutputFilenameUTF8) in[ifBmp,ifJpeg,ifPng,ifIco,ifCur]) then
   begin
     f := TFSaveOption.Create(nil);
     try

+ 172 - 0
lazpaint/image/uimageaction.pas

@@ -21,6 +21,8 @@ type
     procedure ChooseTool(ATool: TPaintToolType);
     procedure RegisterScripts(ARegister: Boolean);
     function GenericScriptFunction(AVars: TVariableSet): TScriptResult;
+    function ScriptPutImage(AVars: TVariableSet): TScriptResult;
+    function ScriptLayerFill(AVars: TVariableSet): TScriptResult;
     procedure ReleaseSelection;
   public
     constructor Create(AInstance: TLazPaintCustomInstance);
@@ -61,6 +63,9 @@ type
     procedure RemoveLayer;
     procedure EditSelection(ACallback: TModifyImageCallback);
     procedure Import3DObject(AFilenameUTF8: string);
+    function GetPixel(X,Y: Integer): TBGRAPixel;
+    function PutImage(X,Y,AWidth,AHeight: integer; AImage: TBGRACustomBitmap; AMode: TDrawMode; AOpacity: byte): boolean;
+    function LayerFill(AColor: TBGRAPixel; AMode: TDrawMode): boolean;
     function TryAddLayerFromFile(AFilenameUTF8: string; ALoadedImage: TBGRABitmap = nil): boolean;
     function AddLayerFromBitmap(ABitmap: TBGRABitmap; AName: string): boolean;
     function AddLayerFromOriginal(AOriginal: TBGRALayerCustomOriginal; AName: string): boolean;
@@ -138,6 +143,12 @@ begin
   Scripting.RegisterScriptFunction('LayerRasterize',@GenericScriptFunction,ARegister);
   Scripting.RegisterScriptFunction('LayerMergeOver',@GenericScriptFunction,ARegister);
   Scripting.RegisterScriptFunction('LayerRemoveCurrent',@GenericScriptFunction,ARegister);
+  Scripting.RegisterScriptFunction('GetLayerCount',@GenericScriptFunction,ARegister);
+  Scripting.RegisterScriptFunction('GetPixel',@GenericScriptFunction,ARegister);
+  Scripting.RegisterScriptFunction('GetImageWidth',@GenericScriptFunction,ARegister);
+  Scripting.RegisterScriptFunction('GetImageHeight',@GenericScriptFunction,ARegister);
+  Scripting.RegisterScriptFunction('PutImage',@GenericScriptFunction,ARegister);
+  Scripting.RegisterScriptFunction('LayerFill',@GenericScriptFunction,ARegister);
 end;
 
 constructor TImageActions.Create(AInstance: TLazPaintCustomInstance);
@@ -192,9 +203,116 @@ begin
   if f = 'LayerRasterize' then RasterizeLayer else
   if f = 'LayerMergeOver' then MergeLayerOver else
   if f = 'LayerRemoveCurrent' then RemoveLayer else
+  if f = 'GetLayerCount' then AVars.Integers['Result']:= Image.NbLayers else
+  if f = 'GetPixel' then AVars.Pixels['Result']:= GetPixel(AVars.Integers['X'],AVars.Integers['Y']) else
+  if f = 'GetImageWidth' then AVars.Integers['Result']:= Image.Width else
+  if f = 'GetImageHeight' then AVars.Integers['Result']:= Image.Height else
+  if f = 'PutImage' then result := ScriptPutImage(AVars) else
+  if f = 'LayerFill' then result := ScriptLayerFill(AVars) else
     result := srFunctionNotDefined;
 end;
 
+function TImageActions.ScriptPutImage(AVars: TVariableSet): TScriptResult;
+var
+  x, y, width, height, opacity, yb, dataPos, xb: integer;
+  dataStr, modeStr: String;
+  mode: TDrawMode;
+  bmp: TBGRABitmap;
+  p: PBGRAPixel;
+
+  function HexDigit(APos: integer): byte;
+  begin
+    result := ord(dataStr[APos]);
+    if result < ord('0') then result := 0
+    else if result <= ord('9') then dec(result, ord('0'))
+    else if result < ord('A') then result := 9
+    else if result <= ord('F') then result := result - ord('A') + 10
+    else result := 15;
+  end;
+
+  function HexValue(APos: integer): byte;
+  begin
+    result := (HexDigit(APos) shl 4) + HexDigit(APos+1);
+  end;
+
+begin
+  x := AVars.Integers['X'];
+  y := AVars.Integers['Y'];
+  width := AVars.Integers['Width'];
+  height := AVars.Integers['Height'];
+  dataStr := AVars.Strings['Data'];
+  modeStr := AVars.Strings['Mode'];
+  opacity := AVars.Integers['Opacity'];
+  case modeStr of
+  'dmDrawWithTransparency': mode := dmDrawWithTransparency;
+  'dmLinearBlend': mode := dmLinearBlend;
+  'dmSet': mode := dmSet;
+  'dmSetExceptTransparent': mode := dmSetExceptTransparent;
+  'dmXor': mode := dmXor;
+  else exit(srInvalidParameters);
+  end;
+  if (opacity < 0) or (opacity > 255) then exit(srInvalidParameters);
+  if length(dataStr)<>width*height*8 then exit(srInvalidParameters);
+
+  if (width = 0) or (height = 0) then exit(srOk);
+  if opacity = 0 then exit(srOk);
+  bmp := TBGRABitmap.Create(width,height);
+  try
+    dataPos := 1;
+    for yb := 0 to height-1 do
+    begin
+      p := bmp.ScanLine[yb];
+      for xb := 0 to width-1 do
+      begin
+        p^.alpha := HexValue(dataPos+6);
+        if p^.alpha = 0 then p^ := BGRAPixelTransparent
+        else
+        begin
+          p^.red := HexValue(dataPos);
+          p^.green := HexValue(dataPos+2);
+          p^.blue := HexValue(dataPos+4);
+        end;
+        inc(dataPos,8);
+        inc(p);
+      end;
+    end;
+    bmp.InvalidateBitmap;
+
+    if PutImage(x,y,width,height,bmp,mode,opacity) then
+    begin
+      result := srOk;
+      FInstance.UpdateWindows;
+    end
+    else
+      result := srException;
+  finally
+    bmp.Free;
+  end;
+end;
+
+function TImageActions.ScriptLayerFill(AVars: TVariableSet): TScriptResult;
+var
+  modeStr: String;
+  mode: TDrawMode;
+begin
+  modeStr := AVars.Strings['Mode'];
+  case modeStr of
+  'dmDrawWithTransparency': mode := dmDrawWithTransparency;
+  'dmLinearBlend': mode := dmLinearBlend;
+  'dmSet': mode := dmSet;
+  'dmSetExceptTransparent': mode := dmSetExceptTransparent;
+  'dmXor': mode := dmXor;
+  else exit(srInvalidParameters);
+  end;
+  if LayerFill(AVars.Pixels['Color'], mode) then
+  begin
+    result := srOk;
+    FInstance.UpdateWindows;
+  end
+  else
+    result := srException;
+end;
+
 procedure TImageActions.ClearAlpha;
 var c: TBGRAPixel;
     n: integer;
@@ -324,6 +442,60 @@ begin
   end;
 end;
 
+function TImageActions.GetPixel(X, Y: Integer): TBGRAPixel;
+var
+  ofs: TPoint;
+begin
+  ofs := Image.LayerOffset[Image.CurrentLayerIndex];
+  result := Image.LayerBitmap[Image.CurrentLayerIndex].GetPixel(X-ofs.X,y-ofs.Y);
+end;
+
+function TImageActions.PutImage(X, Y, AWidth, AHeight: integer; AImage: TBGRACustomBitmap;
+  AMode: TDrawMode; AOpacity: byte): boolean;
+var
+  LayerAction: TLayerAction;
+begin
+  result := false;
+  if not Image.CheckNoAction then exit;
+  LayerAction := nil;
+  try
+    LayerAction := Image.CreateAction(true);
+    LayerAction.ChangeBoundsNotified:= true;
+    LayerAction.SelectedImageLayer.PutImage(X,Y,AImage,AMode,AOpacity);
+    LayerAction.NotifyChange(LayerAction.SelectedImageLayer, RectWithSize(X,Y,AImage.Width,AImage.Height));
+    LayerAction.Validate;
+    result := true;
+  except
+    on ex:Exception do
+      FInstance.ShowError('PutImage',ex.Message);
+  end;
+  LayerAction.Free;
+end;
+
+function TImageActions.LayerFill(AColor: TBGRAPixel; AMode: TDrawMode): boolean;
+var
+  LayerAction: TLayerAction;
+begin
+  if (AColor.alpha=0) and (AMode in[dmDrawWithTransparency,dmLinearBlend]) then exit(true);
+  result := false;
+  if not Image.CheckNoAction then exit;
+  LayerAction := nil;
+  try
+    LayerAction := Image.CreateAction(true);
+    LayerAction.ChangeBoundsNotified:= true;
+    LayerAction.SelectedImageLayer.Fill(AColor, AMode);
+    LayerAction.NotifyChange(LayerAction.SelectedImageLayer,
+        rect(0,0,LayerAction.SelectedImageLayer.Width,
+              LayerAction.SelectedImageLayer.Height));
+    LayerAction.Validate;
+    result := true;
+  except
+    on ex:Exception do
+      FInstance.ShowError('LayerFill',ex.Message);
+  end;
+  LayerAction.Free;
+end;
+
 function TImageActions.LoadSelection(AFilenameUTF8: string; ALoadedImage: PImageEntry = nil): boolean;
 var
   newSelection: TBGRABitmap;

+ 11 - 1
lazpaint/lazpaint.lpi

@@ -342,7 +342,7 @@
         <PackageName Value="LCL"/>
       </Item5>
     </RequiredPackages>
-    <Units Count="100">
+    <Units Count="102">
       <Unit0>
         <Filename Value="lazpaint.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -933,6 +933,16 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="URaw"/>
       </Unit99>
+      <Unit100>
+        <Filename Value="uprocessauto.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UProcessAuto"/>
+      </Unit100>
+      <Unit101>
+        <Filename Value="upython.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UPython"/>
+      </Unit101>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 1 - 1
lazpaint/lazpaint.lpr

@@ -39,7 +39,7 @@ uses
   UMainFormLayout, USaveOption, UBrushType, ugeometricbrush,
   URainType, UFormRain, UPaletteToolbar, uselectionhighlight,
   UImagePreview, UPreviewDialog, UQuestion, UTiff, UImageView,
-  UDarkTheme, URaw;
+  UDarkTheme, URaw, UProcessAuto, UPython;
 
 //sometimes LResources disappear in the uses clause
 

+ 3 - 2
lazpaint/lazpaintdialogs.inc

@@ -86,7 +86,7 @@ begin
     result := srInvalidParameters;
     exit;
   end;
-  if Image.IsFileModified then
+  if Image.IsFileModified and not AVars.Booleans['IgnoreModified'] then
   begin
     case SaveQuestion(rsNewImage) of
     IDYES: begin
@@ -119,6 +119,7 @@ begin
   image.Assign(bitmapRepl, True, False);
   Image.CurrentFilenameUTF8 := '';
   image.SetSavedFlag;
+  UpdateWindows;
   result := srOk;
 end;
 
@@ -396,7 +397,7 @@ begin
   self.ShowTopmost(top);
 end;
 
-function TLazPaintInstance.ShowwaveDisplacementDlg(AFilterConnector: TObject): boolean;
+function TLazPaintInstance.ShowWaveDisplacementDlg(AFilterConnector: TObject): boolean;
 var oldSelectionNormal: boolean;
     top: TTopMostInfo;
 begin

+ 95 - 5
lazpaint/lazpaintinstance.pas

@@ -14,7 +14,8 @@ uses
   ucolorintensity, ushiftcolors, ucolorize, uadjustcurves,
   ucustomblur, uimagelist,
 
-  ULoading, UImage, UTool, uconfig, IniFiles, uresourcestrings, uscripting;
+  ULoading, UImage, UTool, uconfig, IniFiles, uresourcestrings, uscripting,
+  UScriptType;
 
 const
   MaxToolPopupShowCount = 3;
@@ -41,6 +42,9 @@ type
     function ScriptImageResample(AParams: TVariableSet): TScriptResult;
     procedure SelectionInstanceOnRun(AInstance: TLazPaintCustomInstance);
     procedure ToolColorChanged(Sender: TObject);
+    procedure PythonScriptCommand({%H-}ASender: TObject; ACommand, AParam: UTF8String; out
+      AResult: UTF8String);
+    function ScriptShowMessage(AVars: TVariableSet): TScriptResult;
 
   protected
     InColorFromFChooseColor: boolean;
@@ -155,9 +159,10 @@ type
     procedure NotifyImageChangeCompletely(RepaintNow: boolean); override;
     function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; override;
     function ExecuteFilter(filter: TPictureFilter; skipDialog: boolean = false): boolean; override;
+    function RunScript(AFilename: string): boolean; override;
     procedure ColorFromFChooseColor; override;
     procedure ColorToFChooseColor; override;
-    function ShowSaveOptionDlg({%H-}AParameters: TVariableSet; AOutputFilenameUTF8: string): boolean; override;
+    function ShowSaveOptionDlg({%H-}AParameters: TVariableSet; AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean; override;
     function ShowColorIntensityDlg(AParameters: TVariableSet): boolean; override;
     function ShowColorLightnessDlg(AParameters: TVariableSet): boolean; override;
     function ShowShiftColorsDlg(AParameters: TVariableSet): boolean; override;
@@ -213,7 +218,7 @@ uses LCLType, Types, Forms, Dialogs, FileUtil, LCLIntf, Math,
      UImageAction, USharpen, uposterize, UPhongFilter, UFilterFunction,
      uprint, USaveOption, UFormRain,
 
-     ugraph, LCScaleDPI, ucommandline, uabout;
+     ugraph, LCScaleDPI, ucommandline, uabout, UPython;
 
 { TLazPaintInstance }
 
@@ -280,6 +285,7 @@ begin
   ScriptContext.RegisterScriptFunction('ColorLightness',@ScriptColorLightness,ARegister);
   ScriptContext.RegisterScriptFunction('ColorShiftColors',@ScriptColorShiftColors,ARegister);
   ScriptContext.RegisterScriptFunction('ColorIntensity',@ScriptColorIntensity,ARegister);
+  ScriptContext.RegisterScriptFunction('ShowMessage',@ScriptShowMessage,ARegister);
 end;
 
 procedure TLazPaintInstance.Init(AEmbedded: boolean);
@@ -566,6 +572,61 @@ begin
     result := false;
 end;
 
+procedure TLazPaintInstance.PythonScriptCommand(ASender: TObject; ACommand,
+  AParam: UTF8String; out AResult: UTF8String);
+var
+  params: TVariableSet;
+  err: TInterpretationErrors;
+  scriptErr: TScriptResult;
+  vRes: TScriptVariableReference;
+begin
+  AResult := 'None';
+  if Assigned(FScriptContext) then
+  begin
+    params := TVariableSet.Create(ACommand);
+    AParam := trim(AParam);
+    if length(AParam)>0 then
+    begin
+      if AParam[1] = '{' then
+      begin
+        delete(AParam,1,1);
+        if (length(AParam)>0) and (AParam[length(AParam)] = '}') then
+          delete(AParam, length(AParam), 1);
+        err := params.LoadFromVariablesAsString(AParam);
+        if err <> [] then
+          raise exception.Create('Error in parameter format: '+InterpretationErrorsToStr(err));
+      end else
+        raise exception.Create('Error in parameter format: dictionary not found');
+    end;
+    try
+      scriptErr := FScriptContext.CallScriptFunction(params);
+      if scriptErr = srOk then
+      begin
+        vRes := params.GetVariable('Result');
+        if params.IsReferenceDefined(vRes) then
+        begin
+          case vRes.variableType of
+          svtFloat: AResult := FloatToStr(params.GetFloat(vRes));
+          svtInteger: AResult := IntToStr(params.GetInteger(vRes));
+          svtBoolean: AResult := BoolToStr(params.GetBoolean(vRes),'True','False');
+          svtString: AResult := ScriptQuote(params.GetString(vRes));
+          svtPixel: AResult := '"'+BGRAToStr(params.GetPixel(vRes))+'"';
+          end;
+        end;
+      end else
+        raise exception.Create(ScriptResultToStr[scriptErr]+' ('+ACommand+')');
+    finally
+      params.Free;
+    end;
+  end;
+end;
+
+function TLazPaintInstance.ScriptShowMessage(AVars: TVariableSet): TScriptResult;
+begin
+  ShowMessage('Script', AVars.Strings['Message']);
+  result := srOk;
+end;
+
 procedure TLazPaintInstance.OnLayeredBitmapLoadStartHandler(AFilenameUTF8: string);
 begin
   if FLoadingLayers = nil then
@@ -1214,6 +1275,35 @@ begin
   vars.Free;
 end;
 
+function TLazPaintInstance.RunScript(AFilename: string): boolean;
+var
+  p: TPythonScript;
+  errorLines: TStringList;
+begin
+  p := TPythonScript.Create;
+  try
+    p.OnCommand:=@PythonScriptCommand;
+    p.Run(AFilename);
+    if p.ErrorText<>'' then
+    begin
+      errorLines := TStringList.Create;
+      errorLines.Text := Trim(p.ErrorText);
+      if errorLines.Count > 0 then
+        ShowError(ChangeFileExt(ExtractFileName(AFilename),''), errorLines[errorLines.Count-1]);
+      errorLines.Free;
+      result := false;
+    end else
+      result := true;
+  except
+    on ex:exception do
+    begin
+      ShowError('Python', ex.Message);
+      result := false;
+    end;
+  end;
+  p.Free;
+end;
+
 procedure TLazPaintInstance.ColorFromFChooseColor;
 begin
   FormsNeeded;
@@ -1237,9 +1327,9 @@ begin
 end;
 
 function TLazPaintInstance.ShowSaveOptionDlg(AParameters: TVariableSet;
-  AOutputFilenameUTF8: string): boolean;
+  AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean;
 begin
-  result := USaveOption.ShowSaveOptionDialog(self,AOutputFilenameUTF8);
+  result := USaveOption.ShowSaveOptionDialog(self,AOutputFilenameUTF8,ASkipOptions);
 end;
 
 procedure TLazPaintInstance.MoveToolboxTo(X, Y: integer);

+ 5 - 0
lazpaint/lazpaintmainform.lfm

@@ -8716,6 +8716,11 @@ object FMain: TFMain
       OnExecute = EditShapeToCurveExecute
       OnUpdate = EditShapeToCurveUpdate
     end
+    object FileRunScript: TAction
+      Category = 'File'
+      Caption = 'Run script...'
+      OnExecute = FileRunScriptExecute
+    end
   end
   object ColorDialog1: TColorDialog
     Title = 'Choose color'

+ 84 - 29
lazpaint/lazpaintmainform.pas

@@ -28,6 +28,7 @@ type
   { TFMain }
 
   TFMain = class(TForm)
+    FileRunScript: TAction;
     EditShapeToCurve: TAction;
     EditShapeAlignBottom: TAction;
     EditShapeCenterVertically: TAction;
@@ -471,6 +472,7 @@ type
     procedure FileImport3DUpdate(Sender: TObject);
     procedure FilePrintExecute(Sender: TObject);
     procedure FileRememberSaveFormatExecute(Sender: TObject);
+    procedure FileRunScriptExecute(Sender: TObject);
     procedure FileSaveAsInSameFolderExecute(Sender: TObject);
     procedure FileSaveAsInSameFolderUpdate(Sender: TObject);
     procedure FileUseImageBrowserExecute(Sender: TObject);
@@ -811,6 +813,7 @@ type
     function ScriptFileOpen(AVars: TVariableSet): TScriptResult;
     function ScriptFileSaveAs(AVars: TVariableSet): TScriptResult;
     function ScriptFileSave({%H-}AVars: TVariableSet): TScriptResult;
+    function ScriptFileGetFilename(AVars: TVariableSet): TScriptResult;
     function ScriptFileReload({%H-}AVars: TVariableSet): TScriptResult;
     function ScriptFileLoadSelection(AVars: TVariableSet): TScriptResult;
     function ScriptFileSaveSelectionAs(AVars: TVariableSet): TScriptResult;
@@ -863,7 +866,7 @@ implementation
 uses LCLIntf, BGRAUTF8, ugraph, math, umac, uclipboard, ucursors,
    ufilters, ULoadImage, ULoading, UFileExtensions, UBrushType,
    ugeometricbrush, UPreviewDialog, UQuestion, BGRALayerOriginal,
-   BGRATransform, LCVectorPolyShapes, URaw;
+   BGRATransform, LCVectorPolyShapes, URaw, UFileSystem;
 
 const PenWidthFactor = 10;
 
@@ -1128,6 +1131,7 @@ begin
   Scripting.RegisterScriptFunction('FileOpen',@ScriptFileOpen,ARegister);
   Scripting.RegisterScriptFunction('FileSaveAs',@ScriptFileSaveAs,ARegister);
   Scripting.RegisterScriptFunction('FileSave',@ScriptFileSave,ARegister);
+  Scripting.RegisterScriptFunction('GetFileName',@ScriptFileGetFilename,ARegister);
   Scripting.RegisterScriptFunction('FileReload',@ScriptFileReload,ARegister);
   Scripting.RegisterScriptFunction('FileLoadSelection',@ScriptFileLoadSelection,ARegister);
   Scripting.RegisterScriptFunction('FileSaveSelectionAs',@ScriptFileSaveSelectionAs,ARegister);
@@ -1275,7 +1279,7 @@ begin
   loadedImage := TImageEntry.Empty;
   try
     topInfo.defined:= false;
-    if Image.IsFileModified then
+    if Image.IsFileModified and not AVars.Booleans['IgnoreModified'] then
     begin
       topInfo := FLazPaintInstance.HideTopmost;
       case LazPaintInstance.SaveQuestion(rsOpen) of
@@ -1420,7 +1424,7 @@ function TFMain.ScriptFileSaveAs(AVars: TVariableSet): TScriptResult;
         end
         else
         begin
-          if not LazPaintInstance.ShowSaveOptionDlg(nil,filename) then
+          if not LazPaintInstance.ShowSaveOptionDlg(nil,filename,AVars.Booleans['SkipOptions']) then
             result := srCancelledByUser
           else
             saved := true;
@@ -1452,12 +1456,23 @@ var filename: string;
     vFileName: TScriptVariableReference;
     topMost: TTopMostInfo;
     defaultExt: string;
+    initialDir: string;
 begin
   AskMergeSelection(rsSave);
   filename := ExtractFileName(Image.CurrentFilenameUTF8);
   vFileName := AVars.GetVariable('FileName');
-  if AVars.IsReferenceDefined(vFileName) then filename := AVars.GetString(vFileName);
+  if AVars.IsReferenceDefined(vFileName) then
+  begin
+    filename := AVars.GetString(vFileName);
+    initialDir := ExtractFilePath(filename);
+    {$WARNINGS OFF}
+    if PathDelim <> '\' then initialDir := StringReplace(initialDir, '\', PathDelim, [rfReplaceAll]);
+    if PathDelim <> '/' then initialDir := StringReplace(initialDir, '/', PathDelim, [rfReplaceAll]);
+    {$WARNINGS ON}
+    filename := ExtractFileName(filename);
+  end else initialDir:= '';
   if filename = '' then filename := rsNoName;
+  if initialDir = '' then initialDir:= FSaveInitialDir;
   if SavePictureDialog1.FilterIndex > 1 then
     filename := ApplySelectedFilterExtension(filename,SavePictureDialog1.Filter,SavePictureDialog1.FilterIndex);
   if not Image.AbleToSaveAsUTF8(filename) then
@@ -1466,7 +1481,6 @@ begin
     filename := ChangeFileExt(Filename,'');
   end;
   SavePictureDialog1.FileName := filename;
-  topMost := LazPaintInstance.HideTopmost;
 
   case SuggestImageFormat(Image.CurrentFilenameUTF8) of
   ifCur: defaultExt := '.cur';
@@ -1478,36 +1492,49 @@ begin
     end;
   end;
 
-  if UseImageBrowser then
+  if AVars.Booleans['Validate'] and (initialDir <> '') then
   begin
-    if not assigned(FSaveImage) then
+    if FileManager.FileExists(initialDir+filename) then
     begin
-      FSaveImage := TFBrowseImages.Create(self);
-      FSaveImage.LazPaintInstance := LazPaintInstance;
-      FSaveImage.IsSaveDialog := true;
-      FSaveImage.Caption := SavePictureDialog1.Title;
-      FSaveImage.ShowRememberStartupDirectory:= true;
-      if Config.DefaultRememberSaveFormat then
-        FSaveImage.DefaultExtensions:= Config.DefaultSaveExtensions;
+      if QuestionDlg(rsSave, rsOverwriteFile, mtConfirmation,
+          [mrOk, rsOkay, mrCancel, rsCancel],0) <> mrOk then
+             exit(srCancelledByUser);
     end;
-    FSaveImage.InitialFilename := filename;
-    FSaveImage.DefaultExtension := defaultExt;
-    FSaveImage.InitialDirectory:= FSaveInitialDir;
-    if FSaveImage.ShowModal = mrOK then
-      result := DoSaveAs(FSaveImage.FileName)
-    else
-      result := srCancelledByUser;
+    result := DoSaveAs(initialDir+filename);
   end else
   begin
-    SavePictureDialog1.DefaultExt := defaultExt;
-    SavePictureDialog1.InitialDir:= FSaveInitialDir;
-    if SavePictureDialog1.Execute then
+    topMost := LazPaintInstance.HideTopmost;
+    if UseImageBrowser then
     begin
-      result := DoSaveAs(SavePictureDialog1.FileName);
+      if not assigned(FSaveImage) then
+      begin
+        FSaveImage := TFBrowseImages.Create(self);
+        FSaveImage.LazPaintInstance := LazPaintInstance;
+        FSaveImage.IsSaveDialog := true;
+        FSaveImage.Caption := SavePictureDialog1.Title;
+        FSaveImage.ShowRememberStartupDirectory:= true;
+        if Config.DefaultRememberSaveFormat then
+          FSaveImage.DefaultExtensions:= Config.DefaultSaveExtensions;
+      end;
+      FSaveImage.InitialFilename := filename;
+      FSaveImage.DefaultExtension := defaultExt;
+      FSaveImage.InitialDirectory:= initialDir;
+      if FSaveImage.ShowModal = mrOK then
+        result := DoSaveAs(FSaveImage.FileName)
+      else
+        result := srCancelledByUser;
     end else
-      result := srCancelledByUser;
+    begin
+      SavePictureDialog1.DefaultExt := defaultExt;
+      SavePictureDialog1.InitialDir:= initialDir;
+      if SavePictureDialog1.Execute then
+      begin
+        result := DoSaveAs(SavePictureDialog1.FileName);
+      end else
+        result := srCancelledByUser;
+    end;
+    LazPaintInstance.ShowTopmost(topMost);
   end;
-  LazPaintInstance.ShowTopmost(topMost);
 end;
 
 function TFMain.ScriptFileSave(AVars: TVariableSet): TScriptResult;
@@ -1524,7 +1551,7 @@ begin
         end
         else
         begin
-          if LazPaintInstance.ShowSaveOptionDlg(nil,Image.currentFilenameUTF8) then
+          if LazPaintInstance.ShowSaveOptionDlg(nil,Image.currentFilenameUTF8,AVars.Booleans['SkipOptions']) then
             result := srOk
           else
             result := srCancelledByUser;
@@ -1540,6 +1567,12 @@ begin
     end;
 end;
 
+function TFMain.ScriptFileGetFilename(AVars: TVariableSet): TScriptResult;
+begin
+  AVars.Strings['Result'] := Image.currentFilenameUTF8;
+  result := srOk;
+end;
+
 procedure TFMain.FileSaveUpdate(Sender: TObject);
 begin
    FileSave.Enabled := image.IsFileModified;
@@ -1807,7 +1840,7 @@ begin
     result := srOk;
     exit;
   end;
-  if Image.IsFileModified then
+  if Image.IsFileModified and not AVars.Booleans['IgnoreModified'] then
   begin
     topmostInfo := LazPaintInstance.HideTopmost;
     res := MessageDlg(rsReload,rsReloadChanged,mtWarning,mbYesNo,0);
@@ -3132,6 +3165,28 @@ begin
   Config.SetRememberSaveFormat(FileRememberSaveFormat.Checked);
 end;
 
+procedure TFMain.FileRunScriptExecute(Sender: TObject);
+var
+  dlg: TOpenDialog;
+begin
+  dlg := TOpenDialog.Create(nil);
+  try
+    dlg.Title := FileRunScript.Caption;
+    dlg.InitialDir:= Config.DefaultScriptDirectory;
+    dlg.DefaultExt:= 'py';
+    dlg.Filter:= 'Python (*.py)|*.py';
+    if dlg.Execute then
+    begin
+      Config.SetDefaultScriptDirectory(ExtractFilePath(dlg.FileName));
+      LazPaintInstance.RunScript(dlg.FileName);
+    end;
+  except
+    on ex:exception do
+      LazPaintInstance.ShowError(FileRunScript.Caption, ex.Message);
+  end;
+  dlg.Free;
+end;
+
 procedure TFMain.FileSaveAsInSameFolderExecute(Sender: TObject);
 var dir: string;
 begin

+ 2 - 1
lazpaint/lazpainttype.pas

@@ -231,9 +231,10 @@ type
     procedure NotifyStackChange; virtual; abstract;
     function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; virtual; abstract;
     function ExecuteFilter(filter: TPictureFilter; skipDialog: boolean = false): boolean; virtual; abstract;
+    function RunScript(AFilename: string): boolean; virtual; abstract;
     procedure ColorFromFChooseColor; virtual; abstract;
     procedure ColorToFChooseColor; virtual; abstract;
-    function ShowSaveOptionDlg(AParameters: TVariableSet; AOutputFilenameUTF8: string): boolean; virtual; abstract;
+    function ShowSaveOptionDlg(AParameters: TVariableSet; AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean; virtual; abstract;
     function ShowColorIntensityDlg(AParameters: TVariableSet): boolean; virtual; abstract;
     function ShowColorLightnessDlg(AParameters: TVariableSet): boolean; virtual; abstract;
     function ShowShiftColorsDlg(AParameters: TVariableSet): boolean; virtual; abstract;

+ 131 - 49
lazpaint/quote.inc

@@ -6,9 +6,110 @@ begin
     raise exception.create('Invalid quoted string (error '+inttostr(integer(errors))+')');
 end;
 
+function UnescapeString(const S: string): string;
+const HexDigit = ['0'..'9','a'..'f','A'..'F'];
+  OctDigit = ['0'..'7'];
+var
+  outputpos: integer;
+
+  procedure put(c: char);
+  begin
+    if outputpos > length(result) then
+      setlength(result, length(result)*2+1);
+    result[outputpos] := c;
+    inc(outputpos);
+  end;
+  procedure putStr(s: string);
+  var
+    j: Integer;
+  begin
+    for j := 1 to length(s) do
+      put(s[j]);
+  end;
+  function CheckHex(AFrom,ATo: integer): boolean;
+  var
+    j: Integer;
+  begin
+    if ATo > length(s) then exit(false);
+    for j := AFrom to ATo do
+      if not (s[j] in HexDigit) then exit(false);
+    result := true;
+  end;
+  function CheckOct(AFrom,ATo: integer): boolean;
+  var
+    j: Integer;
+  begin
+    if ATo > length(s) then exit(false);
+    for j := AFrom to ATo do
+      if not (s[j] in OctDigit) then exit(false);
+    result := true;
+  end;
+  function OctToInt(s: string): integer;
+  var
+    j: Integer;
+  begin
+    result := 0;
+    for j := 1 to length(s) do
+      result := (result shl 3)+ord(s[j])-ord('0');
+  end;
+
+var
+  i: Integer;
+  escaping: boolean;
+
+begin
+  setlength(result, length(s));
+  escaping := false;
+  outputpos := 1;
+  i := 1;
+  while i <= length(s) do
+  begin
+    if escaping then
+    begin
+      case s[i] of
+        '\','''','"': put(s[i]);
+        'a': put(#7);
+        'b': put(#8);
+        'f': put(#12);
+        'n': put(#10);
+        'r': put(#13);
+        't': put(#9);
+        'v': put(#11);
+        '0'..'7': if CheckOct(i+1,i+3) then
+             begin
+               putstr(UnicodeCharToUTF8(OctToInt(copy(s,i+1,2))));
+               inc(i,3);
+             end else putstr('\'+s[i]);
+        'x': if CheckHex(i+1,i+2) then
+             begin
+               putstr(UnicodeCharToUTF8(StrToInt('$'+copy(s,i+1,2))));
+               inc(i,2);
+             end else putstr('\'+s[i]);
+        'u': if CheckHex(i+1,i+4) then
+             begin
+               putstr(UnicodeCharToUTF8(StrToInt('$'+copy(s,i+1,4))));
+               inc(i,4);
+             end else putstr('\'+s[i]);
+        'U': if CheckHex(i+1,i+8) then
+             begin
+               putstr(UnicodeCharToUTF8(StrToInt('$'+copy(s,i+1,8))));
+               inc(i,8);
+             end else putstr('\'+s[i]);
+         else putstr('\'+s[i]);
+      end;
+      escaping := false;
+    end else
+    if s[i] = '\' then escaping := true
+    else put(s[i]);
+    inc(i);
+  end;
+  setlength(result, outputpos-1);
+end;
+
 function TryScriptUnquote(const S: String; out unquotedS: string): TInterpretationErrors;
 var curPos,quoteStart,idStart: integer; idStr, charCodeStr: string;
   charFuncStep: (fsNone, fsWaitOpenBracket, fsCharCodeParam, fsWaitCloseBraket);
+  escaping: Boolean;
 
   procedure AppendChar;
   var errPos: integer;
@@ -74,29 +175,28 @@ begin
           charCodeStr := charCodeStr+s[CurPos];
       end;
     end else
-    if s[curPos] = StringDelimiter then
+    if s[curPos] in StringDelimiters then
     begin
       quoteStart := curPos;
+      escaping := false;
       inc(curPos);
       while true do
       begin
         if curPos <= length(s) then
         begin
-          if s[curPos]=StringDelimiter then
+          if not escaping then
           begin
-            unquotedS:= unquotedS+copy(s,quoteStart+1,curPos-quoteStart-1);
-            inc(curPos);
-            if (curPos <= length(s)) and (s[curPos]=StringDelimiter) then
-            begin
-              unquotedS:= unquotedS+StringDelimiter;
-              quoteStart := curPos;
-            end
+            if s[curPos]=EscapePrefix then
+              escaping := true
             else
+            if s[curPos]=s[quoteStart] then
             begin
-              quoteStart := curPos-1;
+              unquotedS:= unquotedS+UnescapeString(copy(s,quoteStart+1,curPos-quoteStart-1));
+              inc(curPos);
               break;
             end;
-          end;
+          end else
+            escaping := false;
           inc(curPos);
         end else
         begin
@@ -125,65 +225,47 @@ end;
 
 function ScriptQuote(const S: string): string;
 const
-  NonPrintableChars = [#0,#7..#13,#26,#27];
+  StringDelimiter = StringDelimiter1;
+  EscapeChars = [#0,#7..#13,#26,#27,'\',StringDelimiter];
 var i, j, count: integer;
   inQuote: boolean;
 
-  procedure EnterQuote;
-  begin
-    if not inQuote then
-    begin
-      If result <> '' then result := result + ' & ';
-      result := result+StringDelimiter;
-      inQuote := true;
-    end;
-  end;
-
   procedure FlushChars;
   var NbFlush: integer;
   begin
     NbFlush := i - j - 1;
     if NbFlush <= 0 then exit;
-    EnterQuote;
     result := result + copy(S, 1 + j, NbFlush);
     j := i;
   end;
 
-  procedure LeaveQuote;
-  begin
-    if inQuote then
-    begin
-      result := result+StringDelimiter;
-      inQuote := false;
-    end;
-  end;
-
 begin
-  result := '';
+  result := StringDelimiter;
   inQuote := false;
   count := length(s);
   i := 0;
   j := 0;
-  while i < count do begin
+  while i < count do
+  begin
      i := i + 1;
-     if s[i] in NonPrintableChars then
+     if s[i] in EscapeChars then
      begin
        FlushChars;
-       LeaveQuote;
-       If result <> '' then result := result + ' & ';
-       result := result+'Chr('+IntToStr(Ord(s[i]))+')';
+       case s[i] of
+         #7: result += '\a';
+         #8: result += '\b';
+         #9: result += '\t';
+         #10: result += '\n';
+         #11: result += '\v';
+         #12: result += '\f';
+         #13: result += '\r';
+         ' '..#127: result += '\'+s[i];
+         else result += '\x'+IntToHex(ord(s[i]),2);
+       end;
        j := i;
      end;
-     if S[i] = StringDelimiter then begin
-        FlushChars;
-        result := result+ StringDelimiter+StringDelimiter;
-        end ;
-     end ;
-  if i <> j then
-  begin
-     EnterQuote;
-     result := result + copy(S, 1 + j, i - j);
   end;
-  LeaveQuote;
-  if result = '' then result := StringDelimiter+StringDelimiter;
+  if i <> j then
+    result := result + copy(S, 1 + j, i - j);
+  result += StringDelimiter;
 end;

+ 12 - 0
lazpaint/uconfig.pas

@@ -94,6 +94,8 @@ type
     procedure SetDefaultBrushDirectory(value: string);
     function DefaultPaletteDirectory: string;
     procedure SetDefaultPaletteDirectory(value: string);
+    function DefaultScriptDirectory: string;
+    procedure SetDefaultScriptDirectory(value: string);
 
     function DefaultIconSize(defaultValue: integer): integer;
     procedure SetDefaultIconSize(value: integer);
@@ -1563,6 +1565,16 @@ begin
   iniOptions.WriteString('General','PaletteDirectory',ChompPathDelim(value))
 end;
 
+function TLazPaintConfig.DefaultScriptDirectory: string;
+begin
+  result := iniOptions.ReadString('General','ScriptDirectory','');
+end;
+
+procedure TLazPaintConfig.SetDefaultScriptDirectory(value: string);
+begin
+  iniOptions.WriteString('General','ScriptDirectory',ChompPathDelim(value))
+end;
+
 function TLazPaintConfig.DefaultIconSize(defaultValue: integer): integer;
 begin
   result := iniOptions.ReadInteger('General','DefaultIconSize',0);

+ 1 - 1
lazpaint/umenu.pas

@@ -379,7 +379,7 @@ begin
   with FActionList.Actions[i] as TAction do
     if (Caption = '') and (Hint <> '') then Caption := Hint;
 
-  AddMenus('MenuFile',   'FileNew,FileOpen,LayerFromFile,FileChooseEntry,FileReload,MenuRecentFiles,-,FileSave,FileSaveAsInSameFolder,FileSaveAs,-,FileImport3D,-,FilePrint,-,'+ImageBrowser+'FileRememberSaveFormat,ForgetDialogAnswers,MenuLanguage,*');
+  AddMenus('MenuFile',   'FileNew,FileOpen,LayerFromFile,FileChooseEntry,FileReload,MenuRecentFiles,-,FileSave,FileSaveAsInSameFolder,FileSaveAs,-,FileRunScript,FileImport3D,-,FilePrint,-,'+ImageBrowser+'FileRememberSaveFormat,ForgetDialogAnswers,MenuLanguage,*');
   AddMenus('MenuEdit',   'EditUndo,EditRedo,-,EditCut,EditCopy,EditPaste,EditPasteAsNew,EditPasteAsNewLayer,EditDeleteSelection,-,EditMoveUp,EditMoveToFront,EditMoveDown,EditMoveToBack,EditShapeAlign,EditShapeToCurve,-,EditSelectAll,EditInvertSelection,EditSelectionFit,EditDeselect');
   AddMenus('MenuSelect', 'EditSelection,FileLoadSelection,FileSaveSelectionAs,-,EditSelectAll,EditInvertSelection,EditSelectionFit,EditDeselect,-,ToolSelectRect,ToolSelectEllipse,ToolSelectPoly,ToolSelectSpline,-,ToolMoveSelection,ToolRotateSelection,SelectionHorizontalFlip,SelectionVerticalFlip,-,ToolSelectPen,ToolMagicWand');
   AddMenus('MenuView',   'ViewGrid,ViewZoomOriginal,ViewZoomIn,ViewZoomOut,ViewZoomFit,-,ViewToolBox,ViewColors,ViewPalette,ViewLayerStack,ViewImageList,ViewStatusBar,-,*,-,ViewDarkTheme,ViewWorkspaceColor,MenuIconSize');

+ 153 - 0
lazpaint/uprocessauto.pas

@@ -0,0 +1,153 @@
+unit UProcessAuto;
+
+{$mode objfpc}{$H+}
+{ This unit allows to receive line by line the output of a process
+  and to send lines to its input in response.
+
+  Note:
+  - the process will freeze if it expects an input that is not provided.
+  - if the process draw only part of a line, like with a progress bar, this
+    won't be received in the events.
+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  TReceiveLineEvent = procedure(ALine: RawByteString) of object;
+  TSendLineMethod = procedure(const ALine: RawByteString) of object;
+
+procedure RunProcessAutomation(AExecutable: string; AParameters: array of string;
+  out ASendLine: TSendLineMethod;
+  AOnReceiveOutput: TReceiveLineEvent;
+  AOnReceiveError: TReceiveLineEvent);
+
+implementation
+
+uses process, Pipes, math;
+
+const
+  LineEndingStr: string = LineEnding;
+
+type
+  { TAutomatedProcess }
+
+  TAutomatedProcess = class(TProcess)
+    constructor Create(AOwner: TComponent); override;
+    procedure SendLine(const ALine: RawByteString);
+  end;
+
+procedure RunProcessAutomation(AExecutable: string; AParameters: array of string;
+  out ASendLine: TSendLineMethod;
+  AOnReceiveOutput: TReceiveLineEvent;
+  AOnReceiveError: TReceiveLineEvent);
+
+type
+  TReceiveBuffer = record
+    Data: RawByteString;
+    Length: integer;
+    OnReceive: TReceiveLineEvent;
+  end;
+
+  procedure InitBuffer(out Buffer: TReceiveBuffer; ASize: integer; AOnReceive: TReceiveLineEvent);
+  begin
+    setlength(Buffer.Data, ASize);
+    Buffer.Length:= 0;
+    Buffer.OnReceive:= AOnReceive;
+  end;
+
+  procedure ParseBuffer(var Buffer: TReceiveBuffer);
+  var
+    startIdx,idx, count: integer;
+    line: RawByteString;
+  begin
+    startIdx := 1;
+    idx := startIdx;
+    while idx <= Buffer.Length do
+    begin
+      //find LineEnding
+      if (Buffer.Data[idx] = LineEndingStr[1]) and
+         (idx+length(LineEndingStr)-1 <= Buffer.Length) and
+         (copy(Buffer.Data,idx,length(LineEndingStr)) = LineEndingStr) then
+      begin
+        line := copy(Buffer.Data, startIdx, idx-startIdx);
+        Buffer.OnReceive(line);
+        inc(idx, length(LineEndingStr));
+        startIdx := idx;
+        continue;
+      end;
+      inc(idx);
+    end;
+    if startIdx > 1 then
+    begin
+      count := Buffer.Length-startIdx+1;
+      if count > 0 then
+        move(Buffer.Data[startIdx], Buffer.Data[1], Buffer.Length-startIdx+1);
+      dec(Buffer.Length, startIdx-1);
+    end;
+  end;
+
+  function Receive(AInput: TInputPipeStream; var Buffer: TReceiveBuffer): boolean;
+  var
+    receivedCount: integer;
+  begin
+    receivedCount := AInput.NumBytesAvailable;
+    if receivedCount > 0 then
+    begin
+      if Buffer.Length+receivedCount > length(Buffer.Data) then
+        setlength(Buffer.Data, max(length(Buffer.Data)*2, Buffer.Length+receivedCount));
+      AInput.Read(Buffer.Data[Buffer.Length+1], receivedCount);
+      inc(Buffer.Length, receivedCount);
+      ParseBuffer(Buffer);
+      result := true;
+    end else
+      result := false;
+  end;
+
+var
+  p: TAutomatedProcess;
+  Output, Error: TReceiveBuffer;
+  i: integer;
+begin
+  p := TAutomatedProcess.Create(nil);
+  ASendLine := @p.SendLine;
+  try
+    p.Executable:= AExecutable;
+    for i := 0 to high(AParameters) do
+      p.Parameters.Add(AParameters[i]);
+    p.Execute;
+    InitBuffer(Output, p.PipeBufferSize, AOnReceiveOutput);
+    InitBuffer(Error, p.PipeBufferSize, AOnReceiveError);
+    while p.Running do
+    begin
+      if not Receive(p.Output, Output) and
+         not Receive(p.Stderr, Error) then
+        sleep(15);
+    end;
+    Receive(p.Output, Output);
+    Receive(p.Stderr, Error);
+  finally
+    p.Free;
+  end;
+end;
+
+{ TAutomatedProcess }
+
+constructor TAutomatedProcess.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Options:= [poNoConsole,poUsePipes];
+  PipeBufferSize := 65536;
+end;
+
+procedure TAutomatedProcess.SendLine(const ALine: RawByteString);
+begin
+  if length(ALine)>0 then
+    Input.Write(ALine[1],length(ALine));
+  Input.Write(LineEndingStr[1],length(LineEndingStr));
+end;
+
+end.
+

+ 185 - 0
lazpaint/upython.pas

@@ -0,0 +1,185 @@
+unit UPython;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, UProcessAuto;
+
+const
+  DefaultPythonBin = {$IFDEF WINDOWS}'py'{$ELSE}'python3'{$ENDIF};
+
+type
+  TReceiveLineEvent = procedure(ASender: TObject; ALine: UTF8String) of object;
+  TCommandEvent = procedure(ASender: TObject; ACommand, AParam: UTF8String; out AResult: UTF8String) of object;
+
+  { TPythonScript }
+
+  TPythonScript = class
+  private
+    FPythonBin: string;
+    FPythonVersion: string;
+    FLinePrefix: RawByteString;
+    FOnCommand: TCommandEvent;
+    FOnError: TReceiveLineEvent;
+    FOnOutputLine: TReceiveLineEvent;
+    FPythonSend: TSendLineMethod;
+    FErrorText: UTF8String;
+    FFirstOutput: boolean;
+    function GetPythonVersionMajor: integer;
+    procedure PythonError(ALine: RawByteString);
+    procedure PythonOutput(ALine: RawByteString);
+  public
+    constructor Create(APythonBin: string = DefaultPythonBin);
+    procedure Run(AScriptFilename: UTF8String; APythonVersion: integer = 3);
+    property OnOutputLine: TReceiveLineEvent read FOnOutputLine write FOnOutputLine;
+    property OnError: TReceiveLineEvent read FOnError write FOnError;
+    property OnCommand: TCommandEvent read FOnCommand write FOnCommand;
+    property PythonVersion: string read FPythonVersion;
+    property PythonVersionMajor: integer read GetPythonVersionMajor;
+    property ErrorText: UTF8String read FErrorText;
+  end;
+
+function GetPythonVersion(APythonBin: string = DefaultPythonBin): string;
+
+implementation
+
+uses process;
+
+function GetPythonVersion(APythonBin: string = DefaultPythonBin): string;
+const PythonVersionPrefix = 'Python ';
+var versionStr: string;
+begin
+  RunCommand(APythonBin, ['-V'], versionStr, [poStderrToOutPut]);
+  if versionStr.StartsWith(PythonVersionPrefix) then
+    result := trim(copy(versionStr,length(PythonVersionPrefix)+1,
+           length(versionStr)-length(PythonVersionPrefix)))
+  else
+    result := '?';
+end;
+
+{ TPythonScript }
+
+procedure TPythonScript.PythonOutput(ALine: RawByteString);
+var
+  idxParam, cmdPos: SizeInt;
+  command, param, finalLine: RawByteString;
+  commandRes: UTF8String;
+  i, curDisplayPos, maxDisplayLen: Integer;
+  displayedLine: RawByteString;
+begin
+  if FFirstOutput then
+  begin
+    if ALine <> 'LazPaint script'#9 then
+      raise exception.Create('This is not a LazPaint script')
+    else
+    begin
+      FFirstOutput:= false;
+      if Assigned(FPythonSend) then
+        FPythonSend(chr(27)+'LazPaint')
+      else
+        raise exception.Create('Send callback not defined');
+    end;
+  end;
+
+  cmdPos := pos(#27, ALine);
+  if (cmdPos > 0) then
+  begin
+    FLinePrefix += copy(ALine, 1, cmdPos-1);
+    delete(ALine, 1, cmdPos-1);
+
+    idxParam := Pos(#29, ALine);
+    param := '';
+    if idxParam = 0 then
+      command := copy(ALine,2,length(ALine)-1)
+    else
+    begin
+      command := copy(ALine,2,idxParam-2);
+      param := copy(ALine,idxParam+1,length(ALine)-(idxParam+1)+1);
+    end;
+    if command<>'' then
+    begin
+      if command[length(command)] = '?' then
+      begin
+        delete(command, length(command), 1);
+        if Assigned(FOnCommand) then
+          FOnCommand(self, command, param, commandRes)
+        else
+          commandRes := '';
+        if Assigned(FPythonSend) then
+          FPythonSend(commandRes);
+      end else
+      begin
+        if Assigned(FOnCommand) then
+          FOnCommand(self, command, param, commandRes);
+      end;
+    end;
+
+  end else
+  begin
+    if Assigned(FOnOutputLine) then
+    begin
+      finalLine := FLinePrefix+ALine;
+      setlength(displayedLine, 80);
+      curDisplayPos := 1;
+      maxDisplayLen := 0;
+      for i := 1 to length(finalLine) do
+      begin
+        if finalLine[i] = #13 then curDisplayPos := 1 else
+        if finalLine[i] = #8 then
+        begin
+          if curDisplayPos > 1 then dec(curDisplayPos);
+        end else
+        begin
+          if curDisplayPos > length(displayedLine) then
+            setlength(displayedLine, length(displayedLine)*2);
+          displayedLine[curDisplayPos] := finalLine[i];
+          if curDisplayPos > maxDisplayLen then
+            maxDisplayLen := curDisplayPos;
+          inc(curDisplayPos);
+        end;
+      end;
+      setlength(displayedLine, maxDisplayLen);
+      FOnOutputLine(self, displayedLine);
+    end;
+    FLinePrefix := '';
+  end;
+end;
+
+constructor TPythonScript.Create(APythonBin: string);
+begin
+  FPythonBin := APythonBin;
+  FPythonVersion:= GetPythonVersion(FPythonBin);
+end;
+
+procedure TPythonScript.PythonError(ALine: RawByteString);
+begin
+  if Assigned(FOnError) then
+    FOnError(self, ALine)
+  else
+    FErrorText += ALine+LineEnding;
+end;
+
+function TPythonScript.GetPythonVersionMajor: integer;
+var
+  posDot: SizeInt;
+  errPos: integer;
+begin
+  posDot := pos('.',PythonVersion);
+  val(copy(PythonVersion,1,posDot-1), result, errPos);
+end;
+
+procedure TPythonScript.Run(AScriptFilename: UTF8String;
+  APythonVersion: integer);
+begin
+  FLinePrefix := '';
+  if PythonVersionMajor <> APythonVersion then
+    raise exception.Create('Expected python version is '+inttostr(APythonVersion)+' but '+inttostr(PythonVersionMajor)+' found.');
+  FFirstOutput:= true;
+  RunProcessAutomation(FPythonBin, ['-u', AScriptFilename], FPythonSend, @PythonOutput, @PythonError);
+  FPythonSend := nil;
+end;
+
+end.
+

+ 46 - 18
lazpaint/uscripting.pas

@@ -10,6 +10,11 @@ uses
 type
   TVariableSet = class;
   TScriptResult = (srOk, srInvalidParameters, srCancelledByUser, srException, srFunctionNotDefined);
+const
+  ScriptResultToStr: array[TScriptResult] of string =
+    ('Ok', 'Invalid parameters', 'Cancelled by user', 'Exception', 'Function not defined');
+
+type
   TScriptFunction = function(AVars: TVariableSet): TScriptResult of object;
   TScriptVariableReference = record
     variableSet: TVariableSet;
@@ -417,16 +422,23 @@ var varName: string;
     subsetStr: string;
     s: TVariableSet;
     start: integer;
-    inQuote: boolean;
+    inQuote: char;
+    escaping: boolean;
   begin
     if cur > length(expr) then exit;
     start := cur;
-    inQuote := false;
+    inQuote := #0;
     inSubset := 0;
+    escaping := true;
     repeat
-      if inQuote then
+      if inQuote <> #0 then
       begin
-        if expr[cur] = StringDelimiter then inQuote:= false;
+        if not escaping then
+        begin
+          if expr[cur] = inQuote then inQuote:= #0 else
+          if expr[cur] = '\' then escaping := true;
+        end else
+          escaping := false;
       end else
       begin
         if expr[cur] = '{' then
@@ -439,11 +451,11 @@ var varName: string;
           dec(inSubset);
           if inSubset = 0 then break;
         end
-        else if expr[cur] = StringDelimiter then inQuote:= true;
+        else if expr[cur] in StringDelimiters then inQuote:= expr[cur];
       end;
       inc(cur);
     until cur > length(expr);
-    if inQuote then result += [ieEndingQuoteNotFound];
+    if inQuote <> #0 then result += [ieEndingQuoteNotFound];
     subsetStr := copy(expr,start,cur-start);
     s := TVariableSet.Create('');
     result += s.LoadFromVariablesAsString(subsetStr);
@@ -455,16 +467,23 @@ var varName: string;
   var inBracket: integer;
     listStr: string;
     start: integer;
-    inQuote: boolean;
+    inQuote: char;
+    escaping: boolean;
   begin
     if cur > length(expr) then exit;
     start := cur;
-    inQuote := false;
+    inQuote := #0;
     inBracket := 0;
+    escaping := false;
     repeat
-      if inQuote then
+      if inQuote <> #0 then
       begin
-        if expr[cur] = StringDelimiter then inQuote:= false;
+        if not escaping then
+        begin
+          if expr[cur] = inQuote then inQuote:= #0 else
+          if expr[cur] = '\' then escaping := true;
+        end else
+          escaping := false;
       end else
       begin
         if expr[cur] in['(','['] then
@@ -478,16 +497,16 @@ var varName: string;
           dec(inBracket);
           if inBracket = 0 then
           begin
-            inc(cur);
             if expr[cur] <> ']' then result += [ieUnexpectedClosingBracketKind];
+            inc(cur);
             break;
           end;
         end
-        else if expr[cur] = StringDelimiter then inQuote:= true;
+        else if expr[cur] in StringDelimiters then inQuote:= expr[cur];
       end;
       inc(cur);
     until cur > length(expr);
-    if inQuote then result += [ieEndingQuoteNotFound];
+    if inQuote <> #0 then result += [ieEndingQuoteNotFound];
     listStr := copy(expr,start,cur-start);
     AddList(varName, listStr);
   end;
@@ -502,6 +521,8 @@ begin
   while idxEq <> 0 do
   begin
     varName := trim(copy(AVariablesAsString,1,idxEq-1));
+    if (length(varName)>=2) and (varName[1]='''') and (varName[length(varName)]='''') then
+      varName := UnescapeString(Copy(varName,2,length(varName)-2));
     cur := idxEq+2;
     while (cur <= length(AVariablesAsString)) and (AVariablesAsString[cur] in IgnoredWhitespaces) do inc(cur);
     if (cur <= length(AVariablesAsString)) and (AVariablesAsString[cur]='{') then
@@ -1345,7 +1366,8 @@ class function TVariableSet.AssignList(const ADest: TScriptVariableReference;
   AListExpr: string): TInterpretationErrors;
 var
   tilde,expectingValue: boolean;
-  inQuote: boolean;
+  inQuote: char;
+  escaping: boolean;
   start,cur: integer;
 
   procedure AppendValue(AValue: string);
@@ -1383,19 +1405,25 @@ begin
   end else
     cur := 1;
   tilde := false;
-  inQuote:= false;
+  inQuote:= #0;
+  escaping := false;
   start := 0;
   expectingValue := false;
   while cur <= length(AListExpr) do
   begin
-    if inQuote then
+    if inQuote <> #0 then
     begin
-      if AListExpr[cur]=StringDelimiter then inQuote:= false;
+      if not escaping then
+      begin
+        if AListExpr[cur]=inQuote then inQuote:= #0 else
+        if AListExpr[cur]='\' then escaping := true;
+      end else
+        escaping := false;
     end else
     if (start = 0) and (AListExpr[cur]='~') then tilde := true else
     begin
       if (start = 0) and not (AListExpr[cur] in IgnoredWhitespaces) then start := cur;
-      if AListExpr[cur] = StringDelimiter then inQuote:=true else
+      if AListExpr[cur] in StringDelimiters then inQuote:= AListExpr[cur] else
       if AListExpr[cur]=',' then
       begin
         if start = 0 then result += [ieMissingValue]

+ 55 - 16
lazpaint/uscripttype.pas

@@ -20,10 +20,13 @@ const
   VariableDefinitionToken : string = ':';
   TrueToken : string = 'True';
   FalseToken : string = 'False';
-  NilToken : string = 'Nil';
+  UndefinedToken : string = 'None';
   CharToken1 : string = 'Chr';
   CharToken2 : string = 'Char';
-  StringDelimiter: string = '"';
+  StringDelimiter1 = '"';
+  StringDelimiter2 = '''';
+  EscapePrefix = '\';
+  StringDelimiters = [StringDelimiter1, StringDelimiter2];
   IdentifierCharStart: set of char = ['a'..'z','A'..'Z','_',#128..#255];
   IdentifierCharMiddle: set of char = ['a'..'z','A'..'Z','_',#128..#255,'0'..'9'];
   IgnoredWhitespaces : set of char = [#9,#13,#10,' '];
@@ -72,9 +75,18 @@ const
     (svtFloat, svtInteger, svtBoolean, svtString, svtPixel, svtObject);
   EmptyListExpression : array[svtFloatList..svtObjectList] of string =
     ('[~0.0]', '[~0]', '[~False]', '[~""]','[~#000]','[~Nil]');
+  InterpretationErrorToStr: array[TInterpretationError] of string =
+    ('Too many closing brackets', 'Ending quote not found',
+     'Opening bracket not found', 'Closing bracket not found',
+     'Constant expression expected', 'Unexpected char',
+     'Invalid number', 'Invalid color', 'Invalid boolean',
+     'Duplicate identifier', 'Unexpected opening bracket kind',
+     'Unexpected closing bracket kind',
+     'Unknown list type', 'Missing value');
 
 function ScriptQuote(const S: string): string;
 function ScriptUnquote(const S: string): string;
+function UnescapeString(const S: string): string;
 function TryScriptUnquote(const S: String; out unquotedS: string): TInterpretationErrors;
 function FloatToStrUS(AValue: double): string;
 function ScalarToStr(AVarType: TScriptVariableType; var AValue): string;
@@ -82,9 +94,12 @@ function ParseLitteral(var cur: integer; expr: string; var errors: TInterpretati
 function ParseListType(s: string): TScriptVariableType;
 function FloatToPixel(AValue: double): TBGRAPixel;
 function IntToPixel(AValue: TScriptInteger): TBGRAPixel;
+function InterpretationErrorsToStr(AErrors: TInterpretationErrors): string;
 
 implementation
 
+uses BGRAUTF8;
+
 {$i quote.inc}
 
 function FloatToStrUS(AValue: double): string;
@@ -141,7 +156,7 @@ begin
     svtInteger: result := IntToStr(TScriptInteger(AValue));
     svtPixel: result := '#'+BGRAToStr(TBGRAPixel(AValue));
     svtBoolean: result := BoolToStr(Boolean(AValue),TrueToken,FalseToken);
-    svtObject: if TScriptInteger(AValue) = 0 then result := NilToken else result := 'Object';
+    svtObject: if TScriptInteger(AValue) = 0 then result := UndefinedToken else result := 'Object';
   else raise exception.Create('Not a scalar type');
   end;
 end;
@@ -150,7 +165,7 @@ function ParseLitteral(var cur: integer; expr: string; var errors: TInterpretati
 var startIdentifier: integer;
     inIdentifier, notConstant: boolean;
     inBracket: integer;
-    isString, isBoolean: boolean;
+    isString, isBoolean, isUndefined: boolean;
   procedure CheckIdentifier;
   var idStr: string;
   begin
@@ -164,6 +179,11 @@ var startIdentifier: integer;
     begin
       if inBracket = 0 then isBoolean := true;
     end
+    else
+    if (CompareText(idStr,UndefinedToken) = 0) then
+    begin
+      if inBracket = 0 then isUndefined := true;
+    end
     else
       notConstant := true;
   end;
@@ -173,7 +193,8 @@ var
   valueStr: string;
   start: integer;
   unquotedStr: string;
-  inQuote, inNumber, inPixel: boolean;
+  inQuote: char;
+  inNumber, inPixel: boolean;
   isNumber, isPixel: boolean;
   valueInt: TScriptInteger;
   valueFloat: double;
@@ -187,14 +208,9 @@ begin
   result.valueInt := 0;
   result.valuePixel := BGRAPixelTransparent;
   result.valueBool:= false;
-  if CompareText(trim(expr),NilToken) = 0 then
-  begin
-    result.valueType := svtObject;
-    exit;
-  end;
   start := cur;
   inBracket:= 0;
-  inQuote:= false;
+  inQuote:= #0;
   inIdentifier:= false;
   inNumber:= false;
   inPixel:= false;
@@ -203,13 +219,14 @@ begin
   isBoolean:= false;
   isNumber:= false;
   isPixel := false;
+  isUndefined := false;
   startIdentifier:= 1; //initialize
   notConstant:= false;
   while cur <= length(expr) do
   begin
-    if inQuote then
+    if inQuote<>#0 then
     begin
-      if expr[cur] = StringDelimiter then inQuote := false else
+      if expr[cur] = inQuote then inQuote := #0 else
       if expr[cur] in[#13,#10] then
       begin
         errors += [ieEndingQuoteNotFound];
@@ -241,9 +258,9 @@ begin
           dec(inBracket);
           if inBracket < 0 then errors += [ieTooManyClosingBrackets];
         end else
-        if expr[cur] = StringDelimiter then
+        if expr[cur] in StringDelimiters then
         begin
-          inQuote := true;
+          inQuote := expr[cur];
           if inBracket = 0 then isString:= true;
         end else
         if expr[cur] in IdentifierCharStart then
@@ -273,10 +290,14 @@ begin
   if inNumber then inNumber:= false;
   if inPixel then inPixel := false;
   if inIdentifier then CheckIdentifier;
-  if inQuote then errors += [ieEndingQuoteNotFound];
+  if inQuote<>#0 then errors += [ieEndingQuoteNotFound];
   if inBracket > 0 then errors += [ieClosingBracketNotFound];
   if notConstant then errors += [ieConstantExpressionExpected];
   valueStr := Trim(copy(expr,start,cur-start));
+  if isUndefined then
+  begin
+    result.valueType := svtUndefined;
+  end else
   if isString then
   begin
     errors := errors + TryScriptUnquote(valueStr, unquotedStr);
@@ -364,6 +385,11 @@ begin
   svtPixel: result := svtPixList;
   svtString: result := svtStrList;
   svtObject: result := svtObjectList;
+  svtUndefined:
+    begin
+      include(errors, ieUnknownListType);
+      result := svtUndefined;
+    end
   else
     result := svtUndefined;
   end;
@@ -387,5 +413,18 @@ begin
     result := BGRA(AValue,AValue,AValue,255);
 end;
 
+function InterpretationErrorsToStr(AErrors: TInterpretationErrors): string;
+var
+  e: TInterpretationError;
+begin
+  result := '';
+  for e := low(TInterpretationError) to high(TInterpretationError) do
+    if e in AErrors then
+    begin
+      if result <> '' then result += ', ';
+      result += InterpretationErrorToStr[e];
+    end;
+end;
+
 end.
 

二进制
lazpaintscripts/__pycache__/header.cpython-36.pyc


二进制
lazpaintscripts/__pycache__/lazpaint.cpython-36.pyc


二进制
lazpaintscripts/__pycache__/lazpaint_colors.cpython-36.pyc


二进制
lazpaintscripts/__pycache__/lazpaint_command.cpython-36.pyc


二进制
lazpaintscripts/__pycache__/test.cpython-36.pyc


+ 57 - 0
lazpaintscripts/lazpaint.py

@@ -0,0 +1,57 @@
+from lazpaint_colors import *
+from lazpaint_command import command
+
+DM_DRAW = "dmDrawWithTransparency"
+DM_LINEAR = "dmLinearBlend"
+DM_SET = "dmSet"
+DM_SET_EXCEPT_TRANSPARENT = "dmSetExceptTransparent"
+DM_XOR = "dmXor"
+
+def file_new(width, height, color=TRANSPARENT, ignore_modified=False):
+  command("FileNew", Width=width, Height=height, BackColor=color, IgnoreModified=ignore_modified)
+
+def file_open(file_name=None, ignore_modified=False):
+  command("FileOpen", FileName=file_name, IgnoreModified=ignore_modified)
+
+def file_save(skip_options=False):
+  command("FileSave", SkipOptions=skip_options)
+
+def file_save_as(file_name=None, validate=False, skip_options=False):
+  command("FileSaveAs", FileName=file_name, Validate=validate, SkipOptions=skip_options) 
+
+def file_reload(ignore_modified=False):
+  command("FileReload", IgnoreModified=ignore_modified)
+
+def get_file_name():
+  return command("GetFileName?") 
+
+def put_image(x, y, image, mode=DM_DRAW, opacity=255):
+  height = len(image)
+  if height == 0: return
+  width = max([len(scanline) for scanline in image])
+  flattened = ""
+  for scanline in image:
+    flattened += "".join([str(color) for color in scanline]) + "00000000" * (width - len(scanline))
+  command("PutImage", X=x, Y=y, Width=width, Height=height, Data=flattened, Mode=mode, Opacity=opacity)
+
+def get_pixel(x, y):
+  return str_to_RGBA(command("GetPixel?", X=x, Y=y))
+
+def layer_fill(color, mode=DM_DRAW):
+  command("LayerFill", Color=color, Mode=mode)
+
+def get_image_width():
+  return command("GetImageWidth?")
+
+def get_image_height():
+  return command("GetImageHeight?")
+
+def show_message(message):
+  command("ShowMessage?", Message=message)
+
+def get_layer_count():
+  return command("GetLayerCount?")
+
+if __name__ == "__main__":
+  show_message("This is the script library.")
+

+ 46 - 0
lazpaintscripts/lazpaint_colors.py

@@ -0,0 +1,46 @@
+import collections
+
+CustomRGBA = collections.namedtuple("RGBA", "red, green, blue, alpha")
+class RGBA(CustomRGBA):
+  def __repr__(self):
+    if self.alpha != 255: 
+      return '#{:02X}{:02X}{:02X}{:02X}'.format(self.red,self.green,self.blue,self.alpha) 
+    else:
+      return '#{:02X}{:02X}{:02X}'.format(self.red,self.green,self.blue) 
+  def __str__(self):
+    return '{:02X}{:02X}{:02X}{:02X}'.format(self.red,self.green,self.blue,self.alpha)
+
+def RGB(red,green,blue):
+  return RGBA(red,green,blue,255)
+
+def str_to_RGBA(s):
+  if s[0:1] == "#":
+    s = s[1:]
+  if len(s) == 6:
+    return RGBA(int(s[0:2],16), int(s[2:4],16), int(s[4:6],16), 255)
+  elif len(s) == 8:
+    return RGBA(int(s[0:2],16), int(s[2:4],16), int(s[4:6],16), int(s[6:8],16))
+  else:
+    raise ValueError("Invalid color string")
+
+TRANSPARENT = RGBA(0,0,0,0)
+
+#VGA color names
+BLACK = RGB(0,0,0)
+BLUE = RGB(0,0,255)
+LIME = RGB(0,255,0)
+AQUA = RGB(0,255,255)
+RED = RGB(255,0,0)
+FUCHSIA = RGB(255,0,255)
+ORANGE = RGB(255,165,0)
+YELLOW = RGB(255,255,0)
+WHITE = RGB(255,255,255)
+GRAY = RGB(128,128,128)
+NAVY = RGB(0,0,128)
+GREEN = RGB(0,128,0)
+TEAL = RGB(0,128,128)
+MAROON = RGB(128,0,0)
+PURPLE = RGB(128,0,128)
+OLIVE = RGB(128,128,0)
+SILVER = RGB(192,192,192)
+

+ 18 - 0
lazpaintscripts/lazpaint_command.py

@@ -0,0 +1,18 @@
+import ast
+
+# tells LazPaint it is a script, we are going to send commands
+print("LazPaint script\t")
+# wait for LazPaint response
+if input('') != chr(27) + 'LazPaint': 
+  exit()
+
+# sends a command to LazPaint
+def command(command, **keywords):
+  if keywords is None:
+    print(chr(27) + command)
+  else:
+    print(chr(27) + command + chr(29) + str(keywords))
+  if command[-1] == '?':
+    return ast.literal_eval(input(''))
+  else:
+    return

+ 11 - 0
lazpaintscripts/test_file.py

@@ -0,0 +1,11 @@
+from lazpaint import *
+
+file_new(100, 100, RED)
+file_save_as("script_test_file.png", skip_options=True)
+file_name = get_file_name() 
+file_new(100, 100, LIME)
+file_save_as(file_name, validate=True, skip_options=True)
+layer_fill(BLUE)
+file_reload()
+layer_fill(PURPLE)
+file_save(skip_options=True)

+ 13 - 0
lazpaintscripts/test_put_image.py

@@ -0,0 +1,13 @@
+from lazpaint import *
+
+width = 256
+height = 256
+file_new(width, height)
+layer_fill(WHITE)
+image = []
+for y in range(height):
+  scanline = [RGB(0,x,y) for x in range(width)]
+  image.append(scanline)
+
+put_image(0, 0, image, DM_SET)
+