Simba/Units/MMLCore/dtm.pas

{
	This file is part of the Mufasa Macro Library (MML)
	Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer

    MML is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    MML is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with MML.  If not, see <http://www.gnu.org/licenses/>.

	See the file COPYING, included in this distribution,
	for details about the copyright.

    DTM class for the Mufasa Macro Library
}

unit dtm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, MufasaTypes;

type

    { TMDTM }

    TMDTM = class(TObject)
    private
      FPoints : TMDTMPointArray;
      FLen    : integer;
      function GetPointerPoints: PMDTMPoint;
      procedure SetPointCount(const AValue: integer);
    public
      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);
      procedure MovePoint(fromIndex,toIndex : integer);
      procedure AddPoint( Point : TMDTMPoint);
      property PPoints : PMDTMPoint read GetPointerPoints;
      property Count : integer read FLen write SetPointCount;
      property Points : TMDTMPointArray read FPoints;
    end;
    { TMDTMS }

    TMDTMS = class(TObject) //Manages the DTMs   TMufasaDTMs
    private
      Client: TObject;
      DTMList: Array Of TMDTM;
      FreeSpots: Array Of Integer;
      procedure CheckIndex(index : integer);
    public
      function AddDTM(const d: TSDTM): Integer;overload;
      function AddDTM(const d: TMDTM): Integer;overload;
      function GetDTM(index: Integer) :TMDTM;
      procedure FreeDTM(DTM: Integer);
      function StringToDTM(const S: String): Integer;
      property DTM[Index : integer]: TMDTM read GetDTM; default;
      constructor Create(Owner: TObject);
      destructor Destroy; override;
    end;

implementation
uses
    dtmutil, paszlib,
    client,
    DCPbase64,
    graphics, // for TColor
    math // for max
    ;




constructor TMDTMS.Create(Owner: TObject);
begin
  inherited Create;
  Self.Client := Owner;

  SetLength(DTMList, 0);
  SetLength(FreeSpots, 0);
end;

{$DEFINE DTM_DEBUG}
destructor TMDTMS.Destroy;
var
  i, j: integer;
  b:boolean;
  WriteStr : string;
begin
  WriteStr := '[';
  for i := 0 to high(DTMList) do
  begin
    b := false;
    for j := 0 to high(freespots) do
      if i = freespots[j] then
      begin
        b := true;
        break;
      end;
      if not b then
      begin;
        if DTMList[i].name <> '' then
          WriteStr := WriteStr + DTMList[i].name + ', '
        else
          WriteStr := WriteStr + inttostr(i) + ', ';
        FreeDTM(i);
      end;
  end;
  if WriteStr <> '[' then  //Has unfreed DTMs
  begin
    SetLength(WriteStr,length(WriteStr)-1);
    WriteStr[Length(writeStr)] := ']';
    TClient(Client).Writeln(Format('The following DTMs were not freed: %s',[WriteStr]));
  end;
  SetLength(DTMList, 0);
  SetLength(FreeSpots, 0);

  inherited Destroy;
end;

//  Rotates the given point (p) by A (in radians) around the point defined by cx, cy.

function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint; inline;
begin
  Result.X := Round(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
  Result.Y := Round(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
end;

function HexToInt(const HexNum: string): LongInt;inline;
begin
   Result:=StrToInt('$' + HexNum);
end;

function TMDTMS.StringToDTM(const S: String): Integer;
var
  aDTM : TMDTM;
begin
  aDTM := TMDTM.Create;
  aDTM.LoadFromString(s);
  Result := AddDTM(aDTM);
end;


procedure TMDTMS.CheckIndex(index: integer);
begin
  if (index < 0) or (index >= Length(DTMList)) or (DTMList[Index] = nil) then
    raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]);
end;

function TMDTMS.AddDTM(const d: TSDTM): Integer;
begin
  Result := AddDTM(SDTMToMDTM(d));
end;

{/\
  Adds the given pDTM to the DTM Array, and returns it's index.
/\}

