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

Added freeze() to colour test.

Browse Source 
Fixed a bug in cts 0, made cst 1 20% faster. Only cts 2 left to optimise.
(Can be optimised a lot!)



git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@94 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-09-29 02:12:29 +00:00
parent 8ae45b0237
commit 950bf6cfa9
8 changed files with 697 additions and 648 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

313
Projects/SAMufasaGUI/project1.lpi
View File

@ -33,15 +33,15 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item2> </Item2>
</RequiredPackages> </RequiredPackages>
<Units Count="123"> <Units Count="125">
<Unit0> <Unit0>
<Filename Value="project1.lpr"/> <Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="project1"/> <UnitName Value="project1"/>
<CursorPos X="17" Y="12"/> <CursorPos X="10" Y="7"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="141"/> <UsageCount Value="143"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -170,10 +170,10 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="TestUnit"/> <UnitName Value="TestUnit"/>
<CursorPos X="51" Y="133"/> <CursorPos X="37" Y="115"/>
<TopLine Value="110"/> <TopLine Value="83"/>
<EditorIndex Value="8"/> <EditorIndex Value="10"/>
<UsageCount Value="107"/> <UsageCount Value="109"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit18> </Unit18>
<Unit19> <Unit19>
@ -305,7 +305,7 @@
<CursorPos X="25" Y="17"/> <CursorPos X="25" Y="17"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="4"/> <EditorIndex Value="4"/>
<UsageCount Value="106"/> <UsageCount Value="108"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit37> </Unit37>
<Unit38> <Unit38>
@ -315,7 +315,7 @@
<CursorPos X="69" Y="25"/> <CursorPos X="69" Y="25"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="3"/> <EditorIndex Value="3"/>
<UsageCount Value="106"/> <UsageCount Value="108"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit38> </Unit38>
<Unit39> <Unit39>
@ -331,7 +331,7 @@
<UnitName Value="files"/> <UnitName Value="files"/>
<CursorPos X="37" Y="42"/> <CursorPos X="37" Y="42"/>
<TopLine Value="271"/> <TopLine Value="271"/>
<UsageCount Value="107"/> <UsageCount Value="109"/>
</Unit40> </Unit40>
<Unit41> <Unit41>
<Filename Value="../../Units/MMLCore/window.pas"/> <Filename Value="../../Units/MMLCore/window.pas"/>
@ -339,8 +339,8 @@
<UnitName Value="Window"/> <UnitName Value="Window"/>
<CursorPos X="24" Y="84"/> <CursorPos X="24" Y="84"/>
<TopLine Value="75"/> <TopLine Value="75"/>
<EditorIndex Value="9"/> <EditorIndex Value="12"/>
<UsageCount Value="106"/> <UsageCount Value="108"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit41> </Unit41>
<Unit42> <Unit42>
@ -355,8 +355,8 @@
<UnitName Value="CompTypes"/> <UnitName Value="CompTypes"/>
<CursorPos X="59" Y="545"/> <CursorPos X="59" Y="545"/>
<TopLine Value="524"/> <TopLine Value="524"/>
<EditorIndex Value="14"/> <EditorIndex Value="16"/>
<UsageCount Value="17"/> <UsageCount Value="18"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit43> </Unit43>
<Unit44> <Unit44>
@ -364,8 +364,8 @@
<UnitName Value="windowutil"/> <UnitName Value="windowutil"/>
<CursorPos X="86" Y="19"/> <CursorPos X="86" Y="19"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="10"/> <EditorIndex Value="13"/>
<UsageCount Value="35"/> <UsageCount Value="36"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit44> </Unit44>
<Unit45> <Unit45>
@ -374,17 +374,17 @@
<CursorPos X="32" Y="251"/> <CursorPos X="32" Y="251"/>
<TopLine Value="220"/> <TopLine Value="220"/>
<EditorIndex Value="5"/> <EditorIndex Value="5"/>
<UsageCount Value="15"/> <UsageCount Value="16"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit45> </Unit45>
<Unit46> <Unit46>
<Filename Value="../../Units/MMLCore/finder.pas"/> <Filename Value="../../Units/MMLCore/finder.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="finder"/> <UnitName Value="finder"/>
<CursorPos X="57" Y="15"/> <CursorPos X="70" Y="304"/>
<TopLine Value="2"/> <TopLine Value="272"/>
<EditorIndex Value="1"/> <EditorIndex Value="11"/>
<UsageCount Value="99"/> <UsageCount Value="101"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit46> </Unit46>
<Unit47> <Unit47>
@ -400,7 +400,7 @@
<UnitName Value="MMLThread"/> <UnitName Value="MMLThread"/>
<CursorPos X="132" Y="5"/> <CursorPos X="132" Y="5"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="97"/> <UsageCount Value="99"/>
</Unit48> </Unit48>
<Unit49> <Unit49>
<Filename Value="../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/> <Filename Value="../../../Documents/fpc/rtl/objpas/classes/classesh.inc"/>
@ -412,10 +412,10 @@
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/> <Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="mmlpsthread"/> <UnitName Value="mmlpsthread"/>
<CursorPos X="66" Y="1"/> <CursorPos X="46" Y="167"/>
<TopLine Value="1"/> <TopLine Value="157"/>
<EditorIndex Value="7"/> <EditorIndex Value="7"/>
<UsageCount Value="95"/> <UsageCount Value="97"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit50> </Unit50>
<Unit51> <Unit51>
@ -523,9 +523,11 @@
</Unit65> </Unit65>
<Unit66> <Unit66>
<Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/>
<CursorPos X="23" Y="15"/> <CursorPos X="54" Y="17"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="28"/> <UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit66> </Unit66>
<Unit67> <Unit67>
<Filename Value="../../../FPC/FPCCheckout/rtl/win/tthread.inc"/> <Filename Value="../../../FPC/FPCCheckout/rtl/win/tthread.inc"/>
@ -545,7 +547,7 @@
<UnitName Value="bitmaps"/> <UnitName Value="bitmaps"/>
<CursorPos X="63" Y="428"/> <CursorPos X="63" Y="428"/>
<TopLine Value="387"/> <TopLine Value="387"/>
<UsageCount Value="85"/> <UsageCount Value="87"/>
</Unit69> </Unit69>
<Unit70> <Unit70>
<Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.pp"/> <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.pp"/>
@ -565,7 +567,7 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<CursorPos X="30" Y="34"/> <CursorPos X="30" Y="34"/>
<TopLine Value="22"/> <TopLine Value="22"/>
<UsageCount Value="84"/> <UsageCount Value="86"/>
</Unit72> </Unit72>
<Unit73> <Unit73>
<Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.inc"/> <Filename Value="../../../FPC/FPCCheckout/packages/fcl-image/src/fpcanvas.inc"/>
@ -698,7 +700,7 @@
<CursorPos X="53" Y="27"/> <CursorPos X="53" Y="27"/>
<TopLine Value="9"/> <TopLine Value="9"/>
<EditorIndex Value="2"/> <EditorIndex Value="2"/>
<UsageCount Value="67"/> <UsageCount Value="69"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit92> </Unit92>
<Unit93> <Unit93>
@ -718,7 +720,9 @@
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="9"/> <EditorIndex Value="9"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit95> </Unit95>
<Unit96> <Unit96>
<Filename Value="../../Units/PascalScript/uPSCompiler.pas"/> <Filename Value="../../Units/PascalScript/uPSCompiler.pas"/>
@ -758,7 +762,7 @@
<UnitName Value="plugins"/> <UnitName Value="plugins"/>
<CursorPos X="86" Y="128"/> <CursorPos X="86" Y="128"/>
<TopLine Value="128"/> <TopLine Value="128"/>
<UsageCount Value="61"/> <UsageCount Value="63"/>
</Unit101> </Unit101>
<Unit102> <Unit102>
<Filename Value="../../../Compilertje/Units/CogatUnits/compfiles.pas"/> <Filename Value="../../../Compilertje/Units/CogatUnits/compfiles.pas"/>
@ -788,7 +792,7 @@
</Unit105> </Unit105>
<Unit106> <Unit106>
<Filename Value="../../Units/MMLAddon/PSInc/psdefines.inc"/> <Filename Value="../../Units/MMLAddon/PSInc/psdefines.inc"/>
<CursorPos X="57" Y="4"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="14"/> <UsageCount Value="14"/>
</Unit106> </Unit106>
@ -850,7 +854,7 @@
<UnitName Value="dtm"/> <UnitName Value="dtm"/>
<CursorPos X="52" Y="15"/> <CursorPos X="52" Y="15"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="42"/> <UsageCount Value="44"/>
</Unit115> </Unit115>
<Unit116> <Unit116>
<Filename Value="../../../cogat/Units/CogatUnits/comppicker.pas"/> <Filename Value="../../../cogat/Units/CogatUnits/comppicker.pas"/>
@ -866,7 +870,7 @@
<CursorPos X="27" Y="34"/> <CursorPos X="27" Y="34"/>
<TopLine Value="13"/> <TopLine Value="13"/>
<EditorIndex Value="6"/> <EditorIndex Value="6"/>
<UsageCount Value="38"/> <UsageCount Value="40"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit117> </Unit117>
<Unit118> <Unit118>
@ -874,8 +878,8 @@
<UnitName Value="CompDragger"/> <UnitName Value="CompDragger"/>
<CursorPos X="101" Y="26"/> <CursorPos X="101" Y="26"/>
<TopLine Value="26"/> <TopLine Value="26"/>
<EditorIndex Value="11"/> <EditorIndex Value="14"/>
<UsageCount Value="16"/> <UsageCount Value="17"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit118> </Unit118>
<Unit119> <Unit119>
@ -884,11 +888,9 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="MainForm"/> <UnitName Value="MainForm"/>
<CursorPos X="48" Y="1180"/> <CursorPos X="29" Y="635"/>
<TopLine Value="1161"/> <TopLine Value="612"/>
<EditorIndex Value="12"/>
<UsageCount Value="16"/> <UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit119> </Unit119>
<Unit120> <Unit120>
<Filename Value="../../Units/MMLAddon/windowselector.pas"/> <Filename Value="../../Units/MMLAddon/windowselector.pas"/>
@ -896,8 +898,8 @@
<UnitName Value="windowselector"/> <UnitName Value="windowselector"/>
<CursorPos X="76" Y="83"/> <CursorPos X="76" Y="83"/>
<TopLine Value="65"/> <TopLine Value="65"/>
<EditorIndex Value="13"/> <EditorIndex Value="15"/>
<UsageCount Value="28"/> <UsageCount Value="30"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit120> </Unit120>
<Unit121> <Unit121>
@ -913,120 +915,143 @@
<TopLine Value="338"/> <TopLine Value="338"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
</Unit122> </Unit122>
<Unit123>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<UnitName Value="cthreads"/>
<CursorPos X="28" Y="1077"/>
<TopLine Value="1070"/>
<EditorIndex Value="1"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit123>
<Unit124>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/inc/threadh.inc"/>
<CursorPos X="58" Y="78"/>
<TopLine Value="59"/>
<UsageCount Value="10"/>
</Unit124>
</Units> </Units>
<JumpHistory Count="28" HistoryIndex="27"> <JumpHistory Count="30" HistoryIndex="29">
<Position1> <Position1>
<Filename Value="../../Units/MMLAddon/windowselector.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="40" Column="26" TopLine="25"/> <Caret Line="25" Column="37" TopLine="25"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="testunit.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="96" Column="43" TopLine="85"/> <Caret Line="46" Column="25" TopLine="25"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
<Caret Line="77" Column="14" TopLine="49"/>
</Position3>
<Position4>
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
<Caret Line="11" Column="29" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
<Caret Line="9" Column="10" TopLine="1"/>
</Position5>
<Position6>
<Filename Value="testunit.pas"/>
<Caret Line="52" Column="43" TopLine="52"/>
</Position6>
<Position7>
<Filename Value="testunit.pas"/>
<Caret Line="54" Column="45" TopLine="54"/>
</Position7>
<Position8>
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
<Caret Line="72" Column="74" TopLine="59"/>
</Position8>
<Position9>
<Filename Value="../../Units/MMLCore/client.pas"/>
<Caret Line="17" Column="25" TopLine="1"/>
</Position9>
<Position10>
<Filename Value="../../Units/MMLAddon/windowselector.pas"/>
<Caret Line="79" Column="32" TopLine="65"/>
</Position10>
<Position11>
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
<Caret Line="56" Column="47" TopLine="37"/>
</Position11>
<Position12>
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
<Caret Line="74" Column="19" TopLine="49"/>
</Position12>
<Position13>
<Filename Value="../../Units/MMLAddon/colourpicker.pas"/>
<Caret Line="34" Column="27" TopLine="13"/>
</Position13>
<Position14>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="7" Column="90" TopLine="1"/>
</Position14>
<Position15>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="82" Column="17" TopLine="63"/>
</Position15>
<Position16>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="266" Column="51" TopLine="247"/>
</Position16>
<Position17>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="295" Column="55" TopLine="276"/>
</Position17>
<Position18>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="327" Column="53" TopLine="308"/>
</Position18>
<Position19>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="368" Column="53" TopLine="349"/>
</Position19>
<Position20>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="1004" Column="48" TopLine="985"/>
</Position20>
<Position21>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="1005" Column="43" TopLine="985"/>
</Position21>
<Position22>
<Filename Value="../../../cogat/mainform.pas"/>
<Caret Line="1008" Column="46" TopLine="985"/>
</Position22>
<Position23>
<Filename Value="testunit.pas"/>
<Caret Line="35" Column="78" TopLine="1"/>
</Position23>
<Position24>
<Filename Value="testunit.pas"/>
<Caret Line="25" Column="37" TopLine="25"/>
</Position24>
<Position25>
<Filename Value="testunit.pas"/>
<Caret Line="46" Column="25" TopLine="25"/>
</Position25>
<Position26>
<Filename Value="testunit.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="47" Column="25" TopLine="25"/> <Caret Line="47" Column="25" TopLine="25"/>
</Position26> </Position3>
<Position27> <Position4>
<Filename Value="testunit.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="136" Column="48" TopLine="108"/> <Caret Line="136" Column="48" TopLine="108"/>
</Position27> </Position4>
<Position28> <Position5>
<Filename Value="testunit.pas"/> <Filename Value="testunit.pas"/>
<Caret Line="139" Column="15" TopLine="117"/> <Caret Line="139" Column="15" TopLine="117"/>
</Position5>
<Position6>
<Filename Value="project1.lpr"/>
<Caret Line="7" Column="10" TopLine="1"/>
</Position6>
<Position7>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<Caret Line="12" Column="46" TopLine="1"/>
</Position7>
<Position8>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<Caret Line="313" Column="20" TopLine="294"/>
</Position8>
<Position9>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<Caret Line="321" Column="31" TopLine="294"/>
</Position9>
<Position10>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<Caret Line="327" Column="31" TopLine="294"/>
</Position10>
<Position11>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<Caret Line="343" Column="18" TopLine="324"/>
</Position11>
<Position12>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<Caret Line="346" Column="12" TopLine="324"/>
</Position12>
<Position13>
<Filename Value="../../../../../../usr/lib64/fpc/2.2.4/source/rtl/unix/cthreads.pp"/>
<Caret Line="1077" Column="28" TopLine="1070"/>
</Position13>
<Position14>
<Filename Value="testunit.pas"/>
<Caret Line="92" Column="29" TopLine="73"/>
</Position14>
<Position15>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="11" Column="86" TopLine="2"/>
</Position15>
<Position16>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="32" Column="38" TopLine="2"/>
</Position16>
<Position17>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="307" Column="52" TopLine="269"/>
</Position17>
<Position18>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="48" Column="71" TopLine="10"/>
</Position18>
<Position19>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="238" Column="59" TopLine="233"/>
</Position19>
<Position20>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="33" Column="65" TopLine="13"/>
</Position20>
<Position21>
<Filename Value="../../Units/MMLCore/finder.pas"/>
<Caret Line="285" Column="5" TopLine="253"/>
</Position21>
<Position22>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="134" Column="22" TopLine="108"/>
</Position22>
<Position23>
<Filename Value="../../Units/MMLAddon/PSInc/Wrappers/other.inc"/>
<Caret Line="16" Column="12" TopLine="1"/>
</Position23>
<Position24>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="134" Column="22" TopLine="108"/>
</Position24>
<Position25>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="112" Column="19" TopLine="79"/>
</Position25>
<Position26>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="176" Column="20" TopLine="151"/>
</Position26>
<Position27>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="134" Column="24" TopLine="115"/>
</Position27>
<Position28>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="176" Column="7" TopLine="146"/>
</Position28> </Position28>
<Position29>
<Filename Value="../../Units/MMLAddon/mmlpsthread.pas"/>
<Caret Line="179" Column="71" TopLine="157"/>
</Position29>
<Position30>
<Filename Value="../../Units/MMLAddon/PSInc/pscompile.inc"/>
<Caret Line="15" Column="95" TopLine="1"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -1035,8 +1060,8 @@
<Filename Value="SAMufasaGUI"/> <Filename Value="SAMufasaGUI"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/"/> <IncludeFiles Value="$(ProjOutDir)/;$(ProjPath)../../Units/MMLAddon/PSInc/"/>
<OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/"/> <OtherUnitFiles Value="$(ProjPath)../../Units/MMLCore/;$(ProjPath)../../Units/MMLAddon/;$(ProjPath)../../Units/PascalScript/;$(ProjPath)../../Units/Misc/;$(ProjPath)../../Units/MMLAddon/PSInc/"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>
<Optimizations> <Optimizations>

