Exported the 'whole' TMufasaBitmap class to PascalScript. Changed rev to 605.

2024-12-22 07:18:51 -05:00 · 2010-04-03 15:10:13 +02:00 · 2010-04-03 15:10:13 +02:00 · c918d95b1c
commit c918d95b1c
parent 5ce90afbd6
9 changed files with 130 additions and 48 deletions
--- a/Projects/SAMufasaGUI/extensionmanager.pas
+++ b/Projects/SAMufasaGUI/extensionmanager.pas
@ -149,6 +149,7 @@ begin
        if HookExists(HookName) then
          if ExecuteHook(HookName, Args, Result) <> 0 then
          begin
+            mDebugLn('Execute hook failed: Hookname: %s',[hookname]);
            // Not succesfull.
          end;
 end;
--- a/Projects/SAMufasaGUI/testunit.pas
+++ b/Projects/SAMufasaGUI/testunit.pas
@ -46,7 +46,7 @@ uses
  CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;

 const
-    SimbaVersion = 602;
+    SimbaVersion = 605;

 type

@ -382,7 +382,7 @@ type
    procedure CreateDefaultEnvironment;
    procedure LoadFormSettings;
    procedure SaveFormSettings;
-    procedure AddRecentFile(filename : string);
+    procedure AddRecentFile(const filename : string);
    procedure InitalizeTMThread(var Thread : TMThread);
    procedure HandleParameters;
    procedure OnSaveScript(const Filename : string);
@ -1161,7 +1161,7 @@ begin
  end;
 end;

-procedure TForm1.AddRecentFile(filename: string);
+procedure TForm1.AddRecentFile(const filename: string);
 var
  MaxRecentFiles : integer;
  Len,i : integer;
--- a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc
@ -82,7 +82,7 @@ end;

 procedure SetBitmapName(Bmp : integer; name : string); extdecl;
 begin;
-  CurrThread.Client.MBitmaps[Bmp].BmpName:= name;
+  CurrThread.Client.MBitmaps[Bmp].Name:= name;
 end;

 function CreateMirroredBitmap(Bmp : integer) : integer; extdecl;
@ -270,7 +270,7 @@ begin;
  result := CurrThread.Client.MBitmaps[Bitmap].CreateTMask;
 end;

-function FindMaskTolerance(mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; extdecl;
+function FindMaskTolerance(const mask: TMask; out x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; extdecl;
 begin;
  result := CurrThread.Client.MFinder.FindMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance);
 end;
--- a/Units/MMLAddon/PSInc/Wrappers/file.inc
+++ b/Units/MMLAddon/PSInc/Wrappers/file.inc
@ -21,17 +21,17 @@
    File.inc for the Mufasa Macro Library
 }

-function ps_CreateFile(Path: string): Integer; extdecl;
+function ps_CreateFile(const Path: string): Integer; extdecl;
 begin
  Result := CurrThread.Client.MFiles.CreateFile(Path);
 end;

-function ps_OpenFile(Path: string; Shared: Boolean): Integer; extdecl;
+function ps_OpenFile(const Path: string; Shared: Boolean): Integer; extdecl;
 begin
  Result := CurrThread.Client.MFiles.OpenFile(Path, Shared);
 end;

-function ps_RewriteFile(Path: string; Shared: Boolean): Integer; extdecl;
+function ps_RewriteFile(const Path: string; Shared: Boolean): Integer; extdecl;
 begin
  Result := CurrThread.Client.MFiles.RewriteFile(Path, Shared);
 end;
@ -81,7 +81,7 @@ begin
  result := CreateDir(directoryName);
 end;

-procedure ps_WriteINI(Section, KeyName, NewString, FileName: string);extdecl;
+procedure ps_WriteINI(const Section, KeyName, NewString, FileName: string);extdecl;
 var
  tempini : TIniFile;
 begin;
@ -90,7 +90,7 @@ begin;
  tempini.free;
 end;

-function ps_ReadINI(Section, KeyName, FileName: string): string;extdecl;
+function ps_ReadINI(const Section, KeyName, FileName: string): string;extdecl;
 var
  tempini : TIniFile;
 begin;
@ -99,7 +99,7 @@ begin;
  tempini.free;
 end;

