Kaynağa Gözat

basic support for python scripts

circular17 5 yıl önce
ebeveyn
işleme
0ea1d53d09

+ 3 - 3
lazpaint/dialog/usaveoption.pas

@@ -106,7 +106,7 @@ type
     property PngStreamNeeded: boolean read GetPngStreamNeeded;
     property PngStreamNeeded: boolean read GetPngStreamNeeded;
   end;
   end;
 
 
-function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string): boolean;
+function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean;
 
 
 implementation
 implementation
 
 
@@ -114,11 +114,11 @@ uses UGraph, FPWriteJPEG, UResourceStrings, FPWriteBMP, BMPcomn,
   UMySLV, BGRAWriteBmpMioMap, BGRADithering, UFileSystem, LCScaleDPI,
   UMySLV, BGRAWriteBmpMioMap, BGRADithering, UFileSystem, LCScaleDPI,
   BGRAThumbnail, BGRAIconCursor, BGRAWinResource;
   BGRAThumbnail, BGRAIconCursor, BGRAWinResource;
 
 
-function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string): boolean;
+function ShowSaveOptionDialog(AInstance: TLazPaintCustomInstance; AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean;
 var f: TFSaveOption;
 var f: TFSaveOption;
 begin
 begin
   result := false;
   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
   begin
     f := TFSaveOption.Create(nil);
     f := TFSaveOption.Create(nil);
     try
     try

+ 172 - 0
lazpaint/image/uimageaction.pas

@@ -21,6 +21,8 @@ type
     procedure ChooseTool(ATool: TPaintToolType);
     procedure ChooseTool(ATool: TPaintToolType);
     procedure RegisterScripts(ARegister: Boolean);
     procedure RegisterScripts(ARegister: Boolean);
     function GenericScriptFunction(AVars: TVariableSet): TScriptResult;
     function GenericScriptFunction(AVars: TVariableSet): TScriptResult;
+    function ScriptPutImage(AVars: TVariableSet): TScriptResult;
+    function ScriptLayerFill(AVars: TVariableSet): TScriptResult;
     procedure ReleaseSelection;
     procedure ReleaseSelection;
   public
   public
     constructor Create(AInstance: TLazPaintCustomInstance);
     constructor Create(AInstance: TLazPaintCustomInstance);
@@ -61,6 +63,9 @@ type
     procedure RemoveLayer;
     procedure RemoveLayer;
     procedure EditSelection(ACallback: TModifyImageCallback);
     procedure EditSelection(ACallback: TModifyImageCallback);
     procedure Import3DObject(AFilenameUTF8: string);
     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 TryAddLayerFromFile(AFilenameUTF8: string; ALoadedImage: TBGRABitmap = nil): boolean;
     function AddLayerFromBitmap(ABitmap: TBGRABitmap; AName: string): boolean;
     function AddLayerFromBitmap(ABitmap: TBGRABitmap; AName: string): boolean;
     function AddLayerFromOriginal(AOriginal: TBGRALayerCustomOriginal; AName: string): boolean;
     function AddLayerFromOriginal(AOriginal: TBGRALayerCustomOriginal; AName: string): boolean;
@@ -138,6 +143,12 @@ begin
   Scripting.RegisterScriptFunction('LayerRasterize',@GenericScriptFunction,ARegister);
   Scripting.RegisterScriptFunction('LayerRasterize',@GenericScriptFunction,ARegister);
   Scripting.RegisterScriptFunction('LayerMergeOver',@GenericScriptFunction,ARegister);
   Scripting.RegisterScriptFunction('LayerMergeOver',@GenericScriptFunction,ARegister);
   Scripting.RegisterScriptFunction('LayerRemoveCurrent',@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;
 end;
 
 
 constructor TImageActions.Create(AInstance: TLazPaintCustomInstance);
 constructor TImageActions.Create(AInstance: TLazPaintCustomInstance);
@@ -192,9 +203,116 @@ begin
   if f = 'LayerRasterize' then RasterizeLayer else
   if f = 'LayerRasterize' then RasterizeLayer else
   if f = 'LayerMergeOver' then MergeLayerOver else
   if f = 'LayerMergeOver' then MergeLayerOver else
   if f = 'LayerRemoveCurrent' then RemoveLayer 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;
     result := srFunctionNotDefined;
 end;
 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;
 procedure TImageActions.ClearAlpha;
 var c: TBGRAPixel;
 var c: TBGRAPixel;
     n: integer;
     n: integer;
@@ -324,6 +442,60 @@ begin
   end;
   end;
 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;
 function TImageActions.LoadSelection(AFilenameUTF8: string; ALoadedImage: PImageEntry = nil): boolean;
 var
 var
   newSelection: TBGRABitmap;
   newSelection: TBGRABitmap;

+ 11 - 1
lazpaint/lazpaint.lpi

@@ -342,7 +342,7 @@
         <PackageName Value="LCL"/>
         <PackageName Value="LCL"/>
       </Item5>
       </Item5>
     </RequiredPackages>
     </RequiredPackages>
-    <Units Count="100">
+    <Units Count="102">
       <Unit0>
       <Unit0>
         <Filename Value="lazpaint.lpr"/>
         <Filename Value="lazpaint.lpr"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
@@ -933,6 +933,16 @@
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="URaw"/>
         <UnitName Value="URaw"/>
       </Unit99>
       </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>
     </Units>
   </ProjectOptions>
   </ProjectOptions>
   <CompilerOptions>
   <CompilerOptions>

+ 1 - 1
lazpaint/lazpaint.lpr

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

+ 3 - 2
lazpaint/lazpaintdialogs.inc

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

+ 95 - 5
lazpaint/lazpaintinstance.pas

@@ -14,7 +14,8 @@ uses
   ucolorintensity, ushiftcolors, ucolorize, uadjustcurves,
   ucolorintensity, ushiftcolors, ucolorize, uadjustcurves,
   ucustomblur, uimagelist,
   ucustomblur, uimagelist,
 
 
-  ULoading, UImage, UTool, uconfig, IniFiles, uresourcestrings, uscripting;
+  ULoading, UImage, UTool, uconfig, IniFiles, uresourcestrings, uscripting,
+  UScriptType;
 
 
 const
 const
   MaxToolPopupShowCount = 3;
   MaxToolPopupShowCount = 3;
@@ -41,6 +42,9 @@ type
     function ScriptImageResample(AParams: TVariableSet): TScriptResult;
     function ScriptImageResample(AParams: TVariableSet): TScriptResult;
     procedure SelectionInstanceOnRun(AInstance: TLazPaintCustomInstance);
     procedure SelectionInstanceOnRun(AInstance: TLazPaintCustomInstance);
     procedure ToolColorChanged(Sender: TObject);
     procedure ToolColorChanged(Sender: TObject);
+    procedure PythonScriptCommand({%H-}ASender: TObject; ACommand, AParam: UTF8String; out
+      AResult: UTF8String);
+    function ScriptShowMessage(AVars: TVariableSet): TScriptResult;
 
 
   protected
   protected
     InColorFromFChooseColor: boolean;
     InColorFromFChooseColor: boolean;
@@ -155,9 +159,10 @@ type
     procedure NotifyImageChangeCompletely(RepaintNow: boolean); override;
     procedure NotifyImageChangeCompletely(RepaintNow: boolean); override;
     function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; override;
     function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; override;
     function ExecuteFilter(filter: TPictureFilter; skipDialog: boolean = false): boolean; override;
     function ExecuteFilter(filter: TPictureFilter; skipDialog: boolean = false): boolean; override;
+    function RunScript(AFilename: string): boolean; override;
     procedure ColorFromFChooseColor; override;
     procedure ColorFromFChooseColor; override;
     procedure ColorToFChooseColor; 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 ShowColorIntensityDlg(AParameters: TVariableSet): boolean; override;
     function ShowColorLightnessDlg(AParameters: TVariableSet): boolean; override;
     function ShowColorLightnessDlg(AParameters: TVariableSet): boolean; override;
     function ShowShiftColorsDlg(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,
      UImageAction, USharpen, uposterize, UPhongFilter, UFilterFunction,
      uprint, USaveOption, UFormRain,
      uprint, USaveOption, UFormRain,
 
 
-     ugraph, LCScaleDPI, ucommandline, uabout;
+     ugraph, LCScaleDPI, ucommandline, uabout, UPython;
 
 
 { TLazPaintInstance }
 { TLazPaintInstance }
 
 
@@ -280,6 +285,7 @@ begin
   ScriptContext.RegisterScriptFunction('ColorLightness',@ScriptColorLightness,ARegister);
   ScriptContext.RegisterScriptFunction('ColorLightness',@ScriptColorLightness,ARegister);
   ScriptContext.RegisterScriptFunction('ColorShiftColors',@ScriptColorShiftColors,ARegister);
   ScriptContext.RegisterScriptFunction('ColorShiftColors',@ScriptColorShiftColors,ARegister);
   ScriptContext.RegisterScriptFunction('ColorIntensity',@ScriptColorIntensity,ARegister);
   ScriptContext.RegisterScriptFunction('ColorIntensity',@ScriptColorIntensity,ARegister);
+  ScriptContext.RegisterScriptFunction('ShowMessage',@ScriptShowMessage,ARegister);
 end;
 end;
 
 
 procedure TLazPaintInstance.Init(AEmbedded: boolean);
 procedure TLazPaintInstance.Init(AEmbedded: boolean);
@@ -566,6 +572,61 @@ begin
     result := false;
     result := false;
 end;
 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);
 procedure TLazPaintInstance.OnLayeredBitmapLoadStartHandler(AFilenameUTF8: string);
 begin
 begin
   if FLoadingLayers = nil then
   if FLoadingLayers = nil then
@@ -1214,6 +1275,35 @@ begin
   vars.Free;
   vars.Free;
 end;
 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;
 procedure TLazPaintInstance.ColorFromFChooseColor;
 begin
 begin
   FormsNeeded;
   FormsNeeded;
@@ -1237,9 +1327,9 @@ begin
 end;
 end;
 
 
 function TLazPaintInstance.ShowSaveOptionDlg(AParameters: TVariableSet;
 function TLazPaintInstance.ShowSaveOptionDlg(AParameters: TVariableSet;
-  AOutputFilenameUTF8: string): boolean;
+  AOutputFilenameUTF8: string; ASkipOptions: boolean): boolean;
 begin
 begin
-  result := USaveOption.ShowSaveOptionDialog(self,AOutputFilenameUTF8);
+  result := USaveOption.ShowSaveOptionDialog(self,AOutputFilenameUTF8,ASkipOptions);
 end;
 end;
 
 
 procedure TLazPaintInstance.MoveToolboxTo(X, Y: integer);
 procedure TLazPaintInstance.MoveToolboxTo(X, Y: integer);

+ 5 - 0
lazpaint/lazpaintmainform.lfm

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

+ 84 - 29
lazpaint/lazpaintmainform.pas

@@ -28,6 +28,7 @@ type
   { TFMain }
   { TFMain }
 
 
   TFMain = class(TForm)
   TFMain = class(TForm)
+    FileRunScript: TAction;
     EditShapeToCurve: TAction;
     EditShapeToCurve: TAction;
     EditShapeAlignBottom: TAction;
     EditShapeAlignBottom: TAction;
     EditShapeCenterVertically: TAction;
     EditShapeCenterVertically: TAction;
@@ -471,6 +472,7 @@ type
     procedure FileImport3DUpdate(Sender: TObject);
     procedure FileImport3DUpdate(Sender: TObject);
     procedure FilePrintExecute(Sender: TObject);
     procedure FilePrintExecute(Sender: TObject);
     procedure FileRememberSaveFormatExecute(Sender: TObject);
     procedure FileRememberSaveFormatExecute(Sender: TObject);
+    procedure FileRunScriptExecute(Sender: TObject);
     procedure FileSaveAsInSameFolderExecute(Sender: TObject);
     procedure FileSaveAsInSameFolderExecute(Sender: TObject);
     procedure FileSaveAsInSameFolderUpdate(Sender: TObject);
     procedure FileSaveAsInSameFolderUpdate(Sender: TObject);
     procedure FileUseImageBrowserExecute(Sender: TObject);
     procedure FileUseImageBrowserExecute(Sender: TObject);
@@ -811,6 +813,7 @@ type
     function ScriptFileOpen(AVars: TVariableSet): TScriptResult;
     function ScriptFileOpen(AVars: TVariableSet): TScriptResult;
     function ScriptFileSaveAs(AVars: TVariableSet): TScriptResult;
     function ScriptFileSaveAs(AVars: TVariableSet): TScriptResult;
     function ScriptFileSave({%H-}AVars: TVariableSet): TScriptResult;
     function ScriptFileSave({%H-}AVars: TVariableSet): TScriptResult;
+    function ScriptFileGetFilename(AVars: TVariableSet): TScriptResult;
     function ScriptFileReload({%H-}AVars: TVariableSet): TScriptResult;
     function ScriptFileReload({%H-}AVars: TVariableSet): TScriptResult;
     function ScriptFileLoadSelection(AVars: TVariableSet): TScriptResult;
     function ScriptFileLoadSelection(AVars: TVariableSet): TScriptResult;
     function ScriptFileSaveSelectionAs(AVars: TVariableSet): TScriptResult;
     function ScriptFileSaveSelectionAs(AVars: TVariableSet): TScriptResult;
@@ -863,7 +866,7 @@ implementation
 uses LCLIntf, BGRAUTF8, ugraph, math, umac, uclipboard, ucursors,
 uses LCLIntf, BGRAUTF8, ugraph, math, umac, uclipboard, ucursors,
    ufilters, ULoadImage, ULoading, UFileExtensions, UBrushType,
    ufilters, ULoadImage, ULoading, UFileExtensions, UBrushType,
    ugeometricbrush, UPreviewDialog, UQuestion, BGRALayerOriginal,
    ugeometricbrush, UPreviewDialog, UQuestion, BGRALayerOriginal,
-   BGRATransform, LCVectorPolyShapes, URaw;
+   BGRATransform, LCVectorPolyShapes, URaw, UFileSystem;
 
 
 const PenWidthFactor = 10;
 const PenWidthFactor = 10;
 
 
@@ -1128,6 +1131,7 @@ begin
   Scripting.RegisterScriptFunction('FileOpen',@ScriptFileOpen,ARegister);
   Scripting.RegisterScriptFunction('FileOpen',@ScriptFileOpen,ARegister);
   Scripting.RegisterScriptFunction('FileSaveAs',@ScriptFileSaveAs,ARegister);
   Scripting.RegisterScriptFunction('FileSaveAs',@ScriptFileSaveAs,ARegister);
   Scripting.RegisterScriptFunction('FileSave',@ScriptFileSave,ARegister);
   Scripting.RegisterScriptFunction('FileSave',@ScriptFileSave,ARegister);
+  Scripting.RegisterScriptFunction('GetFileName',@ScriptFileGetFilename,ARegister);
   Scripting.RegisterScriptFunction('FileReload',@ScriptFileReload,ARegister);
   Scripting.RegisterScriptFunction('FileReload',@ScriptFileReload,ARegister);
   Scripting.RegisterScriptFunction('FileLoadSelection',@ScriptFileLoadSelection,ARegister);
   Scripting.RegisterScriptFunction('FileLoadSelection',@ScriptFileLoadSelection,ARegister);
   Scripting.RegisterScriptFunction('FileSaveSelectionAs',@ScriptFileSaveSelectionAs,ARegister);
   Scripting.RegisterScriptFunction('FileSaveSelectionAs',@ScriptFileSaveSelectionAs,ARegister);
@@ -1275,7 +1279,7 @@ begin
   loadedImage := TImageEntry.Empty;
   loadedImage := TImageEntry.Empty;
   try
   try
     topInfo.defined:= false;
     topInfo.defined:= false;
-    if Image.IsFileModified then
+    if Image.IsFileModified and not AVars.Booleans['IgnoreModified'] then
     begin
     begin
       topInfo := FLazPaintInstance.HideTopmost;
       topInfo := FLazPaintInstance.HideTopmost;
       case LazPaintInstance.SaveQuestion(rsOpen) of
       case LazPaintInstance.SaveQuestion(rsOpen) of
@@ -1420,7 +1424,7 @@ function TFMain.ScriptFileSaveAs(AVars: TVariableSet): TScriptResult;
         end
         end
         else
         else
         begin
         begin
-          if not LazPaintInstance.ShowSaveOptionDlg(nil,filename) then
+          if not LazPaintInstance.ShowSaveOptionDlg(nil,filename,AVars.Booleans['SkipOptions']) then
             result := srCancelledByUser
             result := srCancelledByUser
           else
           else
             saved := true;
             saved := true;
@@ -1452,12 +1456,23 @@ var filename: string;
     vFileName: TScriptVariableReference;
     vFileName: TScriptVariableReference;
     topMost: TTopMostInfo;
     topMost: TTopMostInfo;
     defaultExt: string;
     defaultExt: string;
+    initialDir: string;
 begin
 begin
   AskMergeSelection(rsSave);
   AskMergeSelection(rsSave);
   filename := ExtractFileName(Image.CurrentFilenameUTF8);
   filename := ExtractFileName(Image.CurrentFilenameUTF8);
   vFileName := AVars.GetVariable('FileName');
   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 filename = '' then filename := rsNoName;
+  if initialDir = '' then initialDir:= FSaveInitialDir;
   if SavePictureDialog1.FilterIndex > 1 then
   if SavePictureDialog1.FilterIndex > 1 then
     filename := ApplySelectedFilterExtension(filename,SavePictureDialog1.Filter,SavePictureDialog1.FilterIndex);
     filename := ApplySelectedFilterExtension(filename,SavePictureDialog1.Filter,SavePictureDialog1.FilterIndex);
   if not Image.AbleToSaveAsUTF8(filename) then
   if not Image.AbleToSaveAsUTF8(filename) then
@@ -1466,7 +1481,6 @@ begin
     filename := ChangeFileExt(Filename,'');
     filename := ChangeFileExt(Filename,'');
   end;
   end;
   SavePictureDialog1.FileName := filename;
   SavePictureDialog1.FileName := filename;
-  topMost := LazPaintInstance.HideTopmost;
 
 
   case SuggestImageFormat(Image.CurrentFilenameUTF8) of
   case SuggestImageFormat(Image.CurrentFilenameUTF8) of
   ifCur: defaultExt := '.cur';
   ifCur: defaultExt := '.cur';
@@ -1478,36 +1492,49 @@ begin
     end;
     end;
   end;
   end;
 
 
-  if UseImageBrowser then
+  if AVars.Booleans['Validate'] and (initialDir <> '') then
   begin
   begin
-    if not assigned(FSaveImage) then
+    if FileManager.FileExists(initialDir+filename) then
     begin
     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;
     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
   end else
   begin
   begin
-    SavePictureDialog1.DefaultExt := defaultExt;
-    SavePictureDialog1.InitialDir:= FSaveInitialDir;
-    if SavePictureDialog1.Execute then
+    topMost := LazPaintInstance.HideTopmost;
+    if UseImageBrowser then
     begin
     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
     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;
   end;
-  LazPaintInstance.ShowTopmost(topMost);
 end;
 end;
 
 
 function TFMain.ScriptFileSave(AVars: TVariableSet): TScriptResult;
 function TFMain.ScriptFileSave(AVars: TVariableSet): TScriptResult;
@@ -1524,7 +1551,7 @@ begin
         end
         end
         else
         else
         begin
         begin
-          if LazPaintInstance.ShowSaveOptionDlg(nil,Image.currentFilenameUTF8) then
+          if LazPaintInstance.ShowSaveOptionDlg(nil,Image.currentFilenameUTF8,AVars.Booleans['SkipOptions']) then
             result := srOk
             result := srOk
           else
           else
             result := srCancelledByUser;
             result := srCancelledByUser;
@@ -1540,6 +1567,12 @@ begin
     end;
     end;
 end;
 end;
 
 
+function TFMain.ScriptFileGetFilename(AVars: TVariableSet): TScriptResult;
+begin
+  AVars.Strings['Result'] := Image.currentFilenameUTF8;
+  result := srOk;
+end;
+
 procedure TFMain.FileSaveUpdate(Sender: TObject);
 procedure TFMain.FileSaveUpdate(Sender: TObject);
 begin
 begin
    FileSave.Enabled := image.IsFileModified;
    FileSave.Enabled := image.IsFileModified;
@@ -1807,7 +1840,7 @@ begin
     result := srOk;
     result := srOk;
     exit;
     exit;
   end;
   end;
-  if Image.IsFileModified then
+  if Image.IsFileModified and not AVars.Booleans['IgnoreModified'] then
   begin
   begin
     topmostInfo := LazPaintInstance.HideTopmost;
     topmostInfo := LazPaintInstance.HideTopmost;
     res := MessageDlg(rsReload,rsReloadChanged,mtWarning,mbYesNo,0);
     res := MessageDlg(rsReload,rsReloadChanged,mtWarning,mbYesNo,0);
@@ -3132,6 +3165,28 @@ begin
   Config.SetRememberSaveFormat(FileRememberSaveFormat.Checked);
   Config.SetRememberSaveFormat(FileRememberSaveFormat.Checked);
 end;
 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);
 procedure TFMain.FileSaveAsInSameFolderExecute(Sender: TObject);
 var dir: string;
 var dir: string;
 begin
 begin

+ 2 - 1
lazpaint/lazpainttype.pas

@@ -231,9 +231,10 @@ type
     procedure NotifyStackChange; virtual; abstract;
     procedure NotifyStackChange; virtual; abstract;
     function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; virtual; abstract;
     function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; virtual; abstract;
     function ExecuteFilter(filter: TPictureFilter; skipDialog: 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 ColorFromFChooseColor; virtual; abstract;
     procedure ColorToFChooseColor; 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 ShowColorIntensityDlg(AParameters: TVariableSet): boolean; virtual; abstract;
     function ShowColorLightnessDlg(AParameters: TVariableSet): boolean; virtual; abstract;
     function ShowColorLightnessDlg(AParameters: TVariableSet): boolean; virtual; abstract;
     function ShowShiftColorsDlg(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))+')');
     raise exception.create('Invalid quoted string (error '+inttostr(integer(errors))+')');
 end;
 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;
 function TryScriptUnquote(const S: String; out unquotedS: string): TInterpretationErrors;
 var curPos,quoteStart,idStart: integer; idStr, charCodeStr: string;
 var curPos,quoteStart,idStart: integer; idStr, charCodeStr: string;
   charFuncStep: (fsNone, fsWaitOpenBracket, fsCharCodeParam, fsWaitCloseBraket);
   charFuncStep: (fsNone, fsWaitOpenBracket, fsCharCodeParam, fsWaitCloseBraket);