function TMDTMS.AddDTM(const d: TMDTM): Integer;
begin

  if Length(FreeSpots) > 0 then
  begin
    Result := FreeSpots[High(FreeSpots)];
    SetLength(FreeSpots, High(FreeSpots));
  end
  else
  begin
    SetLength(DTMList, Length(DTMList) + 1);
    Result := High(DTMList);
  end;
  DTMList[Result] := d;
  DTMList[Result].Index:= Result;
  DTMList[result].Normalize;
end;

{/\
   Returns the DTM (pDTM type) in the variable dtm at the given index.
   Returns true is succesfull, false if the dtm does not exist.
/\}

function TMDTMS.GetDTM(index: Integer) :TMDTM;
begin
  CheckIndex(index);
  result := DTMList[index];
end;

{/\
  Unloads the DTM at the given index from the DTM Array.
  Notes:
  Will keep track of not used index, so it is very memory efficient.
/\}

procedure TMDTMS.FreeDTM(DTM: Integer);
begin
  CheckIndex(DTM);
  DTMList[DTM].Free;
  DTMList[DTM] := nil;
  SetLength(FreeSpots, Length(FreeSpots) + 1);
  FreeSpots[High(FreeSpots)] := DTM;
end;

{ TMDTM }

function TMDTM.GetPointerPoints: PMDTMPoint;
begin
  if count < 1 then
    result := nil
  else
    result := @FPoints[0];
end;

procedure TMDTM.SetPointCount(const AValue: integer);
begin
  SetLength(FPoints,AValue);
  FLen := AValue;
end;

//We save the data as arrays for each point (so we can add features to DTMs without having to change
//the way the ToString is done..
//E.G. A DTM with 3 points would become
//LenXXXYYYCCCTTTASZASZASZBPBPBP

function TMDTM.ToString: string;
var
  i,len : integer;
  Ptr,Start : Pointer;
  Destlen : Longword;
procedure WriteInteger(int : integer);
begin
  PLongInt(Ptr)^ := int;
  Inc(ptr,sizeof(int));
end;
procedure WriteBool(bool : boolean);
begin;
  PBoolean(Ptr)^ := bool;
  inc(ptr,sizeof(boolean));
end;

begin
  result := '';
  if Count < 1 then
    exit;
  len := Count * TMDTMPointSize + SizeOf(Integer);
  Start:= GetMem(len);
  Ptr := Start;
  WriteInteger(FLen);
  for i := 0 to FLen-1 do
    WriteInteger(FPoints[i].x);
  for i := 0 to FLen-1 do
    WriteInteger(FPoints[i].y);
  for i := 0 to FLen-1 do
    WriteInteger(FPoints[i].c);
  for i := 0 to FLen-1 do
    WriteInteger(FPoints[i].t);
  for i := 0 to FLen-1 do
    WriteInteger(FPoints[i].asz);
  for i := 0 to FLen-1 do
    WriteBool(FPoints[i].bp);
  Destlen :=BufferLen;
  if compress(BufferString,destlen,pchar(start),len) = Z_OK then
  begin
    setlength(result,Destlen + SizeOf(Integer));
    PInteger(@result[1])^ := len;
    Move(bufferstring[0],result[1 + sizeof(integer)],Destlen);
    //We now have Size + Compressed data.. Lets Base64Encrypt it!
    Result := 'm' + Base64EncodeStr(result);
    //It now looks like m + base64encoded data! The 'm' is to indicate we used this encryption method.
  end;
  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;
  Normalize;
  result := true;
end;

procedure TMDTM.DeletePoint(Point: integer);
begin
  MovePoint(Point,FLen-1);
  Count := Count - 1;
end;

procedure TMDTM.SwapPoint(p1, p2: integer);
var
  Temp : TMDTMPoint;
begin
  Temp := FPoints[p1];
  FPoints[p1] := FPoints[p2];
  FPoints[p2] := Temp;
end;

procedure TMDTM.MovePoint(fromIndex, toIndex: integer);
var
  i : integer;
begin
  if fromIndex > toIndex then //We are going down
  begin
    for i := fromindex downto Toindex+1 do
      SwapPoint(i,i-1);
  end else if fromIndex < toIndex then
    for i := fromindex to toindex - 1 do
      SwapPoint(i,i+1);
end;

procedure TMDTM.AddPoint(Point: TMDTMPoint);
begin
  Count:= Count + 1;
  FPoints[FLen-1] := Point;
end;

end.