-procedure ps_DeleteINI(Section, KeyName, FileName: string); extdecl;
+procedure ps_DeleteINI(const Section, KeyName, FileName: string); extdecl;
 var
  tempini : TIniFile;
 begin;
--- a/Units/MMLAddon/PSInc/psexportedmethods.inc
+++ b/Units/MMLAddon/PSInc/psexportedmethods.inc
@ -90,9 +90,9 @@ AddFunction(@IsTargetValid, 'function IsTargetValid: boolean;');

 {files}
 SetCurrSection('Files');
-AddFunction(@ps_CreateFile, 'function CreateFile(Path: string): Integer;');
-AddFunction(@ps_OpenFile, 'function OpenFile(Path: string; Shared: Boolean): Integer;');
-AddFunction(@ps_RewriteFile, 'function RewriteFile(Path: string; Shared: Boolean): Integer;');
+AddFunction(@ps_CreateFile, 'function CreateFile(const Path: string): Integer;');
+AddFunction(@ps_OpenFile, 'function OpenFile(const Path: string; Shared: Boolean): Integer;');
+AddFunction(@ps_RewriteFile, 'function RewriteFile(const Path: string; Shared: Boolean): Integer;');
 AddFunction(@ps_CloseFile, 'procedure CloseFile(FileNum: Integer);');
 AddFunction(@ps_EndOfFile, 'function EndOfFile(FileNum: Integer): Boolean;');
 AddFunction(@ps_FileSize, 'function FileSize(FileNum: Integer): LongInt;');
@ -100,12 +100,12 @@ AddFunction(@ps_ReadFileString, 'function ReadFileString(FileNum: Integer; var s
 AddFunction(@ps_WriteFileString, 'function WriteFileString(FileNum: Integer; s: string): Boolean;');
 AddFunction(@ps_SetFileCharPointer, 'function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;');
 AddFunction(@ps_FilePointerPos, 'function FilePointerPos(FileNum: Integer): Integer;');
-AddFunction(@ps_DirectoryExists,'function DirectoryExists( const DirectoryName : string ) : Boolean;');
-AddFunction(@ps_CreateDirectory,'function CreateDirectory( const DirectoryName : string) : boolean;');
-AddFunction(@ps_FileExists,'function FileExists ( const FileName : string ) : Boolean;');
-AddFunction(@ps_WriteINI,'procedure WriteINI(Section, KeyName, NewString, FileName: string);');
-AddFunction(@ps_ReadINI,'function ReadINI(Section, KeyName, FileName: string): string;');
-AddFunction(@ps_DeleteINI,'procedure DeleteINI(Section, KeyName, FileName: string);');
+AddFunction(@ps_DirectoryExists,'function DirectoryExists(const DirectoryName : string ) : Boolean;');
+AddFunction(@ps_CreateDirectory,'function CreateDirectory(const DirectoryName : string) : boolean;');
+AddFunction(@ps_FileExists,'function FileExists (const FileName : string ) : Boolean;');
+AddFunction(@ps_WriteINI,'procedure WriteINI(const Section, KeyName, NewString, FileName: string);');
+AddFunction(@ps_ReadINI,'function ReadINI(const Section, KeyName, FileName: string): string;');
+AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: string);');

 {other}
 SetCurrSection('Other');
@ -279,7 +279,7 @@ AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) :
 AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
 AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;');
 AddFunction(@CreateMaskFromBitmap,'function CreateMaskFromBitmap(Bitmap : integer) : TMask;');
-AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
+AddFunction(@FindMaskTolerance,'function FindMaskTolerance(const mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
 AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;');
 AddFunction(@FindDeformedBitmapToleranceIn,'function FindDeformedBitmapToleranceIn(bitmap: integer; var x,y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; var accuracy: Extended): Boolean;');
 AddFunction(@DrawTPABitmap,'procedure DrawTPABitmap(bitmap: integer; TPA: TPointArray; Color: integer);');
--- a/Units/MMLAddon/mmisc.pas
+++ b/Units/MMLAddon/mmisc.pas
@ -9,7 +9,7 @@ uses

 function DecompressBZip2(const input : TStream; const BlockSize : Cardinal = 4096) : TMemoryStream;
 function UnTar(const Input : TStream) : TStringArray;overload;
-function UnTar(const Input : TStream; outputdir : string; overwrite : boolean): boolean;overload;
+function UnTar(const Input : TStream;const outputdir : string; overwrite : boolean): boolean;overload;

 implementation

@ -63,7 +63,7 @@ begin;
  Tar.Free;
 end;

-function UnTar(const Input: TStream; outputdir: string; overwrite: boolean): boolean; overload;
+function UnTar(const Input: TStream; const outputdir: string; overwrite: boolean): boolean; overload;
 var
  Tar : TTarArchive;
  DirRec : TTarDirRec;
--- a/Units/MMLAddon/mmlpsthread.pas
+++ b/Units/MMLAddon/mmlpsthread.pas
@ -600,14 +600,44 @@ begin
 end;

 procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
+var
+  PSClass : TPSCompileTimeClass;
 begin
-  with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
+  PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap');
+  with PSClass do
  begin;
+    RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
+    RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
+    RegisterMethod('procedure FastSetPixel(x,y : integer; Color : TColor);');
+    RegisterMethod('procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);');
+    RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
+    RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
+    RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
+//      function FastGetPixels(TPA : TPointArray) : TIntegerArray;
+    RegisterMethod('procedure SetTransparentColor(Col : TColor);');
+    RegisterMethod('function GetTransparentColor : TColor;');
+    RegisterProperty('TransparentColorSet','Boolean',iptR);
+    RegisterMethod('procedure FastDrawClear(Color : TColor);');
+    RegisterMethod('procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);');
+    RegisterMethod('procedure FastReplaceColor(OldColor, NewColor: TColor);');
+    RegisterMethod('procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );');
+    RegisterMethod('procedure Desaturate(TargetBitmap : TMufasaBitmap);');
+    RegisterMethod('procedure GreyScale(TargetBitmap : TMufasaBitmap);');
+    RegisterMethod('procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer);');
+    RegisterMethod('procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);');
+    RegisterMethod('procedure Invert(TargetBitmap : TMufasaBitmap);');
+    RegisterMethod('procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);');
+    RegisterMethod('function Copy: TMufasaBitmap;');
+    RegisterMethod('function ToString : string;');
+    RegisterMethod('function CreateTMask : TMask;');
    RegisterMethod('constructor create');
    RegisterMethod('procedure Free');
    RegisterMethod('function SaveToFile(const FileName : string) :boolean;');
    RegisterMethod('procedure LoadFromFile(const FileName : string);');
+    RegisterProperty('Width','Integer',iptR);
+    RegisterProperty('Height','Integer',iptR);
    RegisterProperty('Index','Integer',iptR);
+    RegisterProperty('Name','String',iptRW);
  end;
 end;

@ -622,20 +652,51 @@ begin;
  CurrThread.Client.MBitmaps.FreeBMP(Self.Index);
 end;

-procedure MufasaBitmapIndex(self : TMufasaBitmap; var Index : integer);
-begin;
-  Index := self.Index;
-end;
+procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin;  Index := self.Index; end;
+procedure MBmp_Width_r(self : TMufasaBitmap; var Width : integer);begin;  Width := self.Width; end;
+procedure MBmp_Height_r(self : TMufasaBitmap; var Height : integer);begin;  Height := self.Height; end;
+procedure MBmp_Name_r(self : TMufasaBitmap; var Name : String);begin;  Name := self.Name; end;
+procedure MBmp_Name_w(self : TMufasaBitmap; const Name : String);begin; Self.name := name; end;
+procedure MBmp_TransColorSet_r(Self : TMufasaBitmap; var IsSet : boolean); begin IsSet := self.TransparentColorSet; end;

 procedure RIRegister_Mufasa(cl: TPSRuntimeClassImporter);
+var
+  PSClass : TPSRuntimeClass;
 begin;
-  with cl.Add(TMufasaBitmap) do
+  PSClass :=cl.Add(TMufasaBitmap);
+  with PSClass do
  begin
+    RegisterMethod(@TMufasaBitmap.SetSize,'SETSIZE');
+    RegisterMethod(@TMufasaBitmap.StretchResize,'STRETCHRESIZE');
+    RegisterMethod(@TMufasaBitmap.FastSetPixel,'FASTSETPIXEL');
+    RegisterMethod(@TMufasaBitmap.FastSetPixels,'FASTSETPIXELS');
+    RegisterMethod(@TMufasaBitmap.DrawATPA,'DRAWATPA');
+    RegisterMethod(@TMufasaBitmap.DrawTPA,'DRAWTPA');
+    RegisterMethod(@TMufasaBitmap.FastGetPixel,'FASTGETPIXEL');
+    RegisterMethod(@TMufasaBitmap.SetTransparentColor,'SETTRANSPARENTCOLOR');
+    RegisterMethod(@TMufasaBitmap.GetTransparentColor,'GETTRANSPARENTCOLOR');
+    RegisterMethod(@TMufasaBitmap.FastDrawClear,'FASTDRAWCLEAR');
+    RegisterMethod(@TMufasaBitmap.FastDrawTransparent,'FASTDRAWTRANSPARENT');
+    RegisterMethod(@TMufasaBitmap.FastReplaceColor,'FASTREPLACECOLOR');
+    RegisterMethod(@TMufasaBitmap.RotateBitmap,'ROTATEBITMAP');
+    RegisterMethod(@TMufasaBitmap.Desaturate,'DESATURATE');
+    RegisterMethod(@TMufasaBitmap.GreyScale,'GREYSCALE');
+    RegisterMethod(@TMufasaBitmap.Brightness,'BRIGHTNESS');
+    RegisterMethod(@TMufasaBitmap.Contrast,'CONTRAST');
+    RegisterMethod(@TMufasaBitmap.Invert,'INVERT');
+    RegisterMethod(@TMufasaBitmap.Posterize,'POSTERIZE');
+    RegisterMethod(@TMufasaBitmap.Copy, 'COPY');
+    RegisterMethod(@TMufasaBitmap.ToString,'TOSTRING');
+    RegisterMethod(@TMufasaBitmap.CreateTMask,'CREATETMASK');
+    RegisterPropertyHelper(@MBmp_TransColorSet_r,nil,'TRANSPARENTCOLORSET');
+    RegisterPropertyHelper(@MBmp_Index_r,nil,'INDEX');
+    RegisterPropertyHelper(@MBmp_Width_r,nil,'WIDTH');
+    RegisterPropertyHelper(@MBmp_Height_r,nil,'HEIGHT');
+    RegisterPropertyHelper(@MBmp_Name_r,@MBmp_Name_w,'NAME');
    RegisterConstructor(@CreateMufasaBitmap,'CREATE');
    RegisterMethod(@FreeMufasaBitmap,'FREE');
    RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
    RegisterMethod(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
-    RegisterPropertyHelper(@MufasaBitmapIndex,nil,'INDEX');
  end;
 end;

--- a/Units/MMLCore/bitmaps.pas
+++ b/Units/MMLCore/bitmaps.pas
@ -38,11 +38,12 @@ type
    TransparentColor : TRGB32;
    TransparentSet : boolean;
    FIndex : integer;
+    FName : string;
  public
    OnDestroy : procedure(Bitmap : TMufasaBitmap) of object;
-    FakeData : array of TRGB32;
+    //FakeData : array of TRGB32;
    FData : PRGB32;
-    BmpName : string; //Optional?
+    property Name : string read FName write FName;
    property Index : integer read FIndex write FIndex;
    procedure SetSize(AWidth,AHeight : integer);
    procedure StretchResize(AWidth,AHeight : integer);
@ -69,15 +70,16 @@ type
    procedure CopyClientToBitmap(MWindow : TObject;Resize : boolean; xs, ys, xe, ye: Integer);overload;
    procedure CopyClientToBitmap(MWindow : TObject;Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);overload;
    procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );
-    procedure Desaturate;overload;
    procedure Desaturate(TargetBitmap : TMufasaBitmap); overload;
+    procedure Desaturate;overload;
    procedure GreyScale(TargetBitmap : TMufasaBitmap);overload;
    procedure GreyScale;
-    procedure Brightness(br: integer);overload;
    procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer); overload;