+  escaping: Boolean;
 
 
   procedure AppendChar;
   procedure AppendChar;
   var errPos: integer;
   var errPos: integer;
@@ -74,29 +175,28 @@ begin
           charCodeStr := charCodeStr+s[CurPos];
           charCodeStr := charCodeStr+s[CurPos];
       end;
       end;
     end else
     end else
-    if s[curPos] = StringDelimiter then
+    if s[curPos] in StringDelimiters then
     begin
     begin
       quoteStart := curPos;
       quoteStart := curPos;
+      escaping := false;
       inc(curPos);
       inc(curPos);
       while true do
       while true do
       begin
       begin
         if curPos <= length(s) then
         if curPos <= length(s) then
         begin
         begin
-          if s[curPos]=StringDelimiter then
+          if not escaping then
           begin
           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
             else
+            if s[curPos]=s[quoteStart] then
             begin
             begin
-              quoteStart := curPos-1;
+              unquotedS:= unquotedS+UnescapeString(copy(s,quoteStart+1,curPos-quoteStart-1));
+              inc(curPos);
               break;
               break;
             end;
             end;
-          end;
+          end else
+            escaping := false;
           inc(curPos);
           inc(curPos);
         end else
         end else
         begin
         begin
@@ -125,65 +225,47 @@ end;
 
 
 function ScriptQuote(const S: string): string;
 function ScriptQuote(const S: string): string;
 const
 const
