Object DTM Generation Tool

Program ObjectDTMGenerationTool;
//{$DEFINE SMART}
{$i SRL\SRL.simba}
{$i ObjectDTM\ObjDTMInclude.simba}

var
  CleanMap, CurrentMap, I, X, Y: Integer;

  SubPoints: TPointArray;
  Objects: MMObjArray;
  ObjectDTM: ObjDTM;

  PageControl: TPageControl;
  TabSheet: Array [0..3] of TTabSheet;

  PropertiesControl: TPageControl;
  PropertySheet: Array [0..2] of TTabSheet;
  PropertyPanel: TPanel;

  ToolForm: TForm;
  MMap: TImage;
  ObjectsList: TListBox;
  Instructions: TListBox;
  Output: TMemo;
  MainFormButtons: Array [0..1] of TButton;
  SubPointButtons: Array [0..3] of TButton;

procedure DeclarePlayers;
begin

  HowManyPlayers := 1;
  CurrentPlayer := 0;
  SetLength(Players, HowManyPlayers);

  Players[0].Name := '';
  Players[0].Pass := '';
  Players[0].Member := False;
  Players[0].Active := True;
end;

procedure DrawDotsEx(pixels: TPointArray; color: Integer);
{:: Author: Sir R. Magician ::}
var
  i : integer;
begin

  MMap.Canvas.Pen.Color := color;

  for i:= 0 to high(pixels) do
  begin

    MMap.canvas.moveto(pixels[i].x,pixels[i].y);
    MMap.canvas.LineTo(pixels[i].x+1,pixels[i].y);
  end;
end;

procedure DrawLine(TP1, TP2: TPoint; Color: TColor);
{:: Author: mormonman ::}
begin

  MMap.canvas.Pen.Color := Color;

  MMap.canvas.moveto(TP1.x,TP1.y);
  MMap.canvas.LineTo(TP2.x,TP2.y);
end;

procedure DrawCircle(Center: TPoint; Radius: Integer; Fill: Boolean; Color: TColor);
{:: Author: mormonman ::}
var
  TPA: TPointArray;
begin
  TPA := TPAFromBox(IntToBox(Center.X - Radius, Center.Y - Radius, Center.X + Radius, Center.Y + Radius));
  FilterPointsPie(TPA, 0, 360, -1, Radius, Center.X, Center.Y);

  if (not Fill) then
    FilterPointsDist(TPA, Radius-1, Radius, Center.X, Center.Y);

  if (Length(TPA) >= 1) then
    DrawDotsEx(TPA, Color);
end;

procedure DrawPolygons(Polygons: T2DPointArray; color: TColor);
{:: Author: mormonman ::}
var
  i, h, Hi: Integer;
begin

  if (Length(Polygons) < 1) then
    Exit;

  for h := 0 to High(Polygons) do
  begin
    Hi := High(Polygons[h]);
    if (Hi < 2) then Exit;

    for i := 0 to Hi - 1 do
      DrawLine(Polygons[h][i], Polygons[h][i+1], color);

    DrawLine(Polygons[h][Hi], Polygons[h][0], color);
  end;
end;

procedure GatherMiniMap;
var
  I: Integer;
  TIA: TIntegerArray;
  TPA: TPointArray;
begin

  TPA := TPAFromBox(IntToBox(548, 6, 708, 166));
  FilterPointsPie(TPA, 0, 360, 0, 80, MMCX, MMCY);

  TIA := GetColors(TPA);
  OffsetTPA(TPA, IntToPoint(-548, -6));

  FastSetPixels(CleanMap, TPA, TIA);
  FastSetPixels(CurrentMap, TPA, TIA);

  DrawBitmap(CleanMap, MMap.Canvas, 0, 0);

  for I := 0 to High(SubPoints) do
    DrawCircle(SubPoints[i], 7, False, clLime);
end;

procedure GatherObject;
var
  I: Integer;
  Name: String;
  Points: String;
  ObjectsTPA: TPointArray;
