SRL Archive - Reflection Development

program ReflectionInterfaceExplorer;
{$DEFINE SMART}
{$i srl\srl.scar}
{$i Reflection\reflection.simba}

const
{---SMART Setup Constants---}
  WORLD = 165;
  MEMBERS = false;
  SIGNED = true;
{---------------------------}

var
  frm: TForm;
  lb1, lb2: TListBox;
  box: TMemo;
  btn: TButton;

procedure UpdateInterfaces();
var
  intarr: TIntegerArray;
  x, up: integer;
begin
  SmartSetup('http://world' + IntToStr(WORLD) + '.runescape.com/', 'plugin.js?param=o0,a1,m0', 765, 503, 's');
  intarr := GetValidInterfaces();
  up := Length(intarr)-1;
  lb1.Items.Clear;
  for x := 0 to up do
    lb1.Items.Add(ToStr(intarr[x]));
end;

procedure ExpandInterfaces(parent: integer);
var
  intarr: TIntegerArray;
  x, up: integer;
begin
  intarr := GetValidInterfaceComponents(parent);
  up := Length(intarr)-1;
  lb2.Items.Clear;
  for x := 0 to up do
    lb2.Items.Add(ToStr(intarr[x]));
end;

{*******************************************************************************
procedure PointToPoint(start, finish: TPoint; var bmp: Integer; colour: TColor);
By: Bresenham (implemented in PS by mc_teo)
Description: Draws a line on given Bmp, from TPoint Start to TPoint Finish.
*******************************************************************************}
procedure PointToPoint(var bmp: Integer; start, finish: TPoint; colour: TColor);
var
  steep: boolean;
  deltax, deltay, error, ystep, x, y: integer;
begin
  steep := (iAbs(finish.Y - start.Y) > iAbs(finish.X - start.X));
    if steep then
      begin
        swap(start.X, start.Y);
        swap(finish.X, finish.Y);
      end;
    if start.X > finish.X then
      begin
        swap(start.X, finish.X);
        swap(start.Y, finish.Y);
      end;
    deltax := (finish.X - start.X);
    deltay := iAbs(finish.Y - start.Y);
    error := (deltax / 2);
    y := start.Y
    if (start.Y < finish.Y) then
      ystep := 1
    else
      ystep := -1;
    for x := start.X to finish.X do
      begin
        if steep then
          FastSetPixel(bmp, y, x, colour)
        else
          FastSetPixel(bmp, x, y, colour);
        error := error - deltay;
        if error < 0 then
          begin
            y := y + ystep;
            error := error + deltax;
          end;
      end;
end;

function DebugTPA(Points: TPointArray; Colour: TColor): Boolean;
var
  Bmp: integer;
  P: TPoint;
  Canvas: TCanvas;
begin
  GetClientDimensions(P.x, P.y);
  Bmp := BitmapFromString(P.x, P.y,'');
//  CleanTPA(Points);
  DrawTPABitmap(Bmp, Points, Colour);
  Canvas := TCANVAS.Create;
  Canvas.Handle := SmartGetDebugDC;
  DrawBitmap(Bmp, Canvas, 0, 0);
  FreeBitmap(Bmp);
  Result := True;
end;

function DebugTritangle(x1, y1, z1: TPoint; Colour: TColor): Boolean;
var
  Bmp: integer;
  P: TPoint;
  Canvas: TCanvas;
begin
  GetClientDimensions(P.x, P.y);
  Bmp := BitmapFromString(P.x, P.y, '');

  PointToPoint(Bmp, x1, y1, Colour);
  PointToPoint(Bmp, x1, z1, Colour);
  PointToPoint(Bmp, y1, z1, Colour);

  Canvas := TCANVAS.Create;
  Canvas.Handle := SmartGetDebugDC;

  DrawBitmap(Bmp, Canvas, 0, 0);
  FreeBitmap(Bmp);
  Result := True;
end;

procedure InformComponents(ParentI, ChildI: Integer);
var
  intarr: TIntegerArray;
  strarr: TStringArray;
  x, up, fileout: integer;
  p1, p2, p3: TPoint;
begin
  SetArrayLength(strarr, 12);

  strarr[0] := 'Id: ' + ToStr(GetInterfaceComponentID(ParentI, ChildI));
  strarr[1] := 'Stack: ' + ToStr(GetInterfaceComponentStack(ParentI, ChildI));
  strarr[2] := 'Text: ' + ToStr(GetInterfaceComponentText (ParentI, ChildI));
  strarr[3] := 'Texture ID: ' + ToStr(GetInterfaceComponentTextureID(ParentI, ChildI));
  strarr[4] := 'Model ID: ' + ToStr(GetInterfaceComponentModelID(ParentI, ChildI));
  strarr[5] := 'Model Zoom: ' + ToStr(GetInterfaceComponentModelZoom(ParentI, ChildI));
  strarr[6] := 'Relative X: ' + ToStr(GetInterfaceComponentRelativeX (ParentI, ChildI ));
  strarr[7] := 'Relative Y: ' + ToStr(GetInterfaceComponentRelativeY (ParentI, ChildI ));
  strarr[8] := 'Component Width: ' + ToStr(GetInterfaceComponentWidth (ParentI, ChildI ));
  strarr[9] := 'Component Height: ' + ToStr(GetInterfaceComponentHeight (ParentI, ChildI ));