2
Projects/SAMufasaGUI/testunit.lrs
View File

@ -1,3 +1,5 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TForm1','FORMDATA',[ LazarusResources.Add('TForm1','FORMDATA',[
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'{'#4#6'Height'#3#29#2#3'Top'#3#148#0#5'Wi' 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'{'#4#6'Height'#3#29#2#3'Top'#3#148#0#5'Wi'
+'dth'#3#251#2#13'ActiveControl'#7#8'SynEdit1'#7'Caption'#6#9'Mufasa v2'#12'C' +'dth'#3#251#2#13'ActiveControl'#7#8'SynEdit1'#7'Caption'#6#9'Mufasa v2'#12'C'

4
Projects/SAMufasaGUI/testunit.pas
View File

@ -87,6 +87,10 @@ begin
MMLPSThread.Client.MWindow.SetWindow(Form1.Window); MMLPSThread.Client.MWindow.SetWindow(Form1.Window);
MMLPSThread.Resume; MMLPSThread.Resume;
// sleep(500);
// MMLPSThread.PSScript.Stop;
end; end;
procedure TForm1.Button1Click(Sender: TObject); procedure TForm1.Button1Click(Sender: TObject);

9
Tests/PS/colourtest.txt
View File

@ -3,20 +3,20 @@ var
x,y,w,h,i,j,t,t2:integer; x,y,w,h,i,j,t,t2:integer;
begin begin
getclientdimensions(w,h); getclientdimensions(w,h);
writeln(inttostr(w) + ', ' + inttostr(h)); writeln(inttostr(w) + ', ' + inttostr(h));
freeze();
for i := 0 to 2 do for i := 0 to 2 do
begin begin
setcolortolerancespeed(i); setcolortolerancespeed(i);
t := getsystemtime; t := getsystemtime;
for j := 0 to 100 do for j := 0 to 100 do
findcolortolerance(x, y, 255, 0, 0, w -1 , h -1, 40); findcolortolerance(x, y, 2532562, 0, 0, w -1 , h -1, 1);
t2 := getsystemtime; t2 := getsystemtime;
writeln('Time for 101 tries: ' + inttostr(t2 - t) + ' ms.'); writeln('Time for 101 tries: ' + inttostr(t2 - t) + ' ms.');
writeln('That is ' + FloatToStr((t2 - t) / 101) + ' ms each.'); writeln('That is ' + FloatToStr((t2 - t) / 101) + ' ms each.');
if findcolortolerance(x, y, 255, 0, 0, w-1, h-1, 40) then if findcolortolerance(x, y, 2532562, 0, 0, w-1, h-1, 1) then
begin begin
writeln('CTS: ' + inttostr(I) + '; Found the colour at (' + inttostr(x) + ', ' + writeln('CTS: ' + inttostr(I) + '; Found the colour at (' + inttostr(x) + ', ' +
inttostr(y) + ')'); inttostr(y) + ')');
@ -25,6 +25,7 @@ begin
end else end else
writeln('not found'); writeln('not found');
end; end;
unfreeze();
end. end.
Compiled succesfully in 7 ms. Compiled succesfully in 7 ms.

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