begin

  case ObjectsList.ItemIndex of

   -1: Name := 'invalid';
    0: Name := 'ladders';
    1: Name := 'trees';
    2: Name := 'dead trees';
    3: Name := 'plants';
    4: Name := 'flax';
    5: Name := 'boulders';
    6: Name := 'henges';
    7: Name := 'cacti';
    8: Name := 'maple trees';
    9: Name := 'rocks';
  end;

  if (Name = 'invalid') then
  begin

    WriteLn('You have passed an ' + name + ' index to the finding function, please select an object first.');
    Exit;
  end;

  ObjectsTPA := FindMiniMapObj(MMObjRecords[ObjectsList.ItemIndex]);

  SetLength(Objects, Length(ObjectsTPA));
  OffsetTPA(ObjectsTPA, IntToPoint(-548, -6));

  DrawBitmap(CleanMap, MMap.Canvas, 0, 0);

  for I := 0 to (Length(ObjectsTPA) - 1) do
  begin

    DrawCircle(ObjectsTPA[i], 7, False, clWhite);

    Points := Points + '(' + IntToStr(ObjectsTPA[i].x) + ', ' + IntToStr(ObjectsTPA[i].y) + '), ';
    Objects[i].Center := ObjectsTPA[i];
    Objects[i].ObjType := ObjectsList.ItemIndex;
  end;

  for I := 0 to High(SubPoints) do
    DrawCircle(SubPoints[i], 7, False, clLime);

  Output.Clear;
  Output.Lines.Add(Points);
end;

procedure SubPointManager;
begin

  for I := 0 to High(Objects) do
  begin

    if InCircle(X, Y, Objects[i].Center.x, Objects[i].Center.y, 7) then
    begin

      if (not PointInTPA(Objects[i].Center, SubPoints)) then
      begin

        Inc(ObjectDTM.NumOfPoints);

        SetLength(ObjectDTM.SubPoints, ObjectDTM.NumOfPoints);
        SetLength(SubPoints, ObjectDTM.NumOfPoints);

        ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Base := Objects[i].ObjType;
        ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Point := Objects[i].Center;
        ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Drift := 7;

        SubPoints[(ObjectDTM.NumOfPoints) - 1] := Objects[i].Center;

        DrawCircle(SubPoints[(ObjectDTM.NumOfPoints) - 1], 7, False, clLime);
        Exit;
      end else
        Continue;
    end;
  end;

  for I := 0 to (ObjectDTM.NumOfPoints - 1) do
  begin

    if (not InCircle(X, Y, SubPoints[i].x, SubPoints[i].y, 7)) then
      Continue;

    DrawCircle(SubPoints[i], 7, False, clRed);

    ObjectDTM.SubPoints[i].Base := ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Base;
    ObjectDTM.SubPoints[i].Point := ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Point;
    ObjectDTM.SubPoints[i].Drift := ObjectDTM.SubPoints[(ObjectDTM.NumOfPoints) - 1].Drift;


    SubPoints[i] := SubPoints[(ObjectDTM.NumOfPoints) - 1];

    ObjectDTM.NumOfPoints := (ObjectDTM.NumOfPoints) - 1;

    SetLength(SubPoints, ObjectDTM.NumOfPoints);
    SetLength(ObjectDTM.SubPoints, ObjectDTM.NumOfPoints);
  end;
end;

procedure AreaManager;
begin
    {
  with Buttons[0] do
  begin

    Caption := 'grab minimap';
    OnClick := @MouseClick;
  end;

  with Buttons[1] do
  begin

    Caption := 'gather object';
    OnClick := @MouseClick;
  end;

  with Buttons[2] do
  begin

    Caption := 'add area polygon';
    OnClick := @MouseClick;
  end;

  with Buttons[3] do
  begin

    Caption := 'print object dtm';
    OnClick := @MouseClick;
  end;
  }
end;

procedure MainPointManager(Click: Boolean);
begin

  DrawBitmap(CleanMap, MMap.Canvas, 0, 0);

  if Click then
    ObjectDTM.MainPoint := IntToPoint(X, Y);

  for I := 0 to High(SubPoints) do
  begin

    DrawCircle(SubPoints[i], 7, False, clLime);
    DrawLine(ObjectDTM.MainPoint, SubPoints[i], clWhite);
  end;

  for I := 0 to High(SubPoints) do
    DrawLine(IntToPoint(X, Y), SubPoints[i], clYellow);
end;

procedure PrintManager;
var
  ObjectDTMString: String;
