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

Added MDTM.LoadFromString + MDTM.Normalize;

Browse Source
This commit is contained in:
Raymond 2010-05-20 11:12:20 +02:00
parent dd0a88e965
commit a2b85fe786
8 changed files with 149 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
Projects/Simba/psextension.pas
View File

@ -105,7 +105,7 @@ begin
result := SExt_ok;
except
on e : exception do
//formWritelnEx(format('Error in Simba extension (%s): %s',[Self.GetName,e.message]));
psWriteLn(format('Error in Simba extension (%s): %s',[Self.GetName,e.message]));
end;
end;
@ -149,22 +149,22 @@ begin
end;
{$DEFINE MML_EXPORT_THREADSAFE}
{$I Wrappers/other.inc}
{$I Wrappers/settings.inc}
{$I Wrappers/bitmap.inc}
{$I Wrappers/window.inc}
{$I Wrappers/tpa.inc}
{$I Wrappers/strings.inc}
{$I Wrappers/colour.inc}
{$I Wrappers/colourconv.inc}
{$I Wrappers/math.inc}
{$I Wrappers/mouse.inc}
{$I Wrappers/file.inc}
{$I Wrappers/keyboard.inc}
{$I Wrappers/dtm.inc}
{$I Wrappers/ocr.inc}
{$I Wrappers/internets.inc}
{$I Wrappers/extensions.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/other.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/settings.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/bitmap.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/window.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/tpa.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/strings.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/colour.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/colourconv.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/math.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/mouse.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/file.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/keyboard.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/dtm.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/ocr.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/internets.inc}
{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc}
procedure TSimbaPSExtension.RegisterMyMethods(x: TPSScript);
@ -196,11 +196,13 @@ begin
{$i ../../Units/MMLAddon/PSInc/psexportedmethods.inc}
AddFunction(@ext_SDTMToMDTM,'function SDTMToMDTM(Const DTM: TSDTM): TMDTM;');
AddFunction(@ext_GetPage,'function GetPage(const url : string) : string');
AddFunction(@ext_DecompressBZip2,'function DecompressBZip2(const input: string;out output : string; const BlockSize: Cardinal): boolean;');
AddFunction(@ext_UnTar,'function UnTar(const Input : string; out Content : TStringArray) : boolean;');
AddFunction(@ext_UnTarEx,'function UnTarEx(const Input : string;const outputdir : string; overwrite : boolean): boolean;');
AddFunction(@ext_MessageDlg,'function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;');
AddFunction(@ext_InputQuery,'function InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;');
AddRegisteredPTRVariable('Settings','TMMLSettingsSandbox');
AddRegisteredVariable('Simba','TForm');
AddRegisteredVariable('Simba_MainMenu','TMainMenu');

2
Projects/Simba/simbaunit.pas
View File

@ -1299,7 +1299,7 @@ begin
if ConsoleVisible then
SetSetting('LastConfig/Console/Visible','True')
else
SetSetting('LastConfig/Console/Visible','false');
SetSetting('LastConfig/Console/Visible','False');
{$endif}
SetSetting('Extensions/ExtensionCount',inttostr(ExtManager.Extensions.Count));
for i := 0 to ExtManager.Extensions.Count-1 do

10
Units/MMLAddon/PSInc/Wrappers/extensions.inc
View File

@ -112,3 +112,13 @@ function ext_MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType;Butto
begin
result := MessageDlg(acaption,amsg,dlgtype,buttons,helpctx);
end;
function ext_SDTMToMDTM(Const DTM: TSDTM): TMDTM;
begin
result := SDTMToMDTM(DTM);
end;
function ext_InputQuery(const ACaption, APrompt : String; var Value : String) : Boolean;
begin
result := InputQuery(acaption,aprompt,value);
end;

1
Units/MMLAddon/PSInc/uPSC_mml.pas
View File

@ -104,6 +104,7 @@ begin
RegisterMethod('procedure free;');
RegisterProperty('Name','String',iptrw);
RegisterMethod('function ToString : string');
RegisterMethod('function LoadFromString(const s : string) : boolean;');
RegisterMethod('function Valid:boolean');
RegisterMethod('procedure DeletePoint( Point : integer);');
RegisterMethod('procedure SwapPoint(p1,p2 : integer);');

1
Units/MMLAddon/PSInc/uPSR_mml.pas
View File