@ -8,3 +8,12 @@ begin
Sleep(t); Sleep(t);
end; end;
function Freeze: boolean;
begin
result := CurrThread.Client.MWindow.Freeze();
end;
function Unfreeze: boolean;
begin
result := CurrThread.Client.MWindow.Unfreeze;
end;

117
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -1,57 +1,60 @@
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer'); Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)'); Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;'); Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);'); Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
{maths} {maths}
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended'); sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;'); Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;'); Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;'); Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;'); Sender.AddFunction(@Freeze, 'function freeze:boolean;');
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;'); Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;'); Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean'); Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;'); Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;'); Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);'); Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);'); Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
Sender.AddFunction(@Wait, 'procedure wait(t: integer);'); Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);'); Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;'); Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;'); Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);'); Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;'); Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;'); Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);'); Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);'); Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;'); Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;'); Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);'); Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);'); Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;'); Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;'); Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)'); Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);'); Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);'); Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;'); Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);'); Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');

2
Units/MMLAddon/mmlpsthread.pas
View File

@ -16,7 +16,6 @@ type
Parser: TPSPascalPreProcessorParser; const Active: Boolean; Parser: TPSPascalPreProcessorParser; const Active: Boolean;
const DirectiveName, DirectiveParam: string; var Continue: Boolean); const DirectiveName, DirectiveParam: string; var Continue: Boolean);
protected protected
PSScript : TPSScript;
DebugTo : TMemo; DebugTo : TMemo;
PluginsToload : Array of integer; PluginsToload : Array of integer;
procedure OnCompile(Sender: TPSScript); procedure OnCompile(Sender: TPSScript);
@ -29,6 +28,7 @@ type
procedure OnThreadTerminate(Sender: TObject); procedure OnThreadTerminate(Sender: TObject);
procedure Execute; override; procedure Execute; override;
public public
PSScript : TPSScript; // Moved to public, as we can't kill it otherwise.
Client : TClient; Client : TClient;
procedure SetPSScript(Script : string); procedure SetPSScript(Script : string);
procedure SetDebug( Strings : TMemo ); procedure SetDebug( Strings : TMemo );

