From 2759ad3a03d01ea7db541b062f79f46da5c35293 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 11 Apr 2010 21:42:42 +0200 Subject: [PATCH] Made some changes; Fixed some bitmap issues; Added some functions to extensions; fixed bug in PS --- Extensions/test.sex | 6 +++++ Projects/SAMufasaGUI/about.pas | 3 --- Projects/SAMufasaGUI/framefunctionlist.pas | 2 ++ Projects/SAMufasaGUI/psextension.pas | 13 +++++++-- Projects/SAMufasaGUI/testunit.pas | 10 ++++--- Units/MMLAddon/PSInc/Wrappers/extensions.inc | 5 ++++ Units/MMLAddon/PSInc/Wrappers/other.inc | 5 ++++ Units/MMLAddon/PSInc/psexportedmethods.inc | 2 ++ Units/MMLAddon/mmlpsthread.pas | 19 ++++++++----- Units/MMLCore/bitmaps.pas | 28 +++++++++++--------- Units/PascalScript/x86.inc | 2 +- 11 files changed, 66 insertions(+), 29 deletions(-) diff --git a/Extensions/test.sex b/Extensions/test.sex index ac088f2..6fd281a 100644 --- a/Extensions/test.sex +++ b/Extensions/test.sex @@ -19,6 +19,7 @@ begin; '0'..'9': result := result + str[i]; end; end; + procedure Attach; var Fonts : string; @@ -26,6 +27,11 @@ var newvers :integer; Vers : integer; begin; + case MessageDlg('Test me!', 'Do you want to test me?',mtConfirmation, [mbNo,mbYes,mbCancel],0) of + mrYes : Writeln('hell yeah!'); + mrNo : Writeln('Hell no!'); + mrCancel : Writeln('CANCEL THIS SHIT!'); + end; Vers := StrToIntDef(Settings.GetKeyValueDef('FontVersion','-1'),-1); newvers := strtointdef(GetNumbers(getpage('http://simba.villavu.com/bin/Fonts/Version')),-1); if newVers > vers then diff --git a/Projects/SAMufasaGUI/about.pas b/Projects/SAMufasaGUI/about.pas index 51c7e5c..75b2c61 100644 --- a/Projects/SAMufasaGUI/about.pas +++ b/Projects/SAMufasaGUI/about.pas @@ -61,9 +61,6 @@ procedure TAboutForm.FormCreate(Sender: TObject); begin Self.Caption := format('About Simba r%d', [TestUnit.SimbaVersion]); Self.LabelRevision.Caption := format('Revision %d', [TestUnit.SimbaVersion]); - AboutMemo.Lines.Add('---Simba---'); - AboutMemo.Lines.Add(''); - AboutMemo.Lines.Add(''); AboutMemo.Lines.Add('Simba is released under the GPL license.'); AboutMemo.Lines.Add(format('You are currently using version: %d',[Testunit.SimbaVersion])); AboutMemo.Lines.Add(''); diff --git a/Projects/SAMufasaGUI/framefunctionlist.pas b/Projects/SAMufasaGUI/framefunctionlist.pas index 911bdb3..aace4fd 100644 --- a/Projects/SAMufasaGUI/framefunctionlist.pas +++ b/Projects/SAMufasaGUI/framefunctionlist.pas @@ -452,6 +452,8 @@ var i : integer; tmpNode : TTreeNode; begin; + if procs = nil then + exit; for i := 0 to Procs.Count - 1 do if (Procs[i] is TciProcedureDeclaration) then with Procs[i] as TciProcedureDeclaration do diff --git a/Projects/SAMufasaGUI/psextension.pas b/Projects/SAMufasaGUI/psextension.pas index 0002a0d..0691aac 100644 --- a/Projects/SAMufasaGUI/psextension.pas +++ b/Projects/SAMufasaGUI/psextension.pas @@ -49,7 +49,7 @@ uses uPSC_extctrls,uPSC_menus, //Compile libs uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_extctrls,uPSR_menus, //Runtime-libs - testunit,updateform,settingssandbox,bitmaps,mmisc//Writeln + testunit,updateform,settingssandbox,bitmaps,files,Dialogs, mmisc//Writeln ; function TSimbaPSExtension.HookExists(const HookName: String): Boolean; @@ -123,12 +123,21 @@ begin Sender.Comp.AddConstantN('PluginPath','string').SetString(Form1.PluginPath); Sender.Comp.AddConstantN('FontPath','string').SetString(form1.FontPath); Sender.Comp.AddConstantN('ExtPath','string').SetString(form1.ExtPath); + Sender.Comp.AddTypeS('TMsgDlgType', '( mtWarning, mtError, mtInformation, mtConfirmati' + +'on, mtCustom )'); + Sender.Comp.AddTypeS('TMsgDlgBtn', '( mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, m' + +'bIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp )'); + Sender.Comp.AddTypeS('TMsgDlgButtons', 'set of TMsgDlgBtn'); Sender.AddFunction(@formWritelnEx,'procedure Writeln(s : string)'); Sender.AddFunction(@ext_GetPage,'function GetPage(const url : string) : string'); Sender.AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;'); Sender.AddFunction(@ext_UnTar,'function UnTar(const Input : string; out Content : TStringArray) : boolean;'); Sender.AddFunction(@ext_UnTarEx,'function UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;'); - + Sender.AddFunction(@DirectoryExists,'Function DirectoryExists (Const Directory : String) : Boolean;'); + Sender.AddFunction(@FileExists,'Function FileExists (Const FileName : String) : Boolean;'); + Sender.AddFunction(@GetFiles, 'function GetFiles(Path, Ext: string): TStringArray;'); + Sender.AddFunction(@GetDirectories,'function GetDirectories(Path: string): TstringArray;'); + Sender.AddFunction(@ext_MessageDlg,'function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;'); Sender.AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox'); Sender.AddRegisteredVariable('Simba','TForm'); Sender.AddRegisteredVariable('Simba_MainMenu','TMainMenu'); diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 5aee8a8..b3a6f04 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -1866,7 +1866,7 @@ end; procedure TForm1.MenuItemHandbookClick(Sender: TObject); begin - OpenURL('http://vila.villavu.com/mufasa/mufasa_ps_handbook/'); + OpenURL('http://wizzup.org/simba/doc/ps_handbook/'); end; procedure TForm1.MenuItemColourHistoryClick(Sender: TObject); @@ -2713,9 +2713,11 @@ end; procedure TForm1.SafeCallThread; var thread: TMThread; + LocalCopy : TSyncInfo; begin - mDebugLn('Executing : ' + CurrentSyncInfo.MethodName); - thread:= TMThread(CurrentSyncInfo.OldThread); + LocalCopy := CurrentSyncInfo; + mDebugLn('Executing : ' + LocalCopy.MethodName); + thread:= TMThread(LocalCopy.OldThread); mmlpsthread.CurrThread:= thread; try if thread is TPSThread then @@ -2723,7 +2725,7 @@ begin with TPSThread(thread).PSScript do begin OnLine:=@OnLinePSScript; - CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V^,Exec.GetProc(CurrentSyncInfo.MethodName)); + LocalCopy.Res^:= Exec.RunProcPVar(LocalCopy.V^,Exec.GetProc(LocalCopy.MethodName)); Online := nil; end; end else diff --git a/Units/MMLAddon/PSInc/Wrappers/extensions.inc b/Units/MMLAddon/PSInc/Wrappers/extensions.inc index a38b9ef..4d608b3 100644 --- a/Units/MMLAddon/PSInc/Wrappers/extensions.inc +++ b/Units/MMLAddon/PSInc/Wrappers/extensions.inc @@ -92,3 +92,8 @@ begin mDebugLn('Exception in GetPage in Extensions: ' + e.message); end; end; + +function ext_MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; +begin + result := MessageDlg(acaption,amsg,dlgtype,buttons,helpctx); +end; diff --git a/Units/MMLAddon/PSInc/Wrappers/other.inc b/Units/MMLAddon/PSInc/Wrappers/other.inc index be0b32d..80df22d 100644 --- a/Units/MMLAddon/PSInc/Wrappers/other.inc +++ b/Units/MMLAddon/PSInc/Wrappers/other.inc @@ -76,6 +76,11 @@ begin CurrThread.DebugClear(); end; +procedure ps_SetSupressExceptions(Supress : boolean);extdecl; +begin + CurrThread.Client.MFinder.WarnOnly:= Supress; +end; + procedure ps_SaveScreenshot(FileName: string); extdecl; var w,h : integer; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index a444f17..c9c4bba 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -24,6 +24,7 @@ AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); AddFunction(@pswriteln,'procedure Writeln(x: string);'); //PS defines a special, keep this for CPascal + { DTM } SetCurrSection('DTM'); AddFunction(@ps_SetDTMName, 'procedure SetDTMName(DTM : integer;const name : string);'); @@ -109,6 +110,7 @@ AddFunction(@ps_DeleteINI,'procedure DeleteINI(const Section, KeyName, FileName: {other} SetCurrSection('Other'); +AddFunction(@ps_SetSupressExceptions, 'procedure SetSupressExceptions(Supress : boolean);'); AddFunction(@ps_SaveScreenshot,'procedure SaveScreenshot(FileName: string);'); AddFunction(@ps_Wait, 'procedure wait(t: integer);'); AddFunction(@ps_Wait, 'procedure Sleep(t: integer);'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 5c64684..21c1039 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -41,7 +41,7 @@ type TSyncInfo = record V : MufasaTypes.PVariantArray; MethodName : string; - Res : Variant; + Res : ^Variant; SyncMethod : procedure of object; OldThread : TThread; end; @@ -465,11 +465,18 @@ end; function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; extdecl; begin - CurrThread.SyncInfo^.MethodName:= ProcName; - CurrThread.SyncInfo^.V:= @V; - CurrThread.SyncInfo^.OldThread := CurrThread; - CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod); - Result := CurrThread.SyncInfo^.Res; + if GetCurrentThreadId = MainThreadID then + begin + with TPSThread(currthread).PSScript do + Result := Exec.RunProcPVar(V,Exec.GetProc(Procname)); + end else + begin + CurrThread.SyncInfo^.MethodName:= ProcName; + CurrThread.SyncInfo^.V:= @V; + CurrThread.SyncInfo^.OldThread := CurrThread; + CurrThread.SyncInfo^.Res := @Result; + CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod); + end; end; {$I PSInc/Wrappers/other.inc} diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index b41c8aa..350b1dd 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -35,8 +35,8 @@ type TMufasaBitmap = class(TObject) private w,h : integer; - TransparentColor : TRGB32; - TransparentSet : boolean; + FTransparentColor : TRGB32; + FTransparentSet : boolean; FIndex : integer; FName : string; public @@ -61,9 +61,6 @@ type function CreateTPA(SearchCol : TColor) : TPointArray; function FastGetPixel(x,y : integer) : TColor; function FastGetPixels(TPA : TPointArray) : TIntegerArray; - Procedure SetTransparentColor(Col : TColor); - Function GetTransparentColor : TColor; - property TransparentColorSet : boolean read TransparentSet; procedure FastDrawClear(Color : TColor); procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap); procedure FastReplaceColor(OldColor, NewColor: TColor); @@ -88,6 +85,9 @@ type procedure LoadFromTBitmap(bmp: TBitmap); procedure LoadFromRawImage(RawImage: TRawImage); function CreateTMask : TMask; + procedure SetTransparentColor(Col : TColor); + function GetTransparentColor : TColor; + property TransparentColorSet : boolean read FTransparentSet; constructor Create; destructor Destroy;override; end; @@ -210,6 +210,7 @@ function TMBitmaps.AddBMP(_bmp: TMufasaBitmap): Integer; begin Result := GetNewIndex; BmpArray[Result] := _bmp; + BmpArray[result].Index:= Result; end; function TMBitmaps.CopyBMP(Bitmap: integer): Integer; @@ -446,6 +447,7 @@ begin; Result.R := Color and $ff; Result.G := Color shr 8 and $ff; Result.B := Color shr 16 and $ff; + Result.A := 0; end; function TMufasaBitmap.Copy: TMufasaBitmap; @@ -698,14 +700,14 @@ end; procedure TMufasaBitmap.SetTransparentColor(Col: TColor); begin - TransparentColor:= RGBToBGR(Col); - TransparentSet:= True; + self.FTransparentSet:= True; + self.FTransparentColor:= RGBToBGR(Col); end; function TMufasaBitmap.GetTransparentColor: TColor; begin - if TransparentSet then - Result := BGRToRGB(TransparentColor) + if FTransparentSet then + Result := BGRToRGB(FTransparentColor) else raise Exception.CreateFmt('Transparent color for Bitmap[%d] isn''t set',[index]); end; @@ -731,16 +733,16 @@ var MinW,MinH,TargetW,TargetH : Integer; loopx,loopy : integer; begin - ValidatePoint(x,y); + TargetBitmap.ValidatePoint(x,y); TargetW := TargetBitmap.Width; TargetH := TargetBitmap.height; MinW := Min(w-1,TargetW-x-1); MinH := Min(h-1,TargetH-y-1); - if TransparentSet then + if FTransparentSet then begin; for loopy := 0 to MinH do for loopx := 0 to MinW do - if LongWord(FData[loopy * w + loopx]) <> LongWord(TransparentColor) then + if LongWord(FData[loopy * w + loopx]) <> LongWord(FTransparentColor) then TargetBitmap.FData[(loopy + y) * TargetW + loopx + x] := FData[Loopy * w + loopx]; end @@ -1227,7 +1229,7 @@ constructor TMufasaBitmap.Create; begin inherited Create; Name:= ''; - TransparentSet:= False; + FTransparentSet:= False; setSize(0,0); {FData:= nil; w := 0; diff --git a/Units/PascalScript/x86.inc b/Units/PascalScript/x86.inc index 77ddc2d..9ae2f84 100644 --- a/Units/PascalScript/x86.inc +++ b/Units/PascalScript/x86.inc @@ -573,7 +573,7 @@ begin btchar,btU8, btS8: tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil); {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil); btClass : - {$IFDEF FPC_OLD_FIX} + {$IFDEF FPC} tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX, @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil); {$ELSE}