-    procedure Contrast(co: Extended);overload;
+    procedure Brightness(br: integer);overload;
    procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);overload;
-    procedure Invert;
+    procedure Contrast(co: Extended);overload;
+    procedure Invert(TargetBitmap : TMufasaBitmap);overload;
+    procedure Invert;overload;
    procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload;
    procedure Posterize(Po : integer);overload;
    function Copy: TMufasaBitmap;
@ -369,7 +371,7 @@ function TMBitmaps.CreateBMPFromString(BmpName: string; width, height: integer;
  Data: string): integer;
 begin
  Result := Self.CreateBMPFromString(width,height,data);
-  Bmp[Result].BmpName:= BmpName;
+  Bmp[Result].Name:= BmpName;

 end;

@ -1028,6 +1030,24 @@ begin
  end;
 end;

+procedure TMufasaBitmap.Invert(TargetBitmap: TMufasaBitmap);
+var
+  I : integer;
+  PtrOld,PtrNew : PRGB32;
+begin
+  TargetBitmap.SetSize(w,h);
+  PtrOld := Self.FData;
+  PtrNew := TargetBitmap.FData;
+  for i := (h*w-1) downto 0 do
+  begin;
+    PtrNew^.r := not PtrOld^.r;
+    PtrNew^.g := not PtrOld^.g;
+    PtrNew^.b := not PtrOld^.b;
+    inc(ptrOld);
+    inc(PtrNew);
+  end;
+end;
+
 procedure TMufasaBitmap.Posterize(TargetBitmap: TMufasaBitmap; Po: integer);
 var
  I : integer;