@ -158,6 +158,7 @@ begin
RegisterConstructor(@TMDTM.Create,'Create');
RegisterMethod(@TMDTM.Free,'Free');
RegisterMethod(@TMDTM.ToString,'ToString');
RegisterMethod(@TMDTM.LoadFromString,'LoadFromString');
RegisterMethod(@TMDTM.Valid,'Valid');
RegisterMethod(@TMDTM.DeletePoint,'DeletePoint');
RegisterMethod(@TMDTM.SwapPoint,'SwapPoint');

200
Units/MMLCore/dtm.pas
View File

@ -44,6 +44,8 @@ type
Name : string;
Index : integer;
function ToString : string;
function LoadFromString(const s : string) : boolean;
procedure Normalize;
function Valid : boolean;
procedure DeletePoint( Point : integer);
procedure SwapPoint(p1,p2 : integer);
@ -146,91 +148,11 @@ end;
function TMDTMS.StringToDTM(const S: String): Integer;
var
b: PBufferByteArray;
MDTM : TMDTM;
Source : String;
DestLen : longword;
i,ii,c : integer;
DPoints : PMDTMPoint;
Ptr : Pointer;
function ReadInteger : integer;
aDTM : TMDTM;
begin
Result := PInteger(ptr)^;
inc(ptr,sizeof(integer));
end;
function ReadBoolean : boolean;
begin
result := PBoolean(ptr)^;
inc(ptr,sizeof(boolean));
end;
begin
MDTM := TMDTM.Create;
Result := AddDTM(MDTM);
ii := Length(S);
if (ii = 0) then
exit;
if S[1] = 'm' then
begin
if ii < 9 then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
Source := Base64DecodeStr(copy(s,2,ii-1));
i:= PLongint(@source[1])^; //The 4 four bytes should contain the dest len!
if i < 1 then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
DestLen := BufferLen;
ptr := @Source[1 + sizeof(longint)];
if uncompress(BufferString,DestLen,ptr,length(source)-sizeof(integer)) = Z_OK then
begin
ptr := BufferString;
MDTM.Count:= ReadInteger;
ii := MDTM.Count;
if (MDTM.Count * TMDTMPointSize) <> (Destlen - SizeOf(integer)) then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
DPoints := MDTM.PPoints;
for i := 0 to ii-1 do
DPoints[i].x := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].y := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].c := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].t := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].asz := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].bp := ReadBoolean;
end;
end else
begin
if (ii mod 2 <> 0) then
exit;
ii := ii div 2;
SetLength(Source,ii);
for i := 1 to ii do
Source[i] := Chr(HexToInt(S[i * 2 - 1] + S[i * 2]));
DestLen := BufferLen;
if uncompress(Bufferstring,Destlen,pchar(Source), ii) = Z_OK then
begin;
if (Destlen mod 36) > 0 then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
DestLen := DestLen div 36;
MDTM.Count:= DestLen;
DPoints := MDTM.PPoints;
b := PBufferByteArray(BufferString);
for i := 0 to DestLen - 1 do
begin;
c := i * 36;
DPoints[i].x := PInteger(@b^[c+1])^;
DPoints[i].y := PInteger(@b^[c+5])^;
DPoints[i].asz := PInteger(@b^[c+12])^;
// DPoints.ash[i] := PInteger(@b^[c+16])^;
DPoints[i].c := PInteger(@b^[c+20])^;
DPoints[i].t := PInteger(@b^[c+24])^;
DPoints[i].bp := False;
end;
end;
end;
aDTM := TMDTM.Create;
aDTM.LoadFromString(s);
Result := AddDTM(aDTM);
end;
@ -264,7 +186,7 @@ begin
end;
DTMList[Result] := d;
DTMList[Result].Index:= Result;
NormalizeDTM(DTMList[result]);
DTMList[result].Normalize;
end;
{/\
@ -363,12 +285,118 @@ begin
Freemem(start,len);
end;
function TMDTM.LoadFromString(const s: string): boolean;
var
MDTM : TMDTM;
Source : String;
DestLen : longword;
i,ii,c : integer;
DPoints : PMDTMPoint;
Ptr : Pointer;
function ReadInteger : integer;
begin
Result := PInteger(ptr)^;
inc(ptr,sizeof(integer));
end;
function ReadBoolean : boolean;
begin
result := PBoolean(ptr)^;
inc(ptr,sizeof(boolean));
end;
begin
Result := false;
ii := Length(S);
if (ii = 0) then
exit;
if S[1] = 'm' then
begin
if ii < 9 then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
Source := Base64DecodeStr(copy(s,2,ii-1));
i:= PLongint(@source[1])^; //The 4 four bytes should contain the dest len!
if i < 1 then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
DestLen := BufferLen;
ptr := @Source[1 + sizeof(longint)];
if uncompress(BufferString,DestLen,ptr,length(source)-sizeof(integer)) = Z_OK then
begin
ptr := BufferString;
Self.Count:= ReadInteger;
ii := Self.Count;
if (Self.Count * TMDTMPointSize) <> (Destlen - SizeOf(integer)) then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
DPoints := Self.PPoints;
for i := 0 to ii-1 do
DPoints[i].x := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].y := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].c := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].t := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].asz := ReadInteger;
for i := 0 to ii-1 do
DPoints[i].bp := ReadBoolean;
Result := true;
end;
end else
begin
if (ii mod 2 <> 0) then
exit;
ii := ii div 2;
SetLength(Source,ii);
for i := 1 to ii do
Source[i] := Chr(HexToInt(S[i * 2 - 1] + S[i * 2]));
DestLen := BufferLen;
if uncompress(Bufferstring,Destlen,pchar(Source), ii) = Z_OK then
begin;
if (Destlen mod 36) > 0 then
raise Exception.CreateFMT('Invalid DTM-String passed to StringToDTM: %s',[s]);
DestLen := DestLen div 36;
Self.Count:= DestLen;
DPoints := Self.PPoints;
ptr := bufferstring;
for i := 0 to DestLen - 1 do
begin;
DPoints[i].x :=PInteger(ptr + 1)^;
DPoints[i].y := PInteger(ptr + 5)^;
DPoints[i].asz := PInteger(ptr + 12)^;
// DPoints.ash[i] := PInteger(@b^[c+16])^;
DPoints[i].c := PInteger(ptr + 20)^;
DPoints[i].t := PInteger(ptr + 24)^;
DPoints[i].bp := False;
inc(ptr,36);
end;
Result := true;
end;
end;
if result then
Normalize;
end;
procedure TMDTM.Normalize;
var
i:integer;
begin
if (self = nil) or (Self.count < 1) or ((Self.Points[0].x = 0) and (Self.Points[0].y = 0)) then //Already normalized
exit;
for i := 1 to Self.Count - 1 do
begin
Self.Points[i].x := Self.Points[i].x - Self.Points[0].x;
Self.Points[i].y := Self.Points[i].y - Self.Points[0].y;
end;
Self.Points[0].x := 0;
Self.Points[0].y := 0;
end;
function TMDTM.Valid: boolean;
begin
result := false;
if Count < 1 then
exit;
NormalizeDTM(self);
Normalize;
result := true;
end;