//  strarr[10] := ToStr(GetInterfaceComponentRelativePoint (ParentI, ChildI ): TPoint;
//  strarr[11] := ToStr(GetInterfaceAbsolutePointBase (ParentI ): TPoint;

  p2 := GetInterfaceComponentRelativePoint(ParentI, ChildI);
  p1 := Point(GetInterfaceComponentRelativeX(ParentI, ChildI) + GetInterfaceComponentWidth(ParentI, ChildI), GetInterfaceComponentRelativeY(ParentI, ChildI) + GetInterfaceComponentHeight(ParentI, ChildI));
  p3 := GetInterfaceAbsolutePointBase(ParentI);

  DebugTritangle(p1, p2, p3, clFuchsia);
  writeln('p1 = (' + inttostr(p1.X) + ',' + inttostr(p1.Y) + ') p2 = (' + inttostr(p2.X) + ',' + inttostr(p2.Y) + ') p3 = (' + inttostr(p3.X) + ',' + inttostr(p3.Y) + ')');

  up := Length(strarr)-1;
  box.Lines.Clear;
  for x := 0 to up do
    box.Lines.Add(strarr[x]);

end;

procedure lb1Click(Sender: TObject);
begin
  ExpandInterfaces(StrToInt(lb1.ITEMS[lb1.ITEMINDEX]));
end;

procedure lb2Click(Sender: TObject);
begin
  InformComponents(StrToInt(lb1.ITEMS[lb1.ITEMINDEX]), StrToInt(lb2.ITEMS[lb2.ITEMINDEX]));
end;

procedure btnUpdate(Sender: TObject);
begin
  UpdateInterfaces();
end;

procedure myCreateForm;
begin
  with frm do
  begin
    Width := 415;
    Height := 395;
    Caption := 'Reflection Interface Explorer - mc_teo';
  end;

  btn := TButton.Create(frm);
  with btn do
  begin
    Parent := frm;
    Left := 8;
    Top := 362;
    Width := 400;
    Height := 30;
    Caption := 'Initiate!';

    OnClick := @btnUpdate;
  end;

  lb1 := TListbox.Create(frm);
  with lb1 do
  begin
    Parent := frm;
    Left := 8;
    Top := 8;
    Width := 100;
    Height := 350;
    ItemHeight := 13;

    OnClick := @lb1Click;
  end;

  lb2 := TListbox.Create(frm);
  with lb2 do
  begin
    Parent := frm;
    Left := 120;
    Top := 8;
    Width := 100;
    Height := 350;
    ItemHeight := 13;

    OnClick := @lb2Click;
  end;

  box := TMemo.Create(frm);
  with box do
  begin
    Parent := frm;
    Left := 232;
    Top := 8;
    Width := 177;
    Height := 350;
    Lines.Add('Memo1');
  end;

end;

function ShowForm: Integer;
begin
  frm := TForm.Create(nil);

  try
    myCreateForm;
    Result := frm.ShowModal;
  finally
    frm.Free;
  end;
end;

procedure ThreadSafe_ShowForm;
var
  v: TVariantArray;
begin
  v := [];
  ThreadSafeCall('ShowForm', v);
end;

begin
  Smart_Members := MEMBERS;
  Smart_Server := WORLD;
  Smart_Signed := SIGNED;

  SetupSRL;
  SetupReflectionEx(true);

  ThreadSafe_ShowForm;
end.

Just a simple little interface explorer I made the other day.

I've started the canvas painting methods (make sure the Debug button is enabled) but as you can see, they are far from done. I think they will need some fixing on the SMART side of things too, since most of the interface procedures produce (0,0) for TPoints.

Anyways, hope its useful.

~mc_teo

Looks good mate, keep up the good work!

Sorry, pardon my ignorance.. but doesn't this force you to update the interfaces manually? Also, why do you have to restart smart each time?

Why not use a TTimer and set it to update the interfaces as it runs? Should allow you do save the restart. Just set it to say.. 500ms, it'll update enough. If I recall, a timer halts other execution while it runs, otherwise you might have to play with some thread-safe practices, but it *should* be fine.

Also, isn't there a .line() method associated with TMufasaBitmaps?

Great idea though, this was really necessary! :)

Yes, is does force the user to update manually, simply because I didnt see any use for it to update live.

As far as I'm aware, TTimers don't work correctly outside of extensions. I had thought of making it an extension, but I left it for the below reason.

Smart needs to restart each time, as to Get the interfaces it needs to be in the same thread as the form, so when the forms thread restarts, so smart needs to be too. I asked Benland100 about it, and he said it was the only way to get to work (well, not crash)

There could be some line method, but I made those procedures a while myself, a while ago, so I knew exactly how they worked. I did some test cases on them, and the first lag I noticed due to just them was when drawing three separate lines, following the mouse, in realtime, but I don't think they are all that efficient though, would probably be needed to precompiled into simba, or a plugin to speed them up considerable.

~mc_teo

From: Nava2
Also, isn't there a .line() method associated with TMufasaBitmaps?

Nope.. I reported it @ Mantis

From: Nava2
Why not use a TTimer and set it to update the interfaces as it runs? Should allow you do save the restart. Just set it to say.. 500ms, it'll update enough. If I recall, a timer halts other execution while it runs, otherwise you might have to play with some thread-safe practices, but it *should* be fine.

Preferably a checkbox to toggle this option.