moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-11 11:55:02 -05:00
Code Issues Releases Wiki Activity

So yeah.. Some user information is now actually printed to Simba (like Your bitmap has not been freed etc).

Browse Source 
Windows users now have the option to use a console or not (it's the little CMD-image-button).
Non-important information will still be written to the console (so you must open it if you want some lil extra information).

Now default compiles *without* the -WG switch, otherwise you LCL will raise exceptions when the Console is closed

Added some exceptions to the Files unit, rather than returning -1.

Use mDebug to write something to the terminal (it's inside the MufasaBase unit).

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@581 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond 2010-03-07 15:57:10 +00:00
parent fa6dc12fe5
commit 865779c59a
38 changed files with 933 additions and 752 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
trunk/Images/license.txt
View File

@ -1,6 +1,6 @@
pause,stop: From Lazarus (http://lazarus.freepascal.org)
exit,cut,page_new,new,open,paste,redo,run,save,undo,help,bug,arrow_refresh,html: Mark James http://www.famfamfam.com/lab/icons/silk/
closetab,closetabs,addtab,eraser,terminate: Yusuke Kamiyamane http://www.pinvoke.com/
closetab,closetabs,addtab,eraser,terminate,terminal: Yusuke Kamiyamane http://www.pinvoke.com/
pickcolor: From the Crystal Clear Project (http://www.everaldo.com/crystal/) licensed under LGPL
crosshair: http://led24.de/iconset/ or http://led24.de/ would be appreciated. Follow us on twitter http://twitter.com/gasyoun or email leds24@gmail.com 512 icons 20/05/2009

BIN
trunk/Images/terminal.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 529 B

22
trunk/Projects/SAMufasaGUI/colourhistory.lfm
View File

@ -5,7 +5,7 @@ object ColourHistoryForm: TColourHistoryForm
Width = 499
ActiveControl = SelectionName
Caption = 'Colour Picker History'
ClientHeight = 235
ClientHeight = 240
ClientWidth = 499
Constraints.MinHeight = 200
Constraints.MinWidth = 490
@ -17,7 +17,7 @@ object ColourHistoryForm: TColourHistoryForm
object DeleteButton: TButton
Left = 16
Height = 25
Top = 193
Top = 198
Width = 128
Anchors = [akLeft, akBottom]
Caption = 'Delete'
@ -26,7 +26,7 @@ object ColourHistoryForm: TColourHistoryForm
end
object SelectionName: TEdit
Left = 370
Height = 27
Height = 21
Top = 16
Width = 112
Anchors = [akTop, akRight]
@ -38,7 +38,7 @@ object ColourHistoryForm: TColourHistoryForm
object PickNewColourButton: TButton
Left = 226
Height = 25
Top = 193
Top = 198
Width = 128
Anchors = [akRight, akBottom]
Caption = 'Pick New Colour'
@ -46,7 +46,7 @@ object ColourHistoryForm: TColourHistoryForm
end
object ColourValue: TEdit
Left = 370
Height = 27
Height = 21
Top = 56
Width = 112
Anchors = [akTop, akRight]
@ -56,7 +56,7 @@ object ColourHistoryForm: TColourHistoryForm
end
object CoordValue: TLabel
Left = 370
Height = 18
Height = 14
Top = 96
Width = 112
Anchors = [akTop, akRight]
@ -67,14 +67,14 @@ object ColourHistoryForm: TColourHistoryForm
object ColourImage: TImage
Left = 152
Height = 24
Top = 194
Top = 199
Width = 66
Anchors = [akLeft, akRight, akBottom]
end
object OkButton: TButton
Left = 402
Height = 24
Top = 194
Top = 199
Width = 80
Anchors = [akRight, akBottom]
Caption = 'Ok'
@ -83,7 +83,7 @@ object ColourHistoryForm: TColourHistoryForm
end
object CH_RGB_Label: TLabel
Left = 370
Height = 18
Height = 14
Top = 128
Width = 112
Anchors = [akTop, akRight]
@ -93,11 +93,11 @@ object ColourHistoryForm: TColourHistoryForm
end
object ColourTree: TTreeView
Left = 8
Height = 154
Height = 159
Top = 16
Width = 346
Anchors = [akTop, akLeft, akRight, akBottom]
DefaultItemHeight = 19
DefaultItemHeight = 16
DragMode = dmAutomatic
Images = CHImages
ScrollBars = ssAutoBoth

22
trunk/Projects/SAMufasaGUI/colourhistory.lrs
View File

@ -3,33 +3,33 @@
LazarusResources.Add('TColourHistoryForm','FORMDATA',[
'TPF0'#18'TColourHistoryForm'#17'ColourHistoryForm'#4'Left'#3'v'#1#6'Height'#3
+#4#1#3'Top'#3'O'#1#5'Width'#3#243#1#13'ActiveControl'#7#13'SelectionName'#7
+'Caption'#6#21'Colour Picker History'#12'ClientHeight'#3#235#0#11'ClientWidt'
+'Caption'#6#21'Colour Picker History'#12'ClientHeight'#3#240#0#11'ClientWidt'
+'h'#3#243#1#21'Constraints.MinHeight'#3#200#0#20'Constraints.MinWidth'#3#234
+#1#4'Menu'#7#10'CHMainMenu'#8'OnCreate'#7#10'FormCreate'#6'OnHide'#7#15'UnSe'
+'tCHShowMenu'#6'OnShow'#7#13'SetCHShowMenu'#10'LCLVersion'#6#6'0.9.29'#0#7'T'
+'Button'#12'DeleteButton'#4'Left'#2#16#6'Height'#2#25#3'Top'#3#193#0#5'Width'
+'Button'#12'DeleteButton'#4'Left'#2#16#6'Height'#2#25#3'Top'#3#198#0#5'Width'
+#3#128#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#6'Delete'#7'OnCl'
+'ick'#7#14'DeleteSelected'#8'TabOrder'#2#0#0#0#5'TEdit'#13'SelectionName'#4
+'Left'#3'r'#1#6'Height'#2#27#3'Top'#2#16#5'Width'#2'p'#7'Anchors'#11#5'akTop'
+'Left'#3'r'#1#6'Height'#2#21#3'Top'#2#16#5'Width'#2'p'#7'Anchors'#11#5'akTop'
+#7'akRight'#0#8'OnChange'#7#10'ChangeName'#10'OnKeyPress'#7#21'SelectionName'
+'KeyPress'#8'TabOrder'#2#1#4'Text'#6#4'Name'#0#0#7'TButton'#19'PickNewColour'
+'Button'#4'Left'#3#226#0#6'Height'#2#25#3'Top'#3#193#0#5'Width'#3#128#0#7'An'
+'Button'#4'Left'#3#226#0#6'Height'#2#25#3'Top'#3#198#0#5'Width'#3#128#0#7'An'
+'chors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#15'Pick New Colour'#8'TabOr'
+'der'#2#2#0#0#5'TEdit'#11'ColourValue'#4'Left'#3'r'#1#6'Height'#2#27#3'Top'#2
+'der'#2#2#0#0#5'TEdit'#11'ColourValue'#4'Left'#3'r'#1#6'Height'#2#21#3'Top'#2
+'8'#5'Width'#2'p'#7'Anchors'#11#5'akTop'#7'akRight'#0#8'ReadOnly'#9#8'TabOrd'
+'er'#2#3#4'Text'#6#11'ColourValue'#0#0#6'TLabel'#10'CoordValue'#4'Left'#3'r'
+#1#6'Height'#2#18#3'Top'#2'`'#5'Width'#2'p'#7'Anchors'#11#5'akTop'#7'akRight'
+#1#6'Height'#2#14#3'Top'#2'`'#5'Width'#2'p'#7'Anchors'#11#5'akTop'#7'akRight'
+#0#7'Caption'#6#10'CoordValue'#20'Constraints.MinWidth'#2'p'#11'ParentColor'
+#8#0#0#6'TImage'#11'ColourImage'#4'Left'#3#152#0#6'Height'#2#24#3'Top'#3#194
+#8#0#0#6'TImage'#11'ColourImage'#4'Left'#3#152#0#6'Height'#2#24#3'Top'#3#199
+#0#5'Width'#2'B'#7'Anchors'#11#6'akLeft'#7'akRight'#8'akBottom'#0#0#0#7'TBut'
+'ton'#8'OkButton'#4'Left'#3#146#1#6'Height'#2#24#3'Top'#3#194#0#5'Width'#2'P'
+'ton'#8'OkButton'#4'Left'#3#146#1#6'Height'#2#24#3'Top'#3#199#0#5'Width'#2'P'
+#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#2'Ok'#7'OnClick'#7#13'O'
+'kButtonClick'#8'TabOrder'#2#4#0#0#6'TLabel'#12'CH_RGB_Label'#4'Left'#3'r'#1
+#6'Height'#2#18#3'Top'#3#128#0#5'Width'#2'p'#7'Anchors'#11#5'akTop'#7'akRigh'
+#6'Height'#2#14#3'Top'#3#128#0#5'Width'#2'p'#7'Anchors'#11#5'akTop'#7'akRigh'
+'t'#0#7'Caption'#6#9'RGBValues'#20'Constraints.MinWidth'#2'p'#11'ParentColor'
+#8#0#0#9'TTreeView'#10'ColourTree'#4'Left'#2#8#6'Height'#3#154#0#3'Top'#2#16
+#8#0#0#9'TTreeView'#10'ColourTree'#4'Left'#2#8#6'Height'#3#159#0#3'Top'#2#16
+#5'Width'#3'Z'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#17
+'DefaultItemHeight'#2#19#8'DragMode'#7#11'dmAutomatic'#6'Images'#7#8'CHImage'
+'DefaultItemHeight'#2#16#8'DragMode'#7#11'dmAutomatic'#6'Images'#7#8'CHImage'
+'s'#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#5#8'OnChange'#7#16'ColourT'
+'reeChange'#10'OnDragDrop'#7#18'ColourTreeDragDrop'#10'OnDragOver'#7#18'Colo'
+'urTreeDragOver'#0#0#10'TImageList'#8'CHImages'#4'left'#3#168#1#3'top'#3#160

18
trunk/Projects/SAMufasaGUI/colourhistory.pas
View File

@ -27,7 +27,7 @@ unit colourhistory;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,MufasaBase,
ComCtrls, StdCtrls, ExtCtrls, Menus, DOM, XMLWrite, XMLRead;
type
@ -172,7 +172,7 @@ begin
begin
If Assigned(N.Data) then
TColourPickerObject(N.Data).Free;
WriteLn('Deleting ImageIndex: ' + IntToStr(n.ImageIndex) + '; Text: ' + N.Text);
mDebugLn('Deleting ImageIndex: ' + IntToStr(n.ImageIndex) + '; Text: ' + N.Text);
// yeah....
try
@ -198,7 +198,7 @@ begin
WalkDeleteTree(ColourTree.Selected, CHImages);
WriteLn('Deleting ImageIndex: ' + IntToStr(ColourTree.Selected.ImageIndex) + '; Text: ' + ColourTree.Selected.Text);
mDebugLn('Deleting ImageIndex: ' + IntToStr(ColourTree.Selected.ImageIndex) + '; Text: ' + ColourTree.Selected.Text);
if ColourTree.Selected.ImageIndex <> -1 then
CHImages.Delete(ColourTree.Selected.ImageIndex);
@ -284,7 +284,7 @@ begin
C := 0;
writeln(Colourtree.Items.TopLvlCount);
mDebugLn(inttostr(Colourtree.Items.TopLvlCount));
for i := 0 to Colourtree.Items.TopLvlCount -1 do
begin
WriteXMLData(ColourTree.Items.TopLvlItems[i], RootNode, XMLDoc, XMLChild, C);
@ -343,7 +343,7 @@ begin
Node := ColourTree.GetNodeAt(X, Y);
if not assigned(ColourTree.Selected) then
begin
writeln('No valid node is currently selected');
mDebugLn('No valid node is currently selected');
exit;
end;
@ -355,8 +355,8 @@ begin
end;
ColourTree.Selected.MoveTo(Node, naAddChild);
TreeChanged:=True;
writeln('Dragging from: ' + ColourTree.Selected.Text);
writeln('Dragging to: ' + Node.Text);
mDebugLn('Dragging from: ' + ColourTree.Selected.Text);
mDebugLn('Dragging to: ' + Node.Text);
end;
procedure TColourHistoryForm.ColourTreeDragOver(Sender, Source: TObject; X,
@ -370,7 +370,7 @@ procedure TColourHistoryForm.ChangeName(Sender: TObject);
begin
if not Assigned(ColourTree.Selected) then
begin
WriteLn('We double clicked but have nothing Selected?');
mDebugLn('We double clicked but have nothing Selected?');
exit;
end;
ColourTree.Selected.Text := SelectionName.Text;
@ -406,7 +406,7 @@ var
exit;
TreeNode := ColourTree.Items.AddChild(TreeNode, 'ERROR');
writeln(Node.NodeName);
mDebugLn(Node.NodeName);
cNode := Node.FindNode('Data');
if Assigned(cNode) then
begin

12
trunk/Projects/SAMufasaGUI/framefunctionlist.pas
View File

@ -5,7 +5,7 @@ unit framefunctionlist;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, ComCtrls, StdCtrls, Controls,
Classes, SysUtils, FileUtil, LResources, MufasaBase,Forms, ComCtrls, StdCtrls, Controls,
ExtCtrls, Buttons;
type
@ -137,7 +137,7 @@ var
begin
if InCodeCompletion then
begin;
Writeln('Not yet implemented');
mDebugLn('Not yet implemented');
exit;
end;
if not (Sender is TTreeView) then
@ -191,7 +191,7 @@ begin
if ScriptNode = nil then
exit;
if FilterTree.Visible then
Writeln('Might get some acces violations now..');
mDebugLn('Might get some acces violations now..');
ScriptNode.DeleteChildren;
Analyzer := TScriptAnalyzer.create;
Analyzer.ScriptToAnalyze:= Script;
@ -241,7 +241,7 @@ begin
begin;
if FilterTree.Visible = false then
begin;
Writeln('ERROR: You cannot search next, since the Tree isnt generated yet');
mDebugLn('ERROR: You cannot search next, since the Tree isnt generated yet');
Find(false);
exit;
end;
@ -313,7 +313,7 @@ begin
FilterTreeVis(True);
FilterTree.FullExpand;
FilterTree.Items[1].Selected:= True;
Writeln(FunctionList.Items[Index].Text);
mDebugLn(FunctionList.Items[Index].Text);
FunctionList.FullCollapse;
FunctionList.Items[Index].Selected := true;
FunctionList.Items[index].ExpandParents;
@ -365,7 +365,7 @@ begin
exit;
if InCodeCompletion then
begin;
Writeln('Not yet implemented');
mDebugLn('Not yet implemented');
exit;
end;
if not (Sender is TTreeView) then

8
trunk/Projects/SAMufasaGUI/framescript.pas
View File

@ -28,7 +28,7 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, SynHighlighterPas, SynEdit, SynEditMarkupHighAll,
mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType, SynEditMarkupSpecialLine, Graphics, Controls;
mmlpsthread,ComCtrls, SynEditKeyCmds, LCLType,MufasaBase, SynEditMarkupSpecialLine, Graphics, Controls;
const
ecCodeCompletion = ecUserFirst;
type
@ -178,8 +178,8 @@ begin
Insert('%s',CompletionLine,i+1);
CompletionCaret := Point(endi,Caret.y);
StartWordCompletion:= Point(i+1,caret.y);
Writeln(CompletionLine);
Writeln(CompletionStart);
mDebugLn(CompletionLine);
mDebugLn(CompletionStart);
InCodeCompletion := true;
editSearchList.Text:= SearchText;
editSearchList.SelStart:= Length(searchText);
@ -247,7 +247,7 @@ begin
if ErrorData.Module <> '' then
begin;
if not FileExists(ErrorData.Module) then
Writeln(Format('ERROR comes from a non-existing file (%s)',[ErrorData.Module]))
formWriteln(Format('ERROR comes from a non-existing file (%s)',[ErrorData.Module]))
else
begin
ErrorData.Module:= SetDirSeparators(ErrorData.Module);// Set it right ;-)

14
trunk/Projects/SAMufasaGUI/project1.lpi
View File

@ -14,9 +14,9 @@
<Icon Value="0"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<Language Value="0419"/>
<CharSet Value="04B0"/>
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
@ -39,7 +39,7 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="34">
<Units Count="35">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
@ -228,6 +228,11 @@
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/tpa.inc"/>
<IsPartOfProject Value="True"/>
</Unit33>
<Unit34>
<Filename Value="../../Units/MMLCore/mufasabase.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mufasabase"/>
</Unit34>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -250,6 +255,11 @@
<Debugging>
<GenerateDebugInfo Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dUseCThreads

2
trunk/Projects/SAMufasaGUI/project1.lpr
View File

@ -33,7 +33,7 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, Forms, testunit, colourhistory, About, internets, debugimage,
framefunctionlist, simpleanalyzer, updater, updateform, simbasettings,
libloader;
libloader, mufasabase;
{$R project1.res}

2
trunk/Projects/SAMufasaGUI/simbasettings.lfm
View File

@ -16,7 +16,7 @@ object SettingsForm: TSettingsForm
Top = 16
Width = 324
Anchors = [akTop, akLeft, akRight, akBottom]
DefaultItemHeight = 19
DefaultItemHeight = 15
ReadOnly = True
ScrollBars = ssAutoBoth
TabOrder = 0

2
trunk/Projects/SAMufasaGUI/simbasettings.lrs
View File

@ -7,7 +7,7 @@ LazarusResources.Add('TSettingsForm','FORMDATA',[
+'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'#10'LCLVersion'#6#6
+'0.9.29'#0#9'TTreeView'#16'SettingsTreeView'#4'Left'#2#16#6'Height'#3#217#1#3
+'Top'#2#16#5'Width'#3'D'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akB'
+'ottom'#0#17'DefaultItemHeight'#2#19#8'ReadOnly'#9#10'ScrollBars'#7#10'ssAut'
+'ottom'#0#17'DefaultItemHeight'#2#15#8'ReadOnly'#9#10'ScrollBars'#7#10'ssAut'
+'oBoth'#8'TabOrder'#2#0#10'OnDblClick'#7#24'SettingsTreeViewDblClick'#7'Opti'
+'ons'#11#17'tvoAutoItemHeight'#16'tvoHideSelection'#21'tvoKeepCollapsedNodes'
+#11'tvoReadOnly'#14'tvoShowButtons'#12'tvoShowLines'#11'tvoShowRoot'#11'tvoT'

4
trunk/Projects/SAMufasaGUI/simbasettings.pas
View File

@ -5,7 +5,7 @@ unit simbasettings;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Classes, SysUtils, FileUtil, LResources, Forms, Controls,MufasaBase, Graphics, Dialogs,
ComCtrls, StdCtrls, settings;
type
@ -94,7 +94,7 @@ begin
Path := Settings.GetNodePath(N.Parent);
NewVal := InputBox('Change Setting', 'Change value for ' + TSettingData(N.Data).Val,
Settings.GetKeyValue(Path));
writeln('NewVal: ' + NewVal);
mDebugLn('NewVal: ' + NewVal);
Settings.SetKeyValue(Path, NewVal);
N.Text := NewVal;
end;

8
trunk/Projects/SAMufasaGUI/simpleanalyzer.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, SynEdit, SynHighlighterPas, Clipbrd;
StdCtrls, SynEdit, SynHighlighterPas,MufasaBase, Clipbrd;
type
@ -339,7 +339,7 @@ begin
WaitingForResult := LastTK = tkFunction;
if Lex.TokenID <> tkIdentifier then
begin;
Writeln('Analyzer: No method name -> exiting');
mDebugLn('Analyzer: No method name -> exiting');
exit;
end;
TempName := Lex.Token;
@ -349,7 +349,7 @@ begin
InParams := True
else if Lex.TokenID = tkPoint then
begin;
Writeln('Analyzer: In class definition?');
mDebugLn('Analyzer: In class definition?');
// FormAnalyzer.SynEdit2.Lines.add('In class definition *cough*');
Lex.NextNoJunk;
TempName := Lex.Token;
@ -358,7 +358,7 @@ begin
InParams := False;
end else
begin;
Writeln('Analyzer: You''re missing some stuff in the procedure declaration');
mDebugLn('Analyzer: You''re missing some stuff in the procedure declaration');
Exit;
end;
if InMethod then

51
trunk/Projects/SAMufasaGUI/testunit.lfm
View File

@ -158,19 +158,18 @@ object Form1: TForm1
Enabled = False
end
object ToolButton3: TToolButton
Left = 407
Left = 430
Top = 2
Width = 3
Caption = 'ToolButton3'
Style = tbsDivider
end
object TT_Update: TToolButton
Left = 410
Left = 433
Hint = 'A new update is available'
Top = 2
Caption = 'TT_Update'
ImageIndex = 1
Visible = False
OnClick = TT_UpdateClick
end
object TT_Cut: TToolButton
@ -199,6 +198,11 @@ object Form1: TForm1
Caption = 'ToolButton9'
Style = tbsDivider
end
object TT_Console: TToolButton
Left = 407
Top = 2
Action = ActionConsole
end
end
object StatusBar: TStatusBar
Left = 0
@ -1472,7 +1476,7 @@ object Form1: TForm1
left = 448
top = 144
Bitmap = {
4C691B0000001000000010000000424242004242420042424200424242004242
4C691C0000001000000010000000424242004242420042424200424242004242
420042424200424242004242420042424200424242004242420042424200A155
42FFA15542FFA15542FF4242420E424242004242420042424200424242004242
4200424242004242420042424200424242004242420042424200A15542FFFFDA
@ -2336,7 +2340,39 @@ object Form1: TForm1
0000000000000000000000000000000000000000000000000000010101300202
02EF151515FF3A3A3AFF606060FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000101
0120020202CF141414FF393939CF
0120020202CF141414FF393939CFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00555555225555555955555566555555665555
5566555555665555556655555566555555665555556655555566555555665555
55665555556655555559555555225252525BC6C6C6D4DCDCDCFFD8D9D9FFD5D5
D5FFD0D1D1FFCCCCCCFFC8C8C8FFC6C6C6FFC6C5C5FFC9C5C5FFCDC6C6FFD1C7
C7FFD7CBCBFFC4B8B8D45252525B50505069BBBBBBFFBABABAFFB8B8B8FFB6B6
B6FFB3B3B3FFB0B0B0FFAEAEAEFFABABABFFA8A8A8FFA6A6A6FFA3A3A3FFA0A0
A0FF9E9E9EFF9C9C9CFF0303036655555567383838FF4D4D4DFF4D4D4DFF4C4C
4CFF4A4A4AFF494949FF484848FF464646FF444444FF3F3F3FFF393737FF3D39
39FF413D3DFF3C3939FF03030366515151684D4D4DFFCBCBCBFF8B8B8BFF7272
72FF6E6E6EFF696969FF646464FF5F5F5FFF525151FF484343FF4C4646FF524A
4AFF584E4EFF4A4444FF030303664D4D4D6A4C4C4CFF5B5B5BFFC5C5C5FF8888
88FF666666FF616161FF5C5C5CFF504E4EFF4A4444FF504848FF564D4DFF5C51
51FF615656FF504949FF030303664949496C4A4A4AFFBFBFBFFF777777FF5F5F
5FFFBFBFBFFF8C8C8CFF514F4FFF4D4747FF534B4BFF594F4FFF5F5454FF6558
58FF6A5C5CFF554E4EFF030303664444446E474747FF545454FF606060FF5B5B
5BFF4C4C4CFF4D4D4DFF514A4AFF574E4EFF5D5252FF625656FF685B5BFF6D5F
5FFF716262FF5A5252FF030303663E3E3E71454545FF5D5D5DFF585858FF5353
53FF4F4F4FFF524D4DFF5A5050FF605555FF665959FF6B5D5DFF6F6161FF7463
63FF766666FF5D5454FF0303036638383873424242FF555555FF515151FF4C4C
4CFF4C4B4BFF5D5353FF635757FF695B5BFF6E5F5FFF726262FF766565FF7766
66FF776666FF5E5555FF0303036632323276404040FF4E4E4EFF4A4A4AFF4747
47FF534D4DFF675A5AFF6C5E5EFF706161FF746464FF776666FF776666FF7766
66FF776666FF5E5555FF030303662727277B383838FF3F3F3FFF3E3E3EFF3E3E
3EFF4C4747FF544D4DFF585050FF5B5252FF5C5454FF5D5555FF5E5555FF5E55
55FF5E5555FF514D4DFF121212720D0D0D671010108510101085101010851010
1085101010851010108510101085101010851010108510101085101010851010
108510101085101010850D0D0D6700000009000000160000001A0000001A0000
001A0000001A0000001A0000001A0000001A0000001A0000001A0000001A0000
001A0000001A0000001600000009FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00
}
end
object MTrayIcon: TTrayIcon
@ -2737,6 +2773,11 @@ object Form1: TForm1
OnExecute = ActionNormalSizeExecute
ShortCut = 16450
end
object ActionConsole: TAction
Caption = 'ActionConsole'
ImageIndex = 27
OnExecute = ActionConsoleExecute
end
end
object DebugTimer: TTimer
OnTimer = ProcessDebugStream

920
trunk/Projects/SAMufasaGUI/testunit.lrs
View File

File diff suppressed because it is too large Load Diff

179
trunk/Projects/SAMufasaGUI/testunit.pas
View File

@ -40,11 +40,11 @@ uses
colourpicker, framescript, windowselector, lcltype, ActnList,
SynExportHTML, SynEditKeyCmds, SynEditHighlighter,
SynEditMarkupHighAll, LMessages, Buttons,
stringutil,mufasatypesutil,
stringutil,mufasatypesutil,mufasabase,
about, framefunctionlist, ocr, updateform, simbasettings;
const
SimbaVersion = 579;
SimbaVersion = 581;
type
@ -65,6 +65,7 @@ type
{ TForm1 }
TForm1 = class(TForm)
ActionConsole: TAction;
ActionNormalSize: TAction;
ActionCompileScript: TAction;
ActionExit: TAction;
@ -112,6 +113,7 @@ type
MenuItemDivider9: TMenuItem;
MouseTimer: TTimer;
NewsTimer: TTimer;
TT_Console: TToolButton;
TT_Cut: TToolButton;
TT_Copy: TToolButton;
TT_Paste: TToolButton;
@ -214,6 +216,7 @@ type
procedure ActionClearDebugExecute(Sender: TObject);
procedure ActionCloseTabExecute(Sender: TObject);
procedure ActionCompileScriptExecute(Sender: TObject);
procedure ActionConsoleExecute(Sender: TObject);
procedure ActionCopyExecute(Sender: TObject);
procedure ActionCutExecute(Sender: TObject);
procedure ActionDeleteExecute(Sender: TObject);
@ -330,6 +333,10 @@ type
OCR_Fonts: TMOCR;
Picker: TMColorPicker;
Selector: TMWindowSelector;
{$ifdef mswindows}
ConsoleVisible : boolean;
procedure ShowConsole( ShowIt : boolean);
{$endif}
procedure FunctionListShown( ShowIt : boolean);
property ScriptState : TScriptState read GetScriptState write SetScriptState;
procedure SafeCallThread;
@ -357,10 +364,12 @@ type
procedure AddRecentFile(filename : string);
procedure InitalizeTMThread(var Thread : TMThread);
procedure HandleParameters;
procedure OnSaveScript(const Filename : string);
end;
procedure ClearDebug;
procedure formWriteln( S : String);
procedure formWritelnEx( S : String);
function GetMethodName( Decl : string; PlusNextChar : boolean) : string;
const
@ -388,7 +397,13 @@ uses
colourhistory,
math;
//{$ifdef mswindows}
{$ifdef mswindows}
function ConsoleHandler( eventType : DWord) : WINBOOL;stdcall;
begin
TThread.Synchronize(nil,@Form1.Close);
Result := true;
end;
{$endif}
var
DebugCriticalSection: syncobjs.TCriticalSection;
@ -506,18 +521,24 @@ procedure TForm1.UpdateTimerCheck(Sender: TObject);
var
chk: String;
time:integer;
LatestVersion : integer;
begin
chk := LoadSettingDef('Settings/Updater/CheckForUpdates','True');
if chk <> 'True' then
Exit;
if SimbaUpdateForm.CanUpdate then
LatestVersion:= SimbaUpdateForm.GetLatestSimbaVersion;
if LatestVersion > SimbaVersion then
begin;
TT_Update.Visible:=True;
formWriteln('A new update of Simba is available!');
formWritelnEx('A new update of Simba is available!');
formWritelnEx(format('Current version is %d. Latest version is %d',[SimbaVersion,LatestVersion]));
end else
begin
mDebugLn(format('Current Simba version: %d',[SimbaVersion]));
mDebugLn('Latest Simba Version: ' + IntToStr(LatestVersion));
end;
time := StrToIntDef(LoadSettingDef('Settings/Updater/CheckEveryXMinutes','30'),30);
UpdateTimer.Interval:= time {mins} * 60 {secs} * 1000 {ms};//Every half hour
end;
@ -537,7 +558,7 @@ end;
procedure formWriteln( S : String);
begin
writeln('formWriteln: ' + s);
mDebugLn('formWriteln: ' + s);
{$ifdef MSWindows}
//Ha, we cán acces the debugmemo
Form1.Memo1.Lines.Add(s);
@ -566,7 +587,7 @@ begin
end else
if ScriptState <> ss_None then
begin;
Writeln('The script hasn''t stopped yet, so we cannot start a new one.');
FormWritelnEx('The script hasn''t stopped yet, so we cannot start a new one.');
exit;
end;
InitalizeTMThread(scriptthread);
@ -589,7 +610,7 @@ begin
ScriptThread.Suspended:= True;
ScriptState:= ss_Paused;
{$else}
Writeln('Linux users are screwed, no pause button for u!');
mDebugLn('Linux users are screwed, no pause button for u!');
{$endif}
end else if ScriptState = ss_Paused then
begin;
@ -606,8 +627,8 @@ begin
case ScriptState of
ss_Stopping:
begin //Terminate the thread the tough way.
writeln('Terminating the Scriptthread');
Writeln('Exit code terminate: ' +inttostr(KillThread(ScriptThread.Handle)));
mDebugLn('Terminating the Scriptthread');
mDebugLn('Exit code terminate: ' +inttostr(KillThread(ScriptThread.Handle)));
WaitForThreadTerminate(ScriptThread.Handle, 0);
ScriptThread.Free;
ScriptState := ss_None;
@ -771,7 +792,7 @@ begin
end
else
begin
Writeln('Searching: ' + SearchString);
mDebugLn('Searching: ' + SearchString);
if next then
CurrPos := CurrScript.SynEdit.LogicalCaretXY
else
@ -782,7 +803,7 @@ begin
res := CurrScript.SynEdit.SearchReplaceEx(SearchString,'',SearchOptions,Classes.Point(0,0));
if res > 0 then
begin;
Writeln('End of document reached');
mDebugLn('End of document reached');
SearchStart.x := 0;
SearchStart.Y := CurrScript.SynEdit.LogicalCaretXY.y;
end;
@ -818,7 +839,7 @@ var
begin
if tabs.Count < 1 then
begin;
Writeln('Cannot refresh tab, since there are no tabs.');
mDebugLn('Cannot refresh tab, since there are no tabs.');
exit;
end;
NewTab := PageControl1.TabIndex;
@ -840,6 +861,7 @@ begin
SetScriptState(Tab.ScriptFrame.FScriptState);//To set the buttons right
if Self.Showing then
if Tab.TabSheet.TabIndex = Self.PageControl1.TabIndex then
if CurrScript.SynEdit.CanFocus then
CurrScript.SynEdit.SetFocus;
StopCodeCompletion;//To set the highlighting back to normal;
frmFunctionList.LoadScriptTree(CurrScript.SynEdit.Text);
@ -913,6 +935,10 @@ begin
PluginsPath := CreateSetting('Settings/Plugins/Path', ExpandFileName(MainDir+ DS+ 'Plugins' + DS));
CreateSetting('LastConfig/MainForm/Position','');
CreateSetting('LastConfig/MainForm/State','Normal');
{$ifdef MSWindows}
CreateSetting('LastConfig/Console/Visible','True');
ShowConsole(True);
{$endif}
if not DirectoryExists(IncludePath) then
CreateDir(IncludePath);
if not DirectoryExists(FontPath) then
@ -960,6 +986,13 @@ begin
FunctionListShown(True)
else
FunctionListShown(false);
{$ifdef MSWindows}
str := LowerCase(LoadSettingDef('LastConfig/Console/Visible','True'));
if str = 'true' then
ShowConsole(True)
else
ShowConsole(false);
{$endif}
end;
procedure TForm1.SaveFormSettings;
@ -988,6 +1021,12 @@ begin
SetKeyValue('LastConfig/MainForm/FunctionListShown','True')
else
SetKeyValue('LastConfig/MainForm/FunctionListShown','False');
{$ifdef MSWindows}
if ConsoleVisible then
SetKeyValue('LastConfig/Console/Visible','True')
else
SetKeyValue('LastConfig/Console/Visible','false');
{$endif}
SaveToXML(SimbaSettingsFile);
end;
end;
@ -1040,7 +1079,7 @@ begin
else
Thread := TPSThread.Create(True,@CurrentSyncInfo,PluginsPath);
except
writeln('Failed to initialise the library!');
mDebugLn('Failed to initialise the library!');
Exit;
end;
{$IFNDEF TERMINALWRITELN}
@ -1065,10 +1104,10 @@ begin
PluginsGlob.AddPath(PluginsPath);
if not DirectoryExists(IncludePath) then
if FirstRun then
Writeln('Warning: The include directory specified in the Settings isn''t valid.');
FormWritelnEx('Warning: The include directory specified in the Settings isn''t valid.');
if not DirectoryExists(fontPath) then
if FirstRun then
Writeln('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now');
FormWritelnEx('Warning: The font directory specified in the Settings isn''t valid. Can''t load fonts now');
Thread.SetPaths(ScriptPath,AppPath,Includepath,PluginsPath,fontPath);
if selector.haspicked then Thread.Client.IOManager.SetTarget(Selector.LastPick);
@ -1101,7 +1140,7 @@ begin
begin;
ErrorMsg:=Application.CheckOptions('ro:','run open:');
if ErrorMsg <> '' then
writeln(ErrorMSG)
mDebugLn(ErrorMSG)
else
begin
if Application.HasOption('o','open') then
@ -1115,6 +1154,25 @@ begin
Self.RunScript;
end;
procedure TForm1.OnSaveScript(const Filename: string);
begin
with CurrScript do
begin
ScriptFile:= Filename;
ScriptName:= ExtractFileNameOnly(Filename);
mDebugLn('Script name will be: ' + ScriptName);
FormWritelnEx('Succesfully saved: ' + Filename);
StartText:= SynEdit.Lines.Text;
ScriptChanged := false;
SynEdit.MarkTextAsSaved;
Self.Caption:= Format(WindowTitle,[ScriptName]);
CurrTab.TabSheet.Caption:= ScriptName;
Self.AddRecentFile(FileName);
StatusBar.Panels[Panel_ScriptName].Text:= ScriptName;
StatusBar.Panels[Panel_ScriptPath].text:= ScriptFile;
end;
end;
procedure TForm1.ActionTabLastExecute(Sender: TObject);
var
@ -1145,6 +1203,13 @@ begin
TempThread.Resume;
end;
procedure TForm1.ActionConsoleExecute(Sender: TObject);
begin
{$ifdef mswindows}
ShowConsole(not ConsoleVisible);
{$endif}
end;
procedure TForm1.ActionCopyExecute(Sender: TObject);
begin
if CurrScript.SynEdit.Focused or ScriptPopup.HandleAllocated then
@ -1339,7 +1404,7 @@ begin
Self.Manager.GetMousePos(x, y);
if self.Manager.ReceivedError() then
begin
formWriteln('Our window no longer exists -> Resetting to desktop');
FormWritelnEx('Our window no longer exists -> Resetting to desktop');
self.Manager.SetDesktop;
self.Manager.ResetError;
end;
@ -1373,7 +1438,7 @@ begin
editSearchList.Color:= clWhite;
if FilterTree.Focused then
begin;
Writeln('This is currently not supported');
mDebugLn('This is currently not supported');
SynEdit.Lines[CompletionCaret.y - 1] := CompletionStart;
SynEdit.LogicalCaretXY:= Classes.point(CompletionCaret.x,CompletionCaret.y);
SynEdit.SelEnd:= SynEdit.SelStart;
@ -1578,6 +1643,12 @@ begin
MainDir:= ExtractFileDir(Application.ExeName);
RecentFiles := TStringList.Create;
SimbaSettingsFile := MainDir + DS + 'settings.xml';
{$ifdef MSWindows}
ConsoleVisible := False;
{$else}
TT_Console.Visible:= false;
InitmDebug;
{$endif}
if FileExists(SimbaSettingsFile) then
begin
Application.CreateForm(TSettingsForm,SettingsForm);
@ -1606,13 +1677,15 @@ begin
{$ifdef mswindows}
if FileExists(Application.ExeName+'_old_') then
begin
Writeln('We still have an out-dated exe file in the dir, lets remove!');
Writeln(format('Sucesfully deleted the file? %s',[BoolToStr(DeleteFile(PChar(Application.ExeName + '_old_')),true)]));
mDebugLn('We still have an out-dated exe file in the dir, lets remove!');
mDebugLn(format('Sucesfully deleted the file? %s',[BoolToStr(DeleteFile(PChar(Application.ExeName + '_old_')),true)]));
end;
SetConsoleCtrlHandler(@ConsoleHandler,true);
{$endif}
frmFunctionList.OnEndDock:= @frmFunctionList.FrameEndDock;
FirstRun := true;//Our next run is the first run.
HandleParameters;
TT_Update.Visible:= false;
end;
procedure TForm1.FormDestroy(Sender: TObject);
@ -1734,6 +1807,11 @@ begin;
end;
end;
procedure formWritelnEx(S: String);
begin
Form1.Memo1.Lines.Add(s);
end;
function GetMethodName( Decl : string; PlusNextChar : boolean) : string;
var
I : integer;
@ -1876,6 +1954,7 @@ begin
News := TStringList.Create;
News.Text:= s;
Memo1.Lines.AddStrings(News);
Memo1.Lines.add('');
News.free;
end;
@ -1902,7 +1981,7 @@ begin
ColourHistoryForm.AddColObj(cobj, true);
ColourHistoryForm.Show;
end;
formWriteln('Picked colour: ' + inttostr(c) + ' at (' + inttostr(x) + ', ' + inttostr(y) + ')');
FormWritelnEx('Picked colour: ' + inttostr(c) + ' at (' + inttostr(x) + ', ' + inttostr(y) + ')');
end;
@ -1910,7 +1989,7 @@ procedure TForm1.ButtonSelectorDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Manager.SetTarget(Selector.Drag);
writeln('New window: ' + IntToStr(Selector.LastPick));
FormWritelnEx('New window: ' + IntToStr(Selector.LastPick));
end;
procedure TForm1.NoTray(Sender: TObject);
@ -1943,7 +2022,7 @@ begin
PopupTab := PageControl1.TabIndexAtClientPos(MousePos);
if PopupTab = -1 then
begin
Writeln('We couldn''t find which tab you clicked on, closing the popup');
mDebugLn('We couldn''t find which tab you clicked on, closing the popup');
Handled := true;
end;
end;
@ -2042,6 +2121,24 @@ begin
result := SettingsForm.Settings.GetSetDefaultKeyValue(Key,value);
end;
{$ifdef mswindows}
procedure TForm1.ShowConsole(ShowIt: boolean);
begin
if ShowIt = ConsoleVisible then
Exit;
if showit then //Console is hidden, get it back!
begin
AllocConsole;
InitmDebug;//Make sure mDebugLn works correctly!
end else
begin
FreeConsole;
FreemDebug;
end;
ConsoleVisible:= ShowIt;
end;
{$endif}
procedure TForm1.FunctionListShown(ShowIt: boolean);
begin
with MenuItemFunctionList, frmFunctionList do
@ -2078,7 +2175,7 @@ procedure TForm1.SafeCallThread;
var
thread: TMThread;
begin
Writeln('Executing : ' + CurrentSyncInfo.MethodName);
mDebugLn('Executing : ' + CurrentSyncInfo.MethodName);
thread:= TMThread(CurrentSyncInfo.OldThread);
mmlpsthread.CurrThread:= thread;
try
@ -2138,7 +2235,7 @@ begin
SynEdit.Lines.LoadFromFile(FileName);
StartText := SynEdit.Lines.text;
ScriptName:= ExtractFileNameOnly(filename);
WriteLn('Script name will be: ' + ScriptName);
mDebugLn('Script name will be: ' + ScriptName);
ScriptFile:= FileName;
ScriptChanged := false;
AddRecentFile(filename);
@ -2155,22 +2252,18 @@ begin
Result := (ScriptFile <> '');
if Result then
begin;
ScriptChanged := false;
SynEdit.Lines.SaveToFile(ScriptFile);
StartText:= SynEdit.Lines.Text;
SynEdit.MarkTextAsSaved;
Self.Caption:= Format(WindowTitle,[ScriptName]);
OnSaveScript(scriptfile);
end
else
result := SaveCurrentScriptAs;
end;
RefreshTab;
end;
function TForm1.SaveCurrentScriptAs: boolean;
var
ScriptFile : string;
begin
with CurrScript do
begin;
Result := false;
with TSaveDialog.Create(nil) do
try
@ -2182,23 +2275,11 @@ begin
ScriptFile := FileName + '.simb';
end else
ScriptFile := FileName;
SynEdit.Lines.SaveToFile(ScriptFile);
ScriptName:= ExtractFileNameOnly(ScriptFile);
Writeln('Saving to: ' + FileName);
WriteLn('Script name will be: ' + ScriptName);
RefreshTab();
Result := True;
CurrScript.SynEdit.Lines.SaveToFile(ScriptFile);
OnSaveScript(scriptfile);
end;
finally
Free;
end;
if result then
begin;
Writeln('Succesfully saved: ' + ScriptFile);
StartText:= SynEdit.Lines.Text;
SynEdit.MarkTextAsSaved;
ScriptChanged := false;
end;
free;
end;
end;

12
trunk/Projects/SAMufasaGUI/updateform.pas
View File

@ -5,7 +5,7 @@ unit updateform;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
Classes, SysUtils, FileUtil, LResources, Forms,MufasaBase, Controls, Graphics, Dialogs,
ComCtrls, StdCtrls, updater;
type
@ -31,8 +31,6 @@ type
procedure CleanUpdateForm(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure UpdateButtonClick(Sender: TObject);
function CanUpdate: Boolean;
private
{ private declarations }
@ -47,9 +45,9 @@ type
SimbaVersionThread : TSimbaVersionThread;
private
function OnUpdateBeat: Boolean;
function GetLatestSimbaVersion: Integer;
public
{ public declarations }
function CanUpdate: Boolean;
function GetLatestSimbaVersion: Integer;
procedure PerformUpdate;
protected
FCancelled: Boolean;
@ -86,8 +84,8 @@ const
function TSimbaUpdateForm.CanUpdate: Boolean;
begin
GetLatestSimbaVersion;
Writeln(format('Current Simba version: %d',[TestUnit.SimbaVersion]));
Writeln('Latest Simba Version: ' + IntToStr(FSimbaVersion));
mDebugLn(format('Current Simba version: %d',[TestUnit.SimbaVersion]));
mDebugLn('Latest Simba Version: ' + IntToStr(FSimbaVersion));
Exit(testunit.SimbaVersion < FSimbaVersion);
end;

1
trunk/Units/MMLAddon/PSInc/Wrappers/ocr.inc
View File

@ -12,7 +12,6 @@ function BitmapFromText(text, font: String): integer; extdecl;
var
bmp: TMufasaBitmap;
begin
writeln('BitmapFromText: ' + text + ' ' + font);
bmp := CurrThread.Client.MOCR.TextToFontBitmap(text, font);
Result := CurrThread.Client.MBitmaps.AddBMP(bmp);
end;

4
trunk/Units/MMLAddon/PSInc/Wrappers/other.inc
View File

@ -47,7 +47,7 @@ begin
{$ifdef MSWINDOWS}
sndPlaySound(PChar(sound),SND_ASYNC or SND_NODEFAULT);
{$else}
Writeln(Format('Playing sound %s (not supported yet on Linux)',[sound]));
psWriteln(Format('Playing sound %s (not supported yet on Linux)',[sound]));
{$endif}
end;
@ -56,7 +56,7 @@ begin
{$ifdef MSWINDOWS}
sndPlaySoundW(nil,0);
{$else}
Writeln('Stopping sound is not supported yet on Linux');
psWriteln('Stopping sound is not supported yet on Linux');
{$endif}
end;

18
trunk/Units/MMLAddon/internets.pas
View File

@ -18,6 +18,7 @@ type
HTTPSend : THTTPSend;
fHandleCookies : boolean;
PostVariables : TStringList;
Client : TObject;
public
procedure SetHTTPUserAgent(agent : string);
function GetHTTPPage(url : string ) : string;
@ -26,7 +27,7 @@ type
function GetRawHeaders: string;
procedure ClearPostData;
procedure AddPostVariable(VarName, VarValue: string);
constructor Create(HandleCookies : boolean = true);
constructor Create(Owner : TObject; HandleCookies : boolean = true);
destructor Destroy;override;
end;
{ TMInternet }
@ -45,6 +46,8 @@ type
implementation
uses
Client;
{ OTHER }
function GetPage(URL: String): String;
var
@ -67,7 +70,7 @@ end;
function TMInternet.CreateHTTPClient(HandleCookies: boolean = true): integer;
begin;
Result := HTTPClients.Add(THTTPClient.Create(HandleCookies));
Result := HTTPClients.Add(THTTPClient.Create(Client,HandleCookies));
end;
function TMInternet.GetHTTPClient(Index: integer): THTTPClient;
@ -105,13 +108,13 @@ begin
if Connections[i] <> nil then
begin
TObject(Connections[i]).Free;
Writeln(Format('Connection[%d] has not been freed in the script, freeing it now.',[i]));
TClient(Client).Writeln(Format('Connection[%d] has not been freed in the script, freeing it now.',[i]));
end;
for i := HTTPClients.Count -1 downto 0 do
if HTTPClients[i] <> nil then
begin
THTTPClient(HTTPClients[i]).Free;
Writeln(Format('HTTPClient[%d] has not been freed in the script, freeing it now.',[i]));
TClient(Client).Writeln(Format('HTTPClient[%d] has not been freed in the script, freeing it now.',[i]));
end;
Connections.Free;
HTTPClients.Free;
@ -139,7 +142,7 @@ begin
result := '';
except
on e : exception do
Writeln('THTTPClient error: ' + e.message);
TClient(Client).Writeln('THTTPClient error: ' + e.message);
end;
end;
@ -157,7 +160,7 @@ begin
result := '';
except
on e : exception do
Writeln('THTTPClient error: ' + e.message);
TClient(Client).Writeln('THTTPClient error: ' + e.message);
end;
end;
@ -189,9 +192,10 @@ begin
PostVariables.Add(Varname + '=' + VarValue);
end;
constructor THTTPClient.Create(HandleCookies : boolean = true);
constructor THTTPClient.Create(Owner : TObject; HandleCookies : boolean = true);
begin
inherited Create;
Client := Owner;
HTTPSend := THTTPSend.Create;
fHandleCookies:= HandleCookies;
PostVariables := TStringList.Create;

10
trunk/Units/MMLAddon/mmlpsthread.pas
View File

@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, client, uPSComponent,uPSCompiler,
uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes, web,
uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes,MufasaBase, web,
bitmaps, plugins, libloader, dynlibs,internets;
@ -45,7 +45,6 @@ type
OldThread : TThread;
end;
TWritelnProc = procedure(s: string);
TClearDebugProc = procedure;
TDbgImgInfo = record
DispSize : ^TPoint;
@ -213,7 +212,7 @@ begin
if Assigned(CurrThread.DebugTo) then
CurrThread.DebugTo(str)
else
writeln(str);
mDebugLn(str);
end;
function MakeString(data : TPSVariantIFC) : string;
@ -397,6 +396,7 @@ end;
procedure TMThread.SetDebug(writelnProc: TWritelnProc);
begin
DebugTo := writelnProc;
Client.WritelnProc:= writelnProc;
end;
procedure TMThread.SetDebugClear(clearProc: TClearDebugProc);
@ -530,7 +530,7 @@ end;
function TPSThread.PSScriptFindUnknownFile(Sender: TObject;
const OrginFileName: string; var FileName, Output: string): Boolean;
begin
Writeln(OrginFileName + '-' + Output + '-' + FileName);
mDebugLn(OrginFileName + '-' + Output + '-' + FileName);
Result := false;
end;
@ -736,7 +736,7 @@ begin
end;
except
on E : Exception do
psWriteln('ERROR IN PSSCRIPT: ' + e.message);
psWriteln('Exception in Script: ' + e.message);
end;
end;

20
trunk/Units/MMLAddon/settings.pas
View File

@ -28,7 +28,7 @@ unit settings;
interface
uses
Classes, SysUtils, ComCtrls, xmlread, xmlwrite, DOM,mufasatypes;
Classes, SysUtils, ComCtrls, xmlread, xmlwrite, DOM,mufasatypes,MufasaBase;
@ -411,7 +411,7 @@ begin
if length(path) < 2 then
begin
writeln('Path too short!');
mDebugLn('CreateKey - Path too short!');
exit(false);
end;
nParent := WalkToNode(path[0]);
@ -426,7 +426,7 @@ begin
begin
if Path[i] = '' then
begin
writeln('Invalid Key Path / Name');
mDebugLn('CreateKey - Invalid Key Path / Name');
exit(false);
end;
NewPath := NewPath + Path[i] + '/';
@ -441,7 +441,7 @@ begin
newN.Text := Path[i];
if (nParent = nil) then
begin
writeln('This shouldn''t happen...');
mDebugLn('CreateKey - This shouldn''t happen...');
newN.MoveTo(Nodes.GetFirstNode, naAddChild);
nParent := newN;
end
@ -474,12 +474,12 @@ var
begin
if not KeyExists(KeyName) then
begin
writeln('SetKeyValue - Key does not exist');
mDebugLn('SetKeyValue - Key does not exist');
Exit;
end;
if not IsKey(KeyName) then
begin
writeln('SetKeyValue - IsKey returned false');
mDebugLn('SetKeyValue - IsKey returned false');
Exit;
end;
N := WalkToNode(KeyName);
@ -499,7 +499,7 @@ begin
TSettingData(N.Data).Free;
N.Data := TSettingData.Create;
TSettingData(N.Data).Val := KeyValue;
writeln('Setting ' + KeyName + ' to ' + KeyValue);
mDebugLn('Setting ' + KeyName + ' to ' + KeyValue);
N := N.GetNextSibling;
end;
end;
@ -513,7 +513,7 @@ begin
Nodes.Clear;
if not fileExists(fileName) then
begin
writeln('SettingsFile hasn''t been created yet.');
mDebugLn('SettingsFile hasn''t been created yet.');
// create file.
SaveToXML(fileName);
end;
@ -527,7 +527,7 @@ procedure TMMLSettings.WriteXMLData(n: TTreeNode;
var XMLChild: TDOMNode; var C: Integer);
begin
if assigned(n.data) and (n.HasChildren) then
writeln('Has data and children! Please close simba and remove settings.xml. if problem persists, please report your settings.xml');
mDebugLn('WriteXMLData - Has data and children! Please close simba and remove settings.xml. if problem persists, please report your settings.xml');
if assigned(n.Data) then
begin
XMLChild := XMLDoc.CreateTextNode(TSettingData(N.Data).Val);
@ -588,7 +588,7 @@ begin
try
WriteXMLFile(XMLDoc, fileName);
except
Writeln('Failed to write ' + fileName);
mDebugLn('Failed to write ' + fileName);
end;
XMLDoc.Free;
end;

12
trunk/Units/MMLAddon/updater.pas
View File

@ -5,7 +5,7 @@ unit updater;
interface
uses
Classes, SysUtils, httpsend,blcksock
Classes, SysUtils, httpsend,MufasaBase,blcksock
{$IFDEF LINUX}
,BaseUnix
{$ENDIF};
@ -175,7 +175,7 @@ begin
end;
FDownloaded := True;
except
writeln('DownloadAndSave: Exception Occured');
mDebugLn('DownloadAndSave: Exception Occured');
Result := False;
end;
HTTPSend.Free;
@ -189,25 +189,25 @@ begin
{ Change to messages + Exit(False) instead of exceptions? }
if not Downloaded then
begin
writeln('Nothing downloaded');
mDebugLn('Nothing downloaded');
exit(False);
// raise Exception.Create('Nothing downloaded');
end;
if FReplacementFile = '' then
begin
writeln('ReplacementFile not se');
mDebugLn('ReplacementFile not se');
exit(False);
//raise Exception.Create('ReplacementFile not set');
end;
if not FileExists(FBasePath + FReplacementFile) then
begin
writeln('ReplacementFile not found');
mDebugLn('ReplacementFile not found');
exit(False);
//raise Exception.Create('ReplacementFile not found');
end;
if not FileExists(FBasePath + FReplacementFile+ '_') then
begin
writeln('ReplacementFile + _ not found');
mDebugLn('ReplacementFile + _ not found');
exit(False);
//raise Exception.Create('ReplacementFile + _ not found');
end;

6
trunk/Units/MMLAddon/windowselector.pas
View File

@ -119,13 +119,13 @@ begin
if Result <> Tempwindow then
begin
writeln('Making ' + inttostr(tempwindow) + ' transparent');
mDebugLn('Making ' + inttostr(tempwindow) + ' transparent');
XChangeProperty(manager.display, tempwindow, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_75, 1);
writeln('Resetting ' + inttostr(Result));
mDebugLn('Resetting ' + inttostr(Result));
if result <> 0 then
XChangeProperty(manager.display, Result, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_100, 1);
WriteLn('Changing Window from: ' + Inttostr(result) +' to: ' + IntToStr(Tempwindow));
mDebugLn('Changing Window from: ' + Inttostr(result) +' to: ' + IntToStr(Tempwindow));
// XChangeProperty(Window.XDisplay, tempwindow, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_50, 1);
Result := Tempwindow;

16
trunk/Units/MMLCore/bitmaps.pas
View File

@ -27,7 +27,7 @@ unit bitmaps;
interface
uses
Classes, SysUtils, FPImage,IntfGraphics,graphtype,MufasaTypes,graphics;
Classes, SysUtils, FPImage,IntfGraphics,graphtype,MufasaTypes,MufasaBase,graphics;
type
@ -119,7 +119,7 @@ type
implementation
uses
paszlib,DCPbase64,math,
paszlib,DCPbase64,math, client,
colour_conv,IOManager,mufasatypesutil;
// Needs more fixing. We need to either copy the memory ourself, or somehow
@ -392,9 +392,9 @@ begin
end;
//Just for testing purposes
if ToDestroy.BmpName = '' then
Writeln(Format('BMP[%d] has been freed.',[number]))
TClient(Self.Client).Writeln(Format('BMP[%d] has been freed.',[number]))
else
Writeln(Format('BMP[%s] has been freed.',[ToDestroy.BmpName]));
TClient(Self.Client).Writeln(Format('BMP[%s] has been freed.',[ToDestroy.BmpName]));
ToDestroy.Free;
BmpArray[number] := nil;
end;
@ -838,10 +838,10 @@ begin
if NewCorners[i].y < MinY then
MinY := NewCorners[i].y;
end;
Writeln(Format('Min: (%d,%d) Max : (%d,%d)',[MinX,MinY,MaxX,MaxY]));
mDebugLn(Format('Min: (%d,%d) Max : (%d,%d)',[MinX,MinY,MaxX,MaxY]));
NewW := MaxX - MinX+1;
NewH := MaxY - MinY+1;
Writeln(format('New bounds: %d,%d',[NewW,NewH]));
mDebugLn(format('New bounds: %d,%d',[NewW,NewH]));
TargetBitmap.SetSize(NewW,NewH);
for y := NewH - 1 downto 0 do
for x := NewW - 1 downto 0 do
@ -1126,9 +1126,9 @@ begin
if BmpArray[i] <> nil then
begin;
if BmpArray[i].BmpName = '' then
Writeln(Format('BMP[%d] has not been freed in the script, freeing it now.',[i]))
TClient(Client).Writeln(Format('BMP[%d] has not been freed in the script, freeing it now.',[i]))
else
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].BmpName]));
FreeAndNil(BmpArray[i]);
end;
SetLength(BmpArray,0);

23
trunk/Units/MMLCore/client.pas
View File

@ -29,7 +29,7 @@ unit Client;
interface
uses
Classes, SysUtils, MufasaTypes,
Classes, SysUtils, MufasaTypes,MufasaBase,
IOManager, Files, Finder, Bitmaps, dtm, ocr,
{$IFDEF MSWINDOWS} os_windows {$ENDIF}
{$IFDEF LINUX} os_linux {$ENDIF};
@ -41,9 +41,6 @@ It binds all the components together.
type
TClient = class(TObject)
constructor Create(plugin_dir: string);
destructor Destroy; override;
public
IOManager: TIOManager;
MFiles: TMFiles;
@ -51,17 +48,31 @@ It binds all the components together.
MBitmaps : TMBitmaps;
MDTM: TMDTM;
MOCR: TMOCR;
WritelnProc : TWritelnProc;
procedure WriteLn(s : string);
constructor Create(plugin_dir: string);
destructor Destroy; override;
end;
implementation
procedure TClient.WriteLn(s: string);
begin
if Assigned(WritelnProc) then
WritelnProc(s)
else
mDebugLn(s);
end;
// Possibly pass arguments to a default window.
constructor TClient.Create(plugin_dir: string);
begin
inherited Create;
WritelnProc:= nil;
IOManager:= TIOManager.Create(plugin_dir);
MFiles := TMFiles.Create;
MFiles := TMFiles.Create(self);
MFinder := TMFinder.Create(Self);
MBitmaps := TMBitmaps.Create(self);
MDTM := TMDTM.Create(self);

10
trunk/Units/MMLCore/dtm.pas
View File

@ -77,6 +77,7 @@ type
implementation
uses
dtmutil, paszlib,
client,
graphics, // for TColor
math // for max
;
@ -112,9 +113,9 @@ begin
if not b then
begin;
if DTMList[i].n <> '' then
Writeln(Format('DTM[%s] has not been freed in the script, freeing it now.',[DTMList[i].n]))
TClient(Client).Writeln(Format('DTM[%s] has not been freed in the script, freeing it now.',[DTMList[i].n]))
else
writeln(Format('DTM[%d] has not been freed in the script, freeing it now.',[i]));
TClient(Client).Writeln(Format('DTM[%d] has not been freed in the script, freeing it now.',[i]));
FreeDTM(i);
end;
end;
@ -167,10 +168,7 @@ begin
if uncompress(Bufferstring,Destlen,pchar(Source), ii) = Z_OK then
begin;
if (Destlen mod 36) > 0 then
begin;
Writeln('Invalid DTM');
Exit;
end;
raise Exception.CreateFmt('Invalid DTM passed to StringToDTM: %s',[s]);
DestLen := DestLen div 36;
SetLength(Result.p,DestLen);
SetLength(Result.c,DestLen);

8
trunk/Units/MMLCore/dtmutil.pas
View File

@ -52,7 +52,7 @@ const
dtm_Triangle = 4;
implementation
uses math;
uses math,MufasaBase;
procedure RotatePoints_(Var P: TPointArray; A, cx, cy: Extended);
@ -105,10 +105,10 @@ var
begin;
i := 0;
if adtm.n <> '' then
writeln('Name: ' + aDTM.n);
WriteLn('MainPoint ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i])+ ', Bad Point: ' + BoolToStr(aDTM.bp[i]));
mDebugLn('Name: ' + aDTM.n);
mDebugLn('MainPoint ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i])+ ', Bad Point: ' + BoolToStr(aDTM.bp[i]));
for I := 1 to High(aDTM.p) do
WriteLn('SubPoint['+IntToStr(I) + '] ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i]) + ', Bad Point: ' + BoolToStr(aDTM.bp[i]));
mDebugLn('SubPoint['+IntToStr(I) + '] ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i]) + ', Bad Point: ' + BoolToStr(aDTM.bp[i]));
end;
Function pDTMToTDTM(Const DTM: pDTM): TDTM;

100
trunk/Units/MMLCore/files.pas
View File

@ -40,7 +40,7 @@ type
TMufasaFilesArray = Array Of TMufasaFile;
TMFiles = class(TObject)
constructor Create;
constructor Create(Owner : TObject);
destructor Destroy; override;
public
function CreateFile(Path: string): Integer;
@ -56,6 +56,7 @@ type
protected
MFiles: TMufasaFilesArray;
FreeSpots: Array Of Integer;
Client : TObject;
private
procedure FreeFileList;
function AddFileToManagedList(Path: string; FS: TFileStream; Mode: Integer): Integer;
@ -68,7 +69,7 @@ type
implementation
uses
{$IFDEF MSWINDOWS}Windows,{$ENDIF} IniFiles;
{$IFDEF MSWINDOWS}Windows,{$ENDIF} IniFiles,Client;
{ GetFiles in independant of the TMFiles class }
@ -108,9 +109,10 @@ begin
end;
end;
constructor TMFiles.Create;
constructor TMFiles.Create(Owner : TObject);
begin
inherited Create;
self.Client := Owner;
SetLength(Self.MFiles, 0);
SetLength(Self.FreeSpots, 0);
end;
@ -122,11 +124,11 @@ begin;
For I := 0 To High(MFiles) Do
If MFiles[i].FS <> nil Then
Begin
Writeln(Format('File[%s] has not been freed in the script, freeing it now.',[MFiles[i].Path]));
TClient(Client).Writeln(Format('File[%s] has not been freed in the script, freeing it now.',[MFiles[i].Path]));
Try
MFiles[I].FS.Free;
Except
WriteLn('FreeFileList - Exception when freeing');
TClient(Client).Writeln('FreeFileList - Exception when freeing FileStream');
End;
End;
SetLength(MFiles, 0);
@ -168,11 +170,7 @@ End;
Function TMFiles.SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
Begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
Begin
WriteLn('Invalid File Num');
Result := -1;
Exit;
End;
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
{If Files[FileNum].Handle = -1 Then
Begin
@ -184,32 +182,21 @@ Begin
case Origin of
fsFromBeginning:
If(cChars < 0) Then
Begin
Writeln('fsFromBeginning takes no negative cChars.');
Result := -1;
Exit;
End;
raise Exception.CreateFmt('fsFromBeginning takes no negative cChars. (%d)',[cChars]);
fsFromCurrent:
;
fsFromEnd:
If(cChars > 0) Then
Begin
Writeln('fsFromEnd takes no positive cChars.');
Result := -1;
Exit;
End;
raise Exception.CreateFmt('fsFromEnd takes no positive cChars. (%d)',[cChars]);
else
Begin
WriteLn('Invalid Origin: ' + IntToStr(Origin));
Result := -1;
Exit;
End;
End;
raise Exception.CreateFmt('Invalid Origin: %d',[Origin]);
end;
Try
Result := MFiles[FileNum].FS.Seek(cChars, Origin);
Except
WriteLn('SetFileCharPointer - Exception Occured.');
TClient(Client).Writeln('SetFileCharPointer - Exception Occured.');
Result := -1;
End;
//Result := FileSeek(Files[FileNum].Handle, cChars, Origin);
End;
@ -230,7 +217,7 @@ begin
FS := TFileStream.Create(Path, fmCreate);
Except
Result := -1;
WriteLn('CreateFile - Exception. Could not create file. Returning -1');
TClient(Client).Writeln(Format('CreateFile - Exception. Could not create file: %s',[path]));
Exit;
End;
@ -259,7 +246,7 @@ begin
FS := TFileStream.Create(Path, fMode)
Except
Result := -1;
WriteLn('OpenFile - Exception. Could not create file. Returning -1');
TClient(Client).Writeln(Format('OpenFile - Exception. Could not open file: %s',[path]));
Exit;
End;
@ -299,7 +286,7 @@ begin
FS := TFileStream.Create(Path, fMode);
Except
Result := -1;
WriteLn('ReWriteFile - Exception. Could not create file. Returning -1');
TClient(Client).Writeln(Format('ReWriteFile - Exception. Could not create file: %s',[path]));
Exit;
End;
@ -324,17 +311,13 @@ end;
procedure TMFiles.CloseFile(FileNum: Integer);
begin
//Writeln('Length of Files: ' + IntToStr(Length(Files)));
If (FileNum >= Length(MFiles)) or (FileNum < 0) Then
Begin
WriteLn('CloseFile. Invalid FileNum: ' + IntToStr(FileNum));
Exit;
End;
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
Try
MFiles[FileNum].FS.Free;
Except
WriteLn('CloseFile, exception when freeing the file...');
TClient(Client).Writeln(Format('CloseFile, exception when freeing the file: %d',[filenum]));
Exit;
End;
@ -359,14 +342,10 @@ end;
function TMFiles.EndOfFile(FileNum: Integer): Boolean;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
Begin
WriteLn('Invalid File Num');
Result := True;
Exit;
End;
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
WriteLn('EndOfFile: Invalid Internal Handle');
TClient(Client).Writeln(format('EndOfFile: Invalid Internal Handle of File: %d',[filenum]));
Result := True;
Exit;
End;
@ -380,17 +359,12 @@ end;
function TMFiles.FileSizeMuf(FileNum: Integer): LongInt;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
Begin
WriteLn('Invalid File Num');
Result := -1;
Exit;
End;
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
WriteLn('FileSize: Invalid Internal Handle');
TClient(Client).Writeln(format('FileSize: Invalid Internal Handle of File: %d',[filenum]));
Result := -1;
Exit;
End;
@ -417,14 +391,10 @@ end;
function TMFiles.FilePointerPos(FileNum: Integer): Integer;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
Begin
WriteLn('Invalid File Num');
Result := -1;
Exit;
End;
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
WriteLn('FileSize: Invalid Internal Handle');
TClient(Client).Writeln(format('FilePointerPos: Invalid Internal Handle of File: %d',[filenum]));
Result := -1;
Exit;
End;
@ -432,7 +402,7 @@ begin
try
Result := MFiles[FileNum].FS.Seek(0, fsFromCurrent);
Except
WriteLn('Exception in FilePointerPos');
TClient(Client).Writeln('Exception in FilePointerPos');
End;
//Result := FileSeek(Files[FileNum].FS, 0, fsFromCurrent);
end;
@ -445,14 +415,10 @@ function TMFiles.ReadFileString(FileNum: Integer; out s: string; x: Integer): Bo
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
Begin
WriteLn('Invalid File Num');
Result := False;
Exit;
End;
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
WriteLn('ReadFileString: Invalid Internal Handle');
TClient(Client).Writeln(format('ReadFileString: Invalid Internal Handle of File: %d',[filenum]));
Exit;
End;
@ -472,14 +438,10 @@ end;
function TMFiles.WriteFileString(FileNum: Integer; s: string): Boolean;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
Begin
WriteLn('Invalid File Num');
Result := False;
Exit;
End;
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If(MFiles[FileNum].FS = nil) Then
Begin
WriteLn('WriteFileString: Invalid Internal Handle');
TClient(Client).Writeln(format('WriteFileString: Invalid Internal Handle of File: %d',[filenum]));
Result := False;
Exit;
End;
@ -493,7 +455,7 @@ begin
try
Result := MFiles[FileNum].FS.Write(S[1], Length(S)) <> 1;
except
WriteLn('Exception - WriteFileString.');
TClient(Client).Writeln('Exception - WriteFileString.');
Result := False;
end;

8
trunk/Units/MMLCore/finder.pas
View File

@ -30,7 +30,7 @@ interface
{$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks).
uses
Classes, SysUtils,bitmaps, MufasaTypes; // Types
Classes, SysUtils,bitmaps,MufasaBase, MufasaTypes; // Types
{ TMFinder Class }
@ -1515,7 +1515,7 @@ begin
//We wont want HSL comparison with BMPs, right? Not for now atleast.
if CCTS > 1 then
begin
Writeln('CTS > 1, putting it temporary back to 1. For this (bitmap)search');
mDebugLn('CTS > 1, putting it temporary back to 1. For this (bitmap)search');
CCTS := 1;
end;
//Get the "skip coords".
@ -1652,7 +1652,7 @@ begin
CCTS := Self.CTS;
if CCTS > 1 then
begin
Writeln('CTS > 1, putting it temporary back to 1. For this (bitmap)search');
mDebugLn('CTS > 1, putting it temporary back to 1. For this (bitmap)search');
CCTS := 1;
end;
//Get the "skip coords".
@ -1727,7 +1727,7 @@ begin
CCTS := Self.CTS;
if CCTS > 1 then
begin
Writeln('CTS > 1, putting it temporary back to 1. For this (bitmap)search');
mDebugLn('CTS > 1, putting it temporary back to 1. For this (bitmap)search');
CCTS := 1;
end;
FoundC := 0;

15
trunk/Units/MMLCore/fontloader.pas
View File

@ -58,8 +58,9 @@ type
private
Fonts: TList;
Path: String;
Client : TObject;
public
constructor Create;
constructor Create(Owner : TObject);
destructor Destroy; override;
function GetFont(Name: String): TOcrData;
@ -75,7 +76,7 @@ type
implementation
uses
MufasaTypes;
MufasaTypes,Client;
constructor TMFont.Create;
@ -139,12 +140,12 @@ begin
result := TMfont(Fonts.Items[index]);
end;
constructor TMFonts.Create;
constructor TMFonts.Create(Owner : TObject);
begin
inherited;
inherited Create;
Fonts := TList.Create;
Client := Owner;
end;
destructor TMFonts.Destroy;
@ -223,7 +224,7 @@ begin
f.Data := ocrdata;
Fonts.Add(f);
{$IFDEF FONTDEBUG}
writeln('Loaded Font ' + f.Name);
TClient(Client).Writeln('Loaded Font ' + f.Name);
{$ENDIF}
end;
@ -232,7 +233,7 @@ function TMFonts.Copy: TMFonts;
var
i:integer;
begin
Result := TMFonts.Create;
Result := TMFonts.Create(Client);
Result.Path := Self.GetPath();
for i := 0 to Self.Fonts.Count -1 do
Result.Fonts.Add(TMFont(Self.Fonts.Items[i]).Copy());

8
trunk/Units/MMLCore/libloader.pas
View File

@ -36,7 +36,7 @@ interface
implementation
uses
MufasaTypes,FileUtil;
MufasaTypes,MufasaBase,FileUtil;
procedure TGenericLoader.AddPath(path: string);
var
@ -47,7 +47,7 @@ implementation
//IDK who changed this to loading a dir, but DON'T
if not PluginDirs.Find(verified,idx) then
begin
writeln('Adding Plugin Path: ' + verified);
mDebugLn('Adding Plugin Path: ' + verified);
PluginDirs.Add(verified);
end;
end;
@ -60,7 +60,7 @@ implementation
begin;
if (Loaded[i].handle > 0) then
try
Writeln(inttostr(I));
mDebugLn('Freeing plugin[%d]',[i]);
FreeLibrary(Loaded[i].handle);
except
end;
@ -136,7 +136,7 @@ implementation
if Loaded[i].filename = (PluginDirs.Strings[ii] + PluginName + PlugExt) then
Exit(i);
SetLength(Loaded,PluginLen + 1);
Writeln(Format('Loading plugin %s at %s',[PluginName,PluginDirs.Strings[ii]]));
mDebugLn(Format('Loading plugin %s at %s',[PluginName,PluginDirs.Strings[ii]]));
Loaded[PluginLen].filename:= PluginDirs.Strings[ii] + Pluginname + PlugExt;
Loaded[PluginLen].handle:= LoadLibrary(Loaded[PluginLen].filename);
if Loaded[PluginLen].handle = 0 then

50
trunk/Units/MMLCore/mufasabase.pas Normal file
View File

@ -0,0 +1,50 @@
unit mufasabase;
{$mode objfpc}
interface
uses
files, Classes, SysUtils{$ifdef MSWindows},windows{$endif};
procedure mDebugLn( s : string);overload;
procedure mDebugLn( s : string; f : array of const);overload;
procedure InitmDebug;
procedure FreemDebug;
implementation
uses
TestUnit;
var
CanDebug : boolean = false;
procedure mDebugLn(s: string);
begin
if CanDebug then
Writeln(s);
end;
procedure mDebugLn(s: string; f: array of const); overload;
begin
mDebugLn(format(s,f));
end;
procedure InitmDebug;
begin
CanDebug := true;
{$ifdef MSWindows}
IsConsole:= True;
SysInitStdIO;
{$endif}
end;
procedure FreemDebug;
begin
CanDebug := false;
{$ifdef MSWindows}
IsConsole := false;
{$endif}
end;
end.

1
trunk/Units/MMLCore/mufasatypes.pas
View File

@ -121,6 +121,7 @@ type
SubPoints: TDTMPointDefArray;
end;
TWritelnProc = procedure(s: string);
type
VirtualKeyInfo = record
Str : string;

21
trunk/Units/MMLCore/ocr.pas
View File

@ -28,7 +28,7 @@ unit ocr;
interface
uses
Classes, SysUtils, MufasaTypes, bitmaps, math, ocrutil, fontloader,
Classes, SysUtils, MufasaTypes,MufasaBase, bitmaps, math, ocrutil, fontloader,
{Begin To-Remove units. Replace ReadBmp with TMufasaBitmap stuff later.}
graphtype, intfgraphics,graphics;
{End To-Remove unit}
@ -121,7 +121,7 @@ constructor TMOCR.Create(Owner: TObject);
begin
inherited Create;
Self.Client := Owner;
Self.Fonts := TMFonts.Create;
Self.Fonts := TMFonts.Create(Owner);
end;
{ Destructor }
@ -150,9 +150,6 @@ begin
begin
if Fonts.LoadFont(dirs[i], false) then
result := true;
{$IFDEF FONTDEBUG}
writeln('Loading ' + dirs[i]);
{$ENDIF}
end;
If DirectoryExists(path + 'UpChars') then
Fonts.LoadFont('UpChars', true); // shadow
@ -564,9 +561,9 @@ begin
begin // more than one char
{$IFDEF OCRDEBUG}
if length(chars_2d[y]) > 70 then
writeln('more than one char at y: ' + inttostr(y));
mDebugLn('more than one char at y: ' + inttostr(y));
if (bb.x2 - bb.x1 > 10) then
writeln('too wide at y: ' + inttostr(y));
mDebugLn('too wide at y: ' + inttostr(y));
{$ENDIF}
helpershadow:=getshadows(shadowsbmp,chars_2d[y]);
chars_2d_b := splittpaex(helpershadow,2,shadowsbmp.height);
@ -649,17 +646,11 @@ begin
begin
font := Fonts.GetFont('UpChars_s');
thachars := shadows;
{$IFDEF OCRDEBUG}
writeln('using shadows');
{$ENDIF}
end
else
begin
font := Fonts.GetFont('UpChars');
thachars := chars;
{$IFDEF OCRDEBUG}
writeln('not using shadows');
{$ENDIF}
end;
lbset:=false;
@ -841,11 +832,10 @@ begin
for i := 1 to length(text) do
begin
writeln(text[i]);
an := Ord(text[i]);
if not InRange(an, 0, 255) then
begin
writeln('WARNING: Invalid character passed to TextToFontTPA');
mDebugLn('WARNING: Invalid character passed to TextToFontTPA');
continue;
end;
d := fontD.ascii[an];
@ -879,7 +869,6 @@ var
begin
TPA := TextToFontTPA(text, font, w, h);
bmp := TMufasaBitmap.Create;
writeln(format('b: %d, %d', [w, h]));
bmp.SetSize(w, h);
bmp.DrawTPA(TPA, clWhite);
result := bmp;

20
trunk/Units/MMLCore/os_linux.pas
View File

@ -148,14 +148,14 @@ implementation
xerror := 'UNKNOWN';
end;
result := 0;
Writeln('X Error: ');
writeln('Error code: ' + inttostr(para2^.error_code));
writeln('Display: ' + inttostr(LongWord(para2^.display)));
writeln('Minor code: ' + inttostr(para2^.minor_code));
writeln('Request code: ' + inttostr(para2^.request_code));
writeln('Resource ID: ' + inttostr(para2^.resourceid));
writeln('Serial: ' + inttostr(para2^.serial));
writeln('Type: ' + inttostr(para2^._type));
mDebugLn('X Error: ');
mDebugLn('Error code: ' + inttostr(para2^.error_code));
mDebugLn('Display: ' + inttostr(LongWord(para2^.display)));
mDebugLn('Minor code: ' + inttostr(para2^.minor_code));
mDebugLn('Request code: ' + inttostr(para2^.request_code));
mDebugLn('Resource ID: ' + inttostr(para2^.resourceid));
mDebugLn('Serial: ' + inttostr(para2^.serial));
mDebugLn('Type: ' + inttostr(para2^._type));
end;
function TWindow.GetError: String;
@ -271,8 +271,8 @@ implementation
buffer := XGetImage(display, window, xs, ys, width, height, AllPlanes, ZPixmap);
if buffer = nil then
begin
Writeln('ReturnData: XGetImage Error. Dumping data now:');
Writeln('xs, ys, width, height: ' + inttostr(xs) + ', ' + inttostr(ys) +
mDebugLn('ReturnData: XGetImage Error. Dumping data now:');
mDebugLn('xs, ys, width, height: ' + inttostr(xs) + ', ' + inttostr(ys) +
', ' + inttostr(width) + ', ' + inttostr(height));
Result.Ptr := nil;
Result.IncPtrWith := 0;

7
trunk/Units/MMLCore/os_windows.pas
View File

@ -181,7 +181,7 @@ implementation
destructor TWindow.Destroy;
begin
ReleaseDC(handle,dc);
ReleaseDC(handle,dc);//Dogdy as one might have used .create and not set a handle..
buffer.Free;
keyinput.Free;
inherited Destroy;
@ -283,8 +283,8 @@ implementation
Rect := WindowRect;
x := x + rect.left;
y := y + rect.top;
if (x<0) or (y<0) then
writeln('Negative coords, what now?');
{ if (x<0) or (y<0) then
writeln('Negative coords, what now?');}
Windows.SetCursorPos(x, y);
end;
procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
@ -416,7 +416,6 @@ begin
inherited Create;
self.dc := GetDC(DesktopHandle);
self.handle:= DesktopHandle;
Writeln('Created a desktop window');
end;

1
trunk/Units/MMLCore/tpa.pas
View File

@ -696,7 +696,6 @@ var
SizeArr: TIntegerArray;
begin
l := High(a);
Writeln(inttostr(l));
if (l < 0) then Exit;
SetLength(SizeArr, l + 1);
for i := 0 to l do