-  NonPrintableChars = [#0,#7..#13,#26,#27];
+  StringDelimiter = StringDelimiter1;
+  EscapeChars = [#0,#7..#13,#26,#27,'\',StringDelimiter];
 var i, j, count: integer;
 var i, j, count: integer;
   inQuote: boolean;
   inQuote: boolean;
 
 
-  procedure EnterQuote;
-  begin
-    if not inQuote then
-    begin
-      If result <> '' then result := result + ' & ';
-      result := result+StringDelimiter;
-      inQuote := true;
-    end;
-  end;
-
   procedure FlushChars;
   procedure FlushChars;
   var NbFlush: integer;
   var NbFlush: integer;
   begin
   begin
     NbFlush := i - j - 1;
     NbFlush := i - j - 1;
     if NbFlush <= 0 then exit;
     if NbFlush <= 0 then exit;
-    EnterQuote;
     result := result + copy(S, 1 + j, NbFlush);
     result := result + copy(S, 1 + j, NbFlush);
     j := i;
     j := i;
   end;
   end;
 
 
-  procedure LeaveQuote;
-  begin
-    if inQuote then
-    begin
-      result := result+StringDelimiter;
-      inQuote := false;
-    end;
-  end;
-
 begin
 begin
-  result := '';
+  result := StringDelimiter;
   inQuote := false;
   inQuote := false;
   count := length(s);
   count := length(s);
   i := 0;
   i := 0;
   j := 0;
   j := 0;
-  while i < count do begin
+  while i < count do
+  begin
      i := i + 1;
      i := i + 1;
-     if s[i] in NonPrintableChars then
+     if s[i] in EscapeChars then
      begin
      begin
        FlushChars;
        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;
        j := i;
      end;
      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;
   end;
-  LeaveQuote;
-  if result = '' then result := StringDelimiter+StringDelimiter;
+  if i <> j then
+    result := result + copy(S, 1 + j, i - j);
+  result += StringDelimiter;
 end;
 end;

+ 12 - 0
lazpaint/uconfig.pas

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

+ 1 - 1
lazpaint/umenu.pas

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

+ 55 - 16
lazpaint/uscripttype.pas

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

BIN
lazpaintscripts/__pycache__/header.cpython-36.pyc


BIN
lazpaintscripts/__pycache__/lazpaint.cpython-36.pyc


BIN
lazpaintscripts/__pycache__/lazpaint_colors.cpython-36.pyc


BIN
lazpaintscripts/__pycache__/lazpaint_command.cpython-36.pyc


BIN
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)
+