@ -1127,10 +1147,10 @@ begin
  for i := 0 to BmpsCurr do
    if BmpArray[i] <> nil then
    begin;
-      if BmpArray[i].BmpName = '' then
+      if BmpArray[i].Name = '' then
        TClient(Client).Writeln(Format('BMP[%d] has not been freed in the script, freeing it now.',[i]))
      else
-        TClient(Client).Writeln(Format('BMP[%s] has not been freed in the script, freeing it now.',[BmpArray[i].BmpName]));
+        TClient(Client).Writeln(Format('BMP[%s] has not been freed in the script, freeing it now.',[BmpArray[i].Name]));
      FreeAndNil(BmpArray[i]);
    end;
  SetLength(BmpArray,0);
@ -1206,7 +1226,7 @@ end;
 constructor TMufasaBitmap.Create;
 begin
  inherited Create;
-  BmpName:= '';
+  Name:= '';
  TransparentSet:= False;
  setSize(0,0);
  {FData:= nil;
--- a/Units/MMLCore/files.pas
+++ b/Units/MMLCore/files.pas
@ -43,14 +43,14 @@ type
          constructor Create(Owner : TObject);
          destructor Destroy; override;
      public
-          function CreateFile(Path: string): Integer;
-          function OpenFile(Path: string; Shared: Boolean): Integer;
-          function RewriteFile(Path: string; Shared: Boolean): Integer;
+          function CreateFile(const Path: string): Integer;
+          function OpenFile(const Path: string; Shared: Boolean): Integer;
+          function RewriteFile(const Path: string; Shared: Boolean): Integer;
          procedure CloseFile(FileNum: Integer);
          function EndOfFile(FileNum: Integer): Boolean;
          function FileSizeMuf(FileNum: Integer): LongInt;
          function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
-          function WriteFileString(FileNum: Integer; s: string): Boolean;
+          function WriteFileString(FileNum: Integer;const s: string): Boolean;
          Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
          function FilePointerPos(FileNum: Integer): Integer;
      protected
@ -226,7 +226,7 @@ End;
  Returns -1 if unsuccesfull.
 /\}

-function TMFiles.CreateFile(Path: string): Integer;
+function TMFiles.CreateFile(const Path: string): Integer;

 Var
   FS: TFileStream;
@ -249,7 +249,7 @@ end;
  Returns -1 if unsuccesfull.
 /\}

-function TMFiles.OpenFile(Path: string; Shared: Boolean): Integer;
+function TMFiles.OpenFile(const Path: string; Shared: Boolean): Integer;

 Var
   FS: TFileStream;
@ -290,7 +290,7 @@ end;
  Returns -1 if unsuccesfull.
 /\}

-function TMFiles.RewriteFile(Path: string; Shared: Boolean): Integer;
+function TMFiles.RewriteFile(const Path: string; Shared: Boolean): Integer;

 Var
   FS: TFileStream;
@ -454,7 +454,7 @@ end;
  Writes s in the given File.
 /\}

-function TMFiles.WriteFileString(FileNum: Integer; s: string): Boolean;
+function TMFiles.WriteFileString(FileNum: Integer;const  s: string): Boolean;
 begin
  If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
    raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);