begin

  ObjectDTMString := ObjDTMToString(ObjectDTM);

  OutPut.LINES.Clear;
  OutPut.LINES.Add(ObjectDTMString);

  ObjDTM_PrintToRec(ObjectDTMString);
  Writeln('');
  WriteLn(ObjectDTMString);
end;

procedure MouseMove(Sender: TObject; S: TShiftState; mX, mY: Integer);
begin

  X := mX;
  Y := mY;

  case Sender of

    MMap:
      begin

        if (PropertiesControl.ActivePageIndex = 1) then
          MainPointManager(False);
      end;
  end;
end;

procedure MouseClick(Sender: TObject);
begin

  case Sender of

    MainFormButtons[0]: GatherMiniMap;
    MainFormButtons[1]: PrintManager;

    SubPointButtons[0]: GatherObject;

    PropertiesControl:
    begin

      case PropertiesControl.ActivePageIndex of

        0:
        begin

          Instructions.Items.Clear;
          Instructions.Items.Add('Instructions: Select an object from the list and click ' + #39 + 'gather object' + #39 + ' to display');
          Instructions.Items.Add('all instances of that object on the minimap.');
          Instructions.Items.Add('click within circles to add or remove sub-points.');
        end;

        1:
        begin

          Instructions.Items.Clear;
          Instructions.Items.Add('Instructions: Displays current main-point of the Object DTM.');
          Instructions.Items.Add('Mouse over a position and click to change the main-point.');
        end;
      end;
    end;

    MMap:
    begin

      case PropertiesControl.ActivePageIndex of

        0: SubPointManager;
        1: MainPointManager(True);
      end;
    end;
  end;
end;

procedure ToolForm_Init;
begin

  ToolForm := TForm.Create(nil);
  MMap := TImage.Create(TabSheet[0]);
  ObjectsList := TListBox.Create(TabSheet[0]);
  Instructions := TListBox.Create(TabSheet[0]);
  Output := TMemo.Create(TabSheet[0]);
  PropertyPanel := TPanel.Create(TabSheet[0]);

  PageControl := TPageControl.Create(ToolForm);
  PageControl.Parent := ToolForm;
  PageControl.Width := 510;
  PageControl.Height := 330;
  PageControl.Caption := 'TabPageControl';

  PropertiesControl := TPageControl.Create(ToolForm);
  PropertiesControl.Parent := PropertyPanel;
  PropertiesControl.Width := 210;
  PropertiesControl.Height := 160;
  PropertiesControl.Caption := 'PropertyPageControl';
  //PropertiesControl.OnChange := @MouseClick;
  PropertiesControl.OnPageChanged := @MouseClick;

  for I := 0 to 3 do
  begin

    TabSheet[I] := TTabSheet.Create(PageControl);
    TabSheet[I].Parent := PageControl;
    TabSheet[I].PageControl := PageControl;
  end;

  TabSheet[0].Caption := 'single';
  TabSheet[1].Caption := 'multi';
  TabSheet[2].Caption := 'path';
  TabSheet[3].Caption := 'multi-path';

  for I := 0 to 2 do
  begin

    PropertySheet[I] := TTabSheet.Create(ToolForm);
    PropertySheet[I].Parent := PropertyPanel;
    PropertySheet[I].PageControl := PropertiesControl;
  end;

  PropertySheet[0].Caption := 'sub-points';
  PropertySheet[1].Caption := 'main-point';
  PropertySheet[2].Caption := 'area';

  with PropertyPanel do
  begin
    Parent := TabSheet[0];
    Left := 282;
    Top := 10;
    Caption := 'Object DTM Generation Tool  - by euphemism';
    Width := 210;
    Height := 160;
  end;

  for I := 0 to 1 do
  begin

    MainFormButtons[i] := TButton.Create(ToolForm);
    MainFormButtons[i].Parent := ToolForm;
    MainFormButtons[i].Width := 100;
    MainFormButtons[i].Height := 30;
    MainFormButtons[i].Top := 55 + (i * 34);
    MainFormButtons[i].Left := 176;
  end;

  with MainFormButtons[0] do
  begin

    Caption := 'grab minimap';
    OnClick := @MouseClick;
  end;

  with MainFormButtons[1] do
  begin

    Caption := 'print object dtm';
    OnClick := @MouseClick;
  end;

  with SubPointButtons[0] do
  begin

    SubPointButtons[0] := TButton.Create(ToolForm);
    Parent := PropertySheet[0];
    Left := 102;
    Top := 4;
    Height := 30;
    Width := 100;

    Caption := 'gather object';
    OnClick := @MouseClick;
  end;

  with ToolForm do
  begin
    Left := 430;
    Top := 174;
    Caption := 'Object DTM Generation Tool  - by euphemism';
    ClientWidth := 510;
    ClientHeight := 330;
    Color := 15790320;
  end;

  with MMap do
  begin
    Parent := TabSheet[0];
    Left := 5;
    Top := 10;
    Width := 160;
    Height := 160;
    OnClick := @MouseClick;
    OnMouseMove := @MouseMove;
  end;

  with ObjectsList do
  begin
    Parent := PropertySheet[0];
    Left := 0;
    Top := 4;
    Width := 100;
    Height := 127;
    ItemHeight := 13;
    Items.Add('Ladders');
    Items.Add('Trees');
    Items.Add('Dead Trees');
    Items.Add('Plants');
    Items.Add('Flax');
    Items.Add('Boulders');
    Items.Add('Henges');
    Items.Add('Cacti');
    Items.Add('Maple Trees');
    Items.Add('Rocks');
  end;

  with Instructions do
  begin
    Parent := TabSheet[0];
    Left := 10;
    Top := 180;
    Width := 480;
    Height := 50;
    Items.Add('Instructions: Click ' + #39 + 'grab minimap' + #39 + ' to grab the current map view.');
    Items.Add('Select an object from the list and click ' + #39 + 'gather object' + #39 + ' to display');
    Items.Add('all instances of that object on the minimap.');
  end;

  with Output do
  begin
    Parent := TabSheet[0];
    Color := 16777215;
    Left := 10;
    Top := 235;
    Width := 480;
    Height := 55;
  end;

  CleanMap := BitmapFromString(160, 160, '');
  CurrentMap := BitmapFromString(160, 160, '');

  FloodFillBitmap(CleanMap, IntToPoint(0, 0), 0, 16777215);
  FloodFillBitmap(CurrentMap, IntToPoint(0, 0), 0, 16777215);

  SetBitmapName(CleanMap, 'Clean');
  SetBitmapName(CurrentMap, 'Current');

  DrawBitmap(CleanMap, MMap.Canvas, 0, 0);

  SubPoints := LoadTextTPA('Click ' + #39 + 'grab minimap' + #39, 'SmallChars', I);
  OffSetTPA(SubPoints, IntToPoint(28, 62));
  DrawDotsEx(SubPoints, 000000001);

  SubPoints := LoadTextTPA('to get client image', 'SmallChars', I);
  OffSetTPA(SubPoints, IntToPoint(31, 79));
  DrawDotsEx(SubPoints, 000000001);

  SetLength(SubPoints, 0);
end;

procedure ToolForm_SafeInit;
var
  v: TVariantArray;
begin
  SetLength(v, 0);
  ThreadSafeCall('ToolForm_Init', v);
end;

function ToolForm_ShowModal: Boolean;
begin
  Result := ToolForm.ShowModal = mrOk;
end;

function ToolForm_SafeShowModal: Boolean;
var
  v: TVariantArray;
begin
  SetLength(v, 0);
  Result := ThreadSafeCall('ToolForm_ShowModal', v);
end;

begin

  {$IFDEF SMART}
    SMART_Server := 10;
    SMART_Members := True;
    SMART_Signed := True;
  {$ENDIF}

  SetupSRL;
  ObjDTM_Setup;

  ObjectDTM.MainPoint := IntToPoint(80, 80);
  ObjectDTM.NumOfPoints := 0;
  ObjectDTM.NumOfAreaPoints := 0;

  SetLength(ObjectDTM.SubPoints, ObjectDTM.NumOfPoints);
  SetLength(ObjectDTM.Area, ObjectDTM.NumOfAreaPoints);

  DeclarePlayers;

  if (not LoggedIn) then
    LoginPlayer;

  while (not RSReady) do
    Wait(500);

  ToolForm_SafeInit;

  if ToolForm_SafeShowModal then
    WriteLn('Form returned modalresult ok');

  FreeBitmap(CleanMap);
  FreeBitmap(CurrentMap);
end.