20
Units/MMLCore/dtmutil.pas
View File

@ -41,7 +41,6 @@ function ValidMainPointBox(var dtm: TMDTM; const x1, y1, x2, y2: Integer): TBox;
function ValidMainPointBox(const TPA: TPointArray; const x1, y1, x2, y2: Integer): TBox;
function ValidMainPointBoxRotated(var dtm: TMDTM; const x1, y1, x2, y2: Integer;const
sAngle, eAngle, aStep: Extended): TBox;
procedure NormalizeDTM(var dtm: TMDTM);
{function RotateDTM(const dtm: TMDTM; angle: extended) : TMDTM;
function copydtm(const dtm: TMDTM): TMDTM; }
@ -142,21 +141,6 @@ begin
result.Points[i].bp := false;
end;
procedure NormalizeDTM(var dtm: TMDTM);
var
i:integer;
begin
if (dtm = nil) or (dtm.count < 1) or ((dtm.Points[0].x = 0) and (dtm.Points[0].y = 0)) then //Already normalized
exit;
for i := 1 to dtm.Count - 1 do
begin
dtm.Points[i].x := dtm.Points[i].x - dtm.Points[0].x;
dtm.Points[i].y := dtm.Points[i].y - dtm.Points[0].y;
end;
dtm.Points[0].x := 0;
dtm.Points[0].y := 0;
end;
function ValidMainPointBox(var dtm: TMDTM; const x1, y1, x2, y2: Integer): TBox;
var
@ -164,7 +148,7 @@ var
b: TBox;
begin
NormalizeDTM(dtm);
dtm.Normalize;
FillChar(b, SizeOf(TBox), 0); //Sets all the members to 0
b.x1 := MaxInt;
@ -203,7 +187,7 @@ var
d:extended;
begin
NormalizeDTM(dtm);
dtm.normalize;
{ Delete the ASZ
for i := 0 to high(dtm.c) do

2
Units/MMLCore/finder.pas
View File

@ -2178,7 +2178,7 @@ begin
if not dtm.Valid then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.name]);
NormalizeDTM(DTM);
dtm.Normalize;;
Len := DTM.Count;
DPoints:= DTM.PPoints;