moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-23 07:48:50 -05:00
Code Issues Releases Wiki Activity

GetDebugImage now ported to PS, thanks to Wizzups leet Bitmap.FromRawImage :D

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@340 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2009-12-25 23:56:25 +00:00
parent 6e0136acfc
commit 49b18d677a
6 changed files with 297 additions and 282 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

246
Projects/SAMufasaGUI/debugimage.pas
View File

@ -1,124 +1,122 @@
{ {
This file is part of the Mufasa Macro Library (MML) This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or the Free Software Foundation, either version 3 of the License, or
(at your option) any later version. (at your option) any later version.
MML is distributed in the hope that it will be useful, MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details. GNU General Public License for more details.
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>. along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution, See the file COPYING, included in this distribution,
for details about the copyright. for details about the copyright.
Image debug window for Mufasa Macro Library Image debug window for Mufasa Macro Library
} }
unit debugimage; unit debugimage;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, bitmaps; ExtCtrls, bitmaps;
type type
{ TDebugImgForm } { TDebugImgForm }
TDebugImgForm = class(TForm) TDebugImgForm = class(TForm)
DrawImage: TImage; DrawImage: TImage;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormHide(Sender: TObject); procedure FormHide(Sender: TObject);
procedure FormResize(Sender: TObject); procedure FormResize(Sender: TObject);
private private
{ private declarations } { private declarations }
public public
DispSize : TPoint; DispSize : TPoint;
ToDrawBmp: TMufasaBitmap;//The bitmap we should draw! ToDrawBmp: TMufasaBitmap;//The bitmap we should draw!
procedure BlackDebugImage; GetDbgBmp : TMufasaBitmap;
procedure DrawBitmap; procedure BlackDebugImage;
procedure GetDebugImage(out bmp : TMufasaBitmap); procedure DrawBitmap;
procedure ShowDebugImgForm; //Uses the global var for w/h procedure GetDebugImage;
{ public declarations } procedure ShowDebugImgForm; //Uses the global var for w/h
end; { public declarations }
end;
var
DebugImgForm: TDebugImgForm; var
DebugImgForm: TDebugImgForm;
implementation
implementation
uses
MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase; uses
{ TDebugImgForm } MufasaTypes, math,windowutil,graphtype, IntfGraphics,TestUnit,lclintf,colour_conv,InterfaceBase;
{ TDebugImgForm }
procedure TDebugImgForm.FormCreate(Sender: TObject);
begin procedure TDebugImgForm.FormCreate(Sender: TObject);
BlackDebugImage; begin
end; BlackDebugImage;
end;
procedure TDebugImgForm.FormHide(Sender: TObject);
begin procedure TDebugImgForm.FormHide(Sender: TObject);
Form1.MenuItemDebugImage.Checked := False; begin
end; Form1.MenuItemDebugImage.Checked := False;
end;
procedure TDebugImgForm.FormResize(Sender: TObject);
begin procedure TDebugImgForm.FormResize(Sender: TObject);
DrawImage.Picture.Graphic.Width := DrawImage.Width; begin
DrawImage.Picture.Graphic.Height := DrawImage.Height; DrawImage.Picture.Graphic.Width := DrawImage.Width;
BlackDebugImage; DrawImage.Picture.Graphic.Height := DrawImage.Height;
end; BlackDebugImage;
end;
procedure TDebugImgForm.BlackDebugImage;
begin procedure TDebugImgForm.BlackDebugImage;
DrawImage.Canvas.Brush.Color:= clBlack; begin
DrawImage.Canvas.Pen.Color:= clBlack; DrawImage.Canvas.Brush.Color:= clBlack;
DrawImage.Canvas.Rectangle(0,0,DrawImage.Width,DrawImage.Height); DrawImage.Canvas.Pen.Color:= clBlack;
end; DrawImage.Canvas.Rectangle(0,0,DrawImage.Width,DrawImage.Height);
end;
procedure TDebugImgForm.DrawBitmap;
var procedure TDebugImgForm.DrawBitmap;
rawImage : TRawImage; var
Bitmap : Graphics.TBitmap; rawImage : TRawImage;
begin Bitmap : Graphics.TBitmap;
if ToDrawBmp = nil then begin
raise Exception.Create('ERROR in TDebugImgForm.DrawBitmap: ToDrawBmp = nil'); if ToDrawBmp = nil then
ArrDataToRawImage(ToDrawBmp.FData,Point(ToDrawBmp.width,ToDrawBmp.height),RawImage); raise Exception.Create('ERROR in TDebugImgForm.DrawBitmap: ToDrawBmp = nil');
Bitmap := Graphics.TBitmap.Create; ArrDataToRawImage(ToDrawBmp.FData,Point(ToDrawBmp.width,ToDrawBmp.height),RawImage);
Bitmap.LoadFromRawImage(Rawimage,false); Bitmap := Graphics.TBitmap.Create;
DrawImage.Canvas.Draw(0,0,Bitmap); Bitmap.LoadFromRawImage(Rawimage,false);
Bitmap.Free; DrawImage.Canvas.Draw(0,0,Bitmap);
end; Bitmap.Free;
end;
procedure TDebugImgForm.GetDebugImage(out bmp: TMufasaBitmap);
begin; procedure TDebugImgForm.GetDebugImage;
DrawImage.Picture.SaveToFile(MainDir + DS + 'stupidwayofdoingthis.bmp'); begin;
bmp := TMufasaBitmap.Create; GetDbgBmp.LoadFromRawImage(DrawImage.Picture.Bitmap.RawImage);
bmp.LoadFromFile(MainDir + DS + 'stupidwayofdoingthis.bmp'); end;
DeleteFile(MainDir + DS + 'stupidwayofdoingthis.bmp');
end; procedure TDebugImgForm.ShowDebugImgForm;
begin
procedure TDebugImgForm.ShowDebugImgForm; Show;
begin if (DispSize.x <> Width) or (DispSize.y <> height) then
Show; begin;
if (DispSize.x <> Width) or (DispSize.y <> height) then Width := DispSize.x;
begin; Height := DispSize.y;
Width := DispSize.x; end;
Height := DispSize.y; end;
end;
end; initialization
{$I debugimage.lrs}
initialization
{$I debugimage.lrs} end.
end.