889
Units/MMLCore/finder.pas
View File

@ -1,442 +1,447 @@
unit finder; unit finder;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, MufasaTypes; // Types Classes, SysUtils, MufasaTypes; // Types
{ TMFinder Class } { TMFinder Class }
{ {
Should be 100% independant, as all platform dependant code is in the Should be 100% independant, as all platform dependant code is in the
Window and Input classes. Window and Input classes.
Let's try not to use any OS-specific defines here? ;) Let's try not to use any OS-specific defines here? ;)
} }
type type
TMFinder = class(TObject) TMFinder = class(TObject)
constructor Create(aClient: TObject); constructor Create(aClient: TObject);
destructor Destroy; override; destructor Destroy; override;
private private
Procedure UpdateCachedValues(NewWidth,NewHeight : integer); Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
procedure DefaultOperations(var x1,y1,x2,y2 : integer); procedure DefaultOperations(var x1,y1,x2,y2 : integer);
public public
function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer; function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
procedure SetToleranceSpeed(nCTS: Integer); procedure SetToleranceSpeed(nCTS: Integer);
function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean; function SimilarColors(Color1,Color2,Tolerance : Integer) : boolean;
// Possibly turn x, y into a TPoint var. // Possibly turn x, y into a TPoint var.
function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean; function FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
function FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean; function FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean; function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean;
function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean; function FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
protected protected
Client: TObject; Client: TObject;
CachedWidth, CachedHeight : integer; CachedWidth, CachedHeight : integer;
ClientTPA : TPointArray; ClientTPA : TPointArray;
hueMod, satMod: Extended; hueMod, satMod: Extended;
CTS: Integer; CTS: Integer;
end; end;
implementation implementation
uses uses
Client, // For the Client Casts. Client, // For the Client Casts.
colour_conv // For RGBToColor, etc. colour_conv // For RGBToColor, etc.
; ;
constructor TMFinder.Create(aClient: TObject); constructor TMFinder.Create(aClient: TObject);
begin begin
inherited Create; inherited Create;
Self.Client := aClient; Self.Client := aClient;
Self.CTS := 1; Self.CTS := 1;
Self.hueMod := 0.2; Self.hueMod := 0.2;
Self.satMod := 0.2; Self.satMod := 0.2;
end; end;
destructor TMFinder.Destroy; destructor TMFinder.Destroy;
begin begin
inherited; inherited;
end; end;
procedure TMFinder.SetToleranceSpeed(nCTS: Integer); procedure TMFinder.SetToleranceSpeed(nCTS: Integer);
begin begin
if (nCTS < 0) or (nCTS > 2) then if (nCTS < 0) or (nCTS > 2) then
raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]); raise Exception.CreateFmt('The given CTS ([%d]) is invalid.',[nCTS]);
Self.CTS := nCTS; Self.CTS := nCTS;
end; end;
function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean; function TMFinder.SimilarColors(Color1, Color2,Tolerance: Integer) : boolean;
var var
R1,G1,B1,R2,G2,B2 : Byte; R1,G1,B1,R2,G2,B2 : Byte;
H1,S1,L1,H2,S2,L2 : extended; H1,S1,L1,H2,S2,L2 : extended;
begin begin
Result := False; Result := False;
ColorToRGB(Color1,R1,G1,B1); ColorToRGB(Color1,R1,G1,B1);
ColorToRGB(Color2,R2,G2,B2); ColorToRGB(Color2,R2,G2,B2);
if Color1 = Color2 then if Color1 = Color2 then
Result := true Result := true
else else
case CTS of case CTS of
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
2: begin 2: begin
RGBToHSL(R1,g1,b1,H1,S1,L1); RGBToHSL(R1,g1,b1,H1,S1,L1);
RGBToHSL(R2,g2,b2,H2,S2,L2); RGBToHSL(R2,g2,b2,H2,S2,L2);
Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
end; end;
end; end;
end; end;
function ColorSame(var CTS,Tolerance : Integer; var R1,B1,G1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline; function ColorSame(var CTS,Tolerance : Integer; var R1,B1,G1,R2,G2,B2 : byte; var H1,S1,L1,huemod,satmod : extended) : boolean; inline;
var var
H2,S2,L2 : extended; H2,S2,L2 : extended;
begin begin
Result := False; Result := False;
case CTS of case CTS of
0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance)); 0: Result := ((Abs(R1-R2) <= Tolerance) and (Abs(G1-G2) <= Tolerance) and (Abs(B1-B2) <= Tolerance));
1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance); 1: Result := (Sqrt(sqr(R1-R2) + sqr(G1-G2) + sqr(B1-B2)) <= Tolerance);
2: begin 2: begin
RGBToHSL(R1,g1,b1,H1,S1,L1); RGBToHSL(R1,g1,b1,H1,S1,L1);
RGBToHSL(R2,g2,b2,H2,S2,L2); RGBToHSL(R2,g2,b2,H2,S2,L2);
Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance)); Result := ((abs(H1 - H2) <= (hueMod * Tolerance)) and (abs(S2-S1) <= (satMod * Tolerance)) and (abs(L1-L2) <= Tolerance));
end; end;
end; end;
end; end;
procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer); procedure TMFinder.UpdateCachedValues(NewWidth, NewHeight: integer);
begin begin
CachedWidth := NewWidth; CachedWidth := NewWidth;
CachedHeight := NewHeight; CachedHeight := NewHeight;
SetLength(ClientTPA,NewWidth * NewHeight); SetLength(ClientTPA,NewWidth * NewHeight);
end; end;
procedure TMFinder.DefaultOperations(var x1, y1, x2, y2: integer); procedure TMFinder.DefaultOperations(var x1, y1, x2, y2: integer);
var var
w,h : integer; w,h : integer;
begin begin
{ if x1 > x2 then { if x1 > x2 then
Swap(x1,x2); Swap(x1,x2);
if y1 > y2 then if y1 > y2 then
Swap(y1,y2);} Swap(y1,y2);}
if x1 < 0 then if x1 < 0 then
// x1 := 0; // x1 := 0;
raise Exception.createFMT('Any FindColor Function, you did not pass a ' + raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct x1: %d.', [x1]); 'correct x1: %d.', [x1]);
if y1 < 0 then if y1 < 0 then
// y1 := 0; // y1 := 0;
raise Exception.createFMT('Any FindColor Function, you did not pass a ' + raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct y1: %d.', [y1]); 'correct y1: %d.', [y1]);
TClient(Self.Client).MWindow.GetDimensions(w,h); TClient(Self.Client).MWindow.GetDimensions(w,h);
if (w <> CachedWidth) or (h <> CachedHeight) then if (w <> CachedWidth) or (h <> CachedHeight) then
UpdateCachedValues(w,h); UpdateCachedValues(w,h);
if x2 >= w then if x2 >= w then
// x2 := w-1; // x2 := w-1;
raise Exception.createFMT('Any FindColor Function, you did not pass a ' + raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct x2: %d.', [x2]); 'correct x2: %d.', [x2]);
if y2 >= h then if y2 >= h then
// y2 := h-1; // y2 := h-1;
raise Exception.createFMT('Any FindColor Function, you did not pass a ' + raise Exception.createFMT('Any FindColor Function, you did not pass a ' +
'correct y2: %d.', [y2]); 'correct y2: %d.', [y2]);
end; end;
function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer; function TMFinder.CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;
var var
PtrData: TRetData; PtrData: TRetData;
Ptr: PRGB32; Ptr: PRGB32;
PtrInc: Integer; PtrInc: Integer;
clR, clG, clB : byte; clR, clG, clB : byte;
dX, dY, xx, yy: Integer; dX, dY, xx, yy: Integer;
h,s,l,hmod,smod : extended; h,s,l,hmod,smod : extended;
Ccts : integer; Ccts : integer;
begin begin
DefaultOperations(xs, ys, xe, ye); DefaultOperations(xs, ys, xe, ye);
dX := xe - xs; dX := xe - xs;
dY := ye - ys; dY := ye - ys;
ColorToRGB(Color, clR, clG, clB); ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
Ptr := PtrData.Ptr; Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith; PtrInc := PtrData.IncPtrWith;
CCts := Self.CTS; CCts := Self.CTS;
result := 0; result := 0;
if cts = 2 then if cts = 2 then
begin; begin;
RGBToHSL(clR,clG,clB,h,s,l); RGBToHSL(clR,clG,clB,h,s,l);
hmod := Self.hueMod; hmod := Self.hueMod;
smod := Self.satMod; smod := Self.satMod;
end; end;
for yy := ys to ye do for yy := ys to ye do
begin; begin;
for xx := xs to xe do for xx := xs to xe do
begin; begin;
if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then if ColorSame(CCts,Tolerance,clR,clG,clB,Ptr^.r,Ptr^.g,Ptr^.b,H,S,L,hmod,smod) then
inc(result); inc(result);
Inc(Ptr); Inc(Ptr);
end; end;
Inc(Ptr, PtrInc) Inc(Ptr, PtrInc)
end; end;
TClient(Client).MWindow.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean; function TMFinder.FindColor(var x, y: Integer; Color, x1, y1, x2, y2: Integer): Boolean;
var var
PtrData: TRetData; PtrData: TRetData;
Ptr: PRGB32; Ptr: PRGB32;
PtrInc: Integer; PtrInc: Integer;
dX, dY, clR, clG, clB, xx, yy: Integer; dX, dY, clR, clG, clB, xx, yy: Integer;
begin begin
// checks for valid x1,y1,x2,y2? (may involve GetDimensions) // checks for valid x1,y1,x2,y2? (may involve GetDimensions)
DefaultOperations(x1,y1,x2,y2); DefaultOperations(x1,y1,x2,y2);
// calculate delta x and y // calculate delta x and y
dX := x2 - x1; dX := x2 - x1;
dY := y2 - y1; dY := y2 - y1;
//next, convert the color to r,g,b //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); ColorToRGB(Color, clR, clG, clB);
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1); PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
// Do we want to "cache" these vars? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
Ptr := PtrData.Ptr; Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith; PtrInc := PtrData.IncPtrWith;
for yy := y1 to y2 do for yy := y1 to y2 do
begin; begin;
for xx := x1 to x2 do for xx := x1 to x2 do
begin; begin;
// Colour comparison here. Possibly with tolerance? ;) // Colour comparison here. Possibly with tolerance? ;)
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
begin begin
Result := True; Result := True;
x := xx; x := xx;
y := yy; y := yy;
TClient(Client).MWindow.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
Exit; Exit;
end; end;
Inc(Ptr); Inc(Ptr);
end; end;
Inc(Ptr, PtrInc) Inc(Ptr, PtrInc)
end; end;
TClient(Client).MWindow.FreeReturnData; TClient(Client).MWindow.FreeReturnData;
end; end;
function TMFinder.FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean; function TMFinder.FindColorTolerance(var x, y: Integer; Color, x1, y1, x2, y2, tol: Integer): Boolean;
var var
PtrData: TRetData; PtrData: TRetData;
Ptr: PRGB32; Ptr: PRGB32;
PtrInc: Integer; PtrInc: Integer;
dX, dY, clR, clG, clB, xx, yy: Integer; dX, dY, clR, clG, clB, xx, yy: Integer;
H1, S1, L1, H2, S2, L2: Extended; H1, S1, L1, H2, S2, L2: Extended;
label Hit; label Hit;
label Miss; label Miss;
begin begin
// checks for valid x1,y1,x2,y2? (may involve GetDimensions) // checks for valid x1,y1,x2,y2? (may involve GetDimensions)
DefaultOperations(x1,y1,x2,y2); DefaultOperations(x1,y1,x2,y2);
// calculate delta x and y // calculate delta x and y
dX := x2 - x1; dX := x2 - x1;
dY := y2 - y1; dY := y2 - y1;
//next, convert the color to r,g,b //next, convert the color to r,g,b
ColorToRGB(Color, clR, clG, clB); ColorToRGB(Color, clR, clG, clB);
ColorToHSL(Color, H1, S1, L1); ColorToHSL(Color, H1, S1, L1);
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1); PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
// Do we want to "cache" these vars? // Do we want to "cache" these vars?
// We will, for now. Easier to type. // We will, for now. Easier to type.
Ptr := PtrData.Ptr; Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith; PtrInc := PtrData.IncPtrWith;
case CTS of case CTS of
0: 0:
for yy := y1 to y2 do for yy := y1 to y2 do
begin begin
for xx := x1 to x2 do for xx := x1 to x2 do
begin begin
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then if ((abs(clB-Ptr^.B) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clR-Ptr^.R) <= Tol)) then
goto Hit; goto Hit;
inc(Ptr); inc(Ptr);
end; end;
Inc(Ptr, PtrInc); Inc(Ptr, PtrInc);
end; end;
1: 1:
for yy := y1 to y2 do begin
begin Tol := Sqr(Tol);
for xx := x1 to x2 do
begin for yy := y1 to y2 do
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then begin
goto Hit; for xx := x1 to x2 do
inc(ptr); begin
end; if (sqr(clB - Ptr^.B) + sqr(clG - Ptr^.G) + sqr(clR-Ptr^.R)) <= Tol then
Inc(Ptr, PtrInc); goto Hit;
end; inc(ptr);
2: end;
begin Inc(Ptr, PtrInc);
for yy := y1 to y2 do end;
for xx := x1 to x2 do
begin end;
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); 2:
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then begin
goto Hit; for yy := y1 to y2 do
inc(Ptr); for xx := x1 to x2 do
end; begin
Inc(Ptr, PtrInc); RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
end; if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
end; goto Hit;
Result := False; inc(Ptr);
TClient(Client).MWindow.FreeReturnData; end;
Exit; Inc(Ptr, PtrInc);
end;
Hit: end;
Result := True; Result := False;
x := xx; TClient(Client).MWindow.FreeReturnData;
y := yy; Exit;
TClient(Client).MWindow.FreeReturnData;
end; Hit:
Result := True;
function TMFinder.FindColorsTolerance(var Points: TPointArray; Color, xs, ys, x := xx;
xe, ye, Tol: Integer): Boolean; y := yy;
var TClient(Client).MWindow.FreeReturnData;
PtrData: TRetData; end;
Ptr: PRGB32;
PtrInc,C: Integer; function TMFinder.FindColorsTolerance(var Points: TPointArray; Color, xs, ys,
dX, dY, clR, clG, clB, xx, yy: Integer; xe, ye, Tol: Integer): Boolean;
H1, S1, L1, H2, S2, L2: Extended; var
begin PtrData: TRetData;
DefaultOperations(xs,ys,xe,ye); Ptr: PRGB32;
PtrInc,C: Integer;
dX := xe - xs; dX, dY, clR, clG, clB, xx, yy: Integer;
dY := ye - ys; H1, S1, L1, H2, S2, L2: Extended;
//next, convert the color to r,g,b begin
ColorToRGB(Color, clR, clG, clB); DefaultOperations(xs,ys,xe,ye);
ColorToHSL(Color, H1, S1, L1);
dX := xe - xs;
PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); dY := ye - ys;
//next, convert the color to r,g,b
// Do we want to "cache" these vars? ColorToRGB(Color, clR, clG, clB);
// We will, for now. Easier to type. ColorToHSL(Color, H1, S1, L1);
Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith; PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1);
c := 0;
case CTS of // Do we want to "cache" these vars?
0: // We will, for now. Easier to type.
for yy := ys to ye do Ptr := PtrData.Ptr;
begin PtrInc := PtrData.IncPtrWith;
for xx := xs to xe do c := 0;
begin case CTS of
if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then 0:
begin; for yy := ys to ye do
ClientTPA[c].x := xx; begin
ClientTPA[c].y := yy; for xx := xs to xe do
inc(c); begin
end; if ((abs(clR-Ptr^.R) <= Tol) and (abs(clG-Ptr^.G) <= Tol) and (Abs(clG-Ptr^.B) <= Tol)) then
inc(Ptr); begin;
end; ClientTPA[c].x := xx;
Inc(Ptr, PtrInc); ClientTPA[c].y := yy;
end; inc(c);
end;
1: inc(Ptr);
for yy := ys to ye do end;
begin Inc(Ptr, PtrInc);
for xx := xs to xe do end;
begin
if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then 1:
begin; for yy := ys to ye do
ClientTPA[c].x := xx; begin
ClientTPA[c].y := yy; for xx := xs to xe do
inc(c); begin
end; if (Sqrt(sqr(clR-Ptr^.R) + sqr(clG - Ptr^.G) + sqr(clB - Ptr^.B)) <= Tol) then
inc(ptr); begin;
end; ClientTPA[c].x := xx;
Inc(Ptr, PtrInc); ClientTPA[c].y := yy;
end; inc(c);
2: end;
begin inc(ptr);
for yy := ys to ye do end;
for xx := xs to xe do Inc(Ptr, PtrInc);
begin end;
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2); 2:
if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then begin
begin; for yy := ys to ye do
ClientTPA[c].x := xx; for xx := xs to xe do
ClientTPA[c].y := yy; begin
inc(c); RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,H2,S2,L2);
end; if ((abs(H1 - H2) <= (hueMod * tol)) and (abs(S1 - S2) <= (satMod * tol)) and (abs(L1 - L2) <= Tol)) then
inc(Ptr); begin;
end; ClientTPA[c].x := xx;
Inc(Ptr, PtrInc); ClientTPA[c].y := yy;
end; inc(c);
end; end;
SetLength(Points, C); inc(Ptr);
Move(ClientTPA[0], Points[0], C * SizeOf(TPoint)); end;
Result := C > 0; Inc(Ptr, PtrInc);
TClient(Client).MWindow.FreeReturnData; end;
end; end;
SetLength(Points, C);
function TMFinder.FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean; Move(ClientTPA[0], Points[0], C * SizeOf(TPoint));
var Result := C > 0;
PtrData: TRetData; TClient(Client).MWindow.FreeReturnData;
Ptr: PRGB32; end;
PtrInc: Integer;
dX, dY, clR, clG, clB, xx, yy, i: Integer; function TMFinder.FindColors(var TPA: TPointArray; Color, x1, y1, x2, y2: Integer): Boolean;
var
begin PtrData: TRetData;
DefaultOperations(x1,y1,x2,y2); Ptr: PRGB32;
PtrInc: Integer;
dX := x2 - x1; dX, dY, clR, clG, clB, xx, yy, i: Integer;
dY := y2 - y1;
begin
I := 0; DefaultOperations(x1,y1,x2,y2);
ColorToRGB(Color, clR, clG, clB); dX := x2 - x1;
dY := y2 - y1;
PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
I := 0;
Ptr := PtrData.Ptr;
PtrInc := PtrData.IncPtrWith; ColorToRGB(Color, clR, clG, clB);
for yy := y1 to y2 do PtrData := TClient(Client).MWindow.ReturnData(x1, y1, dX + 1, dY + 1);
begin;
for xx := x1 to x2 do Ptr := PtrData.Ptr;
begin; PtrInc := PtrData.IncPtrWith;
if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
begin for yy := y1 to y2 do
Self.ClientTPA[I].x := xx; begin;
Self.ClientTPA[i].y := yy; for xx := x1 to x2 do
Inc(I); begin;
end; if (Ptr^.R = clR) and (Ptr^.G = clG) and (Ptr^.B = clB) then
Inc(Ptr); begin
end; Self.ClientTPA[I].x := xx;
Inc(Ptr, PtrInc); Self.ClientTPA[i].y := yy;
end; Inc(I);
end;
SetLength(TPA, I); Inc(Ptr);
end;
Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint)); Inc(Ptr, PtrInc);
end;
Result := I > 0;
SetLength(TPA, I);
TClient(Client).MWindow.FreeReturnData;
end; Move(ClientTPA[0], TPA[0], i * SizeOf(TPoint));
end. Result := I > 0;
TClient(Client).MWindow.FreeReturnData;
end;
end.