321
Projects/SAMufasaGUI/framefunctionlist.pas
View File

@ -1,158 +1,163 @@
unit framefunctionlist; unit framefunctionlist;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, ComCtrls, StdCtrls, Controls; Classes, SysUtils, FileUtil, LResources, Forms, ComCtrls, StdCtrls, Controls;
type type
{ TFunctionListFrame } { TFunctionListFrame }
TFunctionListFrame = class(TFrame) TFunctionListFrame = class(TFrame)
editSearchList: TEdit; editSearchList: TEdit;
FunctionList: TTreeView; FunctionList: TTreeView;
procedure editSearchListChange(Sender: TObject); procedure editSearchListChange(Sender: TObject);
procedure FunctionListMouseDown(Sender: TObject; Button: TMouseButton; procedure FunctionListMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure FunctionListMouseUp(Sender: TObject; Button: TMouseButton; procedure FunctionListMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction); procedure DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction);
private private
{ private declarations } { private declarations }
public public
DraggingNode : TTreeNode; DraggingNode : TTreeNode;
ScriptNode : TTreeNode; ScriptNode : TTreeNode;
InCodeCompletion : boolean; InCodeCompletion : boolean;
CompletionCaret : TPoint; CompletionCaret : TPoint;
StartWordCompletion : TPoint; StartWordCompletion : TPoint;
CompletionLine : string; CompletionLine : string;
CompletionStart : string; CompletionStart : string;
function Find(Next : boolean) : boolean; function Find(Next : boolean) : boolean;
{ public declarations } { public declarations }
end; end;
implementation implementation
uses uses
TestUnit, Graphics, simpleanalyzer; TestUnit, Graphics, simpleanalyzer;
{ TFunctionListFrame } { TFunctionListFrame }
procedure TFunctionListFrame.editSearchListChange(Sender: TObject); procedure TFunctionListFrame.editSearchListChange(Sender: TObject);
begin begin
Find(false); Find(false);
end; end;
procedure TFunctionListFrame.DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction); procedure TFunctionListFrame.DockFormOnClose(Sender: TObject; var CloseAction: TCloseAction);
begin begin
CloseAction := caHide; CloseAction := caHide;
Form1.MenuItemFunctionList.Checked := False; Form1.MenuItemFunctionList.Checked := False;
end; end;
function TFunctionListFrame.Find(Next : boolean) : boolean; function TFunctionListFrame.Find(Next : boolean) : boolean;
var var
Start,i,index,posi: Integer; Start,i,index,posi: Integer;
FoundFunction : boolean; FoundFunction : boolean;
str : string; str : string;
Node : TTreeNode; Node : TTreeNode;
begin begin
if(editSearchList.Text = '')then if(editSearchList.Text = '')then
begin begin
editSearchList.Color := clWhite; editSearchList.Color := clWhite;
FunctionList.FullCollapse; FunctionList.FullCollapse;
if InCodeCompletion then if InCodeCompletion then
begin; begin;
Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart; Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
Form1.CurrScript.SynEdit.LogicalCaretXY:= point(CompletionCaret.x,CompletionCaret.y); Form1.CurrScript.SynEdit.LogicalCaretXY:= point(CompletionCaret.x,CompletionCaret.y);
Form1.CurrScript.SynEdit.SelEnd:= Form1.CurrScript.SynEdit.SelStart; Form1.CurrScript.SynEdit.SelEnd:= Form1.CurrScript.SynEdit.SelStart;
end; end;
exit; exit;
end; end;
FoundFunction := False; FoundFunction := False;
if FunctionList.Selected <> nil then if FunctionList.Selected <> nil then
begin begin
Start := FunctionList.Selected.AbsoluteIndex; Start := FunctionList.Selected.AbsoluteIndex;
if(next)then if(next)then
inc(Start); inc(Start);
end else end else
Start := 0; Start := 0;
for i := start to start + FunctionList.Items.Count - 1 do for i := start to start + FunctionList.Items.Count - 1 do
if(FunctionList.Items[i mod FunctionList.Items.Count].Level = 1)then if(FunctionList.Items[i mod FunctionList.Items.Count].Level = 1)then
if(pos(lowercase(editSearchList.Text), lowercase(FunctionList.Items[i mod FunctionList.Items.Count].Text)) > 0)then if(pos(lowercase(editSearchList.Text), lowercase(FunctionList.Items[i mod FunctionList.Items.Count].Text)) > 0)then
begin begin
FoundFunction := True; FoundFunction := True;
index := i mod FunctionList.Items.Count; index := i mod FunctionList.Items.Count;
break; break;
end; end;
Result := FoundFunction; Result := FoundFunction;
if Result then if Result then
begin; begin;
Writeln(FunctionList.Items[Index].Text); Writeln(FunctionList.Items[Index].Text);
FunctionList.FullCollapse; FunctionList.FullCollapse;
FunctionList.Items[Index].Selected := true; FunctionList.Items[Index].Selected := true;
FunctionList.Items[index].ExpandParents; FunctionList.Items[index].ExpandParents;
editSearchList.Color := clWhite; editSearchList.Color := clWhite;
if InCodeCompletion then if InCodeCompletion then
begin; begin;
str := format(CompletionLine, [FunctionList.items[index].text]); str := format(CompletionLine, [FunctionList.items[index].text]);
with Form1.CurrScript.SynEdit do with Form1.CurrScript.SynEdit do
begin; begin;
Lines[CompletionCaret.y - 1] := str; Lines[CompletionCaret.y - 1] := str;
LogicalCaretXY:= StartWordCompletion; LogicalCaretXY:= StartWordCompletion;
i := SelStart; i := SelStart;
posi := pos(lowercase(editSearchList.text), lowercase(FunctionList.items[index].text)); posi := pos(lowercase(editSearchList.text), lowercase(FunctionList.items[index].text));
SelStart := i + length(editSearchList.Text) + posi - 1; SelStart := i + length(editSearchList.Text) + posi - 1;
SelEnd := i + Length(str); SelEnd := i + Length(str);
end; end;
end; end;
end else end else
begin begin
editSearchList.Color := 6711039; editSearchList.Color := 6711039;
if InCodeCompletion then if InCodeCompletion then
Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart; Form1.CurrScript.SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
end; end;
end; end;
procedure TFunctionListFrame.FunctionListMouseDown(Sender: TObject; procedure TFunctionListFrame.FunctionListMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var var
N: TTreeNode; N: TTreeNode;
begin begin
N := Self.FunctionList.GetNodeAt(x, y); if InCodeCompletion then
if(N = nil)then begin;
begin Writeln('Not yet implemented');
Self.DragKind := dkDock; exit;
Self.BeginDrag(false, 40); end;
exit; N := Self.FunctionList.GetNodeAt(x, y);
end; if(N = nil)then
Self.DragKind := dkDrag; begin
if(Button = mbLeft) and (N.Level > 0)then Self.DragKind := dkDock;
Self.BeginDrag(False, 10); Self.BeginDrag(false, 40);
DraggingNode := N; exit;
end; end;
Self.DragKind := dkDrag;
procedure TFunctionListFrame.FunctionListMouseUp(Sender: TObject; if(Button = mbLeft) and (N.Level > 0)then
Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Self.BeginDrag(False, 10);
var DraggingNode := N;
F: ^TCustomDockForm; end;
begin
if(Self.Parent is TCustomDockForm)then procedure TFunctionListFrame.FunctionListMouseUp(Sender: TObject;
begin Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
F := @Self.Parent; //can't typecast parent as a TCustomDockForm var
F^.Caption := 'Function List'; F: ^TCustomDockForm;
F^.BorderStyle := bsSizeable; begin
F^.OnClose := @DockFormOnClose; if(Self.Parent is TCustomDockForm)then
Form1.Splitter1.Hide; begin
end; F := @Self.Parent; //can't typecast parent as a TCustomDockForm
end; F^.Caption := 'Function List';
F^.BorderStyle := bsSizeable;
initialization F^.OnClose := @DockFormOnClose;
{$I framefunctionlist.lrs} Form1.Splitter1.Hide;
end;
end. end;
initialization
{$I framefunctionlist.lrs}
end.

2
Projects/SAMufasaGUI/testunit.pas
View File

@ -456,6 +456,8 @@ begin
DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm; DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm;
DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp; DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp;
DbgImgInfo.DrawBitmap:= @DebugImgForm.DrawBitmap; DbgImgInfo.DrawBitmap:= @DebugImgForm.DrawBitmap;
DbgImgInfo.GetDebugBitmap:= @DebugImgForm.GetDbgBmp;
DbgImgInfo.GetBitmap:= @DebugImgForm.GetDebugImage;
ScriptThread.SetDbgImg(DbgImgInfo); ScriptThread.SetDbgImg(DbgImgInfo);
ScriptThread.OnError:=@ErrorThread; ScriptThread.OnError:=@ErrorThread;

7
Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -110,6 +110,13 @@ begin;
CurrThread.Synchronize(CurrThread.DebugImg.DrawBitmap); CurrThread.Synchronize(CurrThread.DebugImg.DrawBitmap);
end; end;
function GetDebugBitmap : integer;
begin;
result := CurrThread.Client.MBitmaps.CreateBMP(0,0);
CurrThread.DebugImg.GetDebugBitmap^ := CurrThread.Client.MBitmaps.Bmp[result];
CurrThread.Synchronize(CurrThread.DebugImg.GetBitmap);
end;
procedure TerminateScript; procedure TerminateScript;
begin; begin;
CurrThread.PSScript.Stop; CurrThread.PSScript.Stop;

1
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -91,6 +91,7 @@ AddFunction(@HakunaMatata,'procedure HakunaMatata;');
AddFunction(@TerminateScript,'procedure TerminateScript;'); AddFunction(@TerminateScript,'procedure TerminateScript;');
AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w,h : integer);'); AddFunction(@DisplayDebugImgWindow,'procedure DisplayDebugImgWindow(w,h : integer);');
AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp : integer);'); AddFunction(@DrawBitmapDebugImg,'procedure DrawBitmapDebugImg(bmp : integer);');
AddFunction(@GetDebugBitmap,'function GetDebugBitmap : integer;');
AddFunction(@Random,'function Random(Int : integer): integer;'); AddFunction(@Random,'function Random(Int : integer): integer;');

2
Units/MMLAddon/mmlpsthread.pas
View File

@ -47,6 +47,8 @@ type
ShowForm : procedure of object; ShowForm : procedure of object;
ToDrawBitmap : ^TMufasaBitmap; ToDrawBitmap : ^TMufasaBitmap;
DrawBitmap : procedure of object; DrawBitmap : procedure of object;
GetDebugBitmap : ^TMufasaBitmap;
GetBitmap : procedure of object;
end; end;
PSyncInfo = ^TSyncInfo; PSyncInfo = ^TSyncInfo;
TErrorType = (errRuntime,errCompile); TErrorType = (errRuntime,errCompile);