SRL Archive - Research & Development Lounge

these are a few little things that i came up with, they may not be useful for others, but i think i can use them.

the first script opens up a form, where you decide which command you want to do. you can only use one at a time for now, if i feel like it i'll change it so you can do how many ever i want(all i have to do is change ids)

you put the "receiver" procedure into the script that you want to you, and when the script calls it, it will do what ever it is told.

the remote control part:

program New;

var
  // InitForm variables.
  EndInitForm : Boolean;
  frmDesign : TForm;
  Label1 : TLabel;
  CheckBox1, CheckBox2, CheckBox3, CheckBox4,
  CheckBox5 : TCheckBox;
  Button1 : TButton;

procedure InitFormOnClose(Sender : TObject; var Action : TCloseAction);
begin
  if (not(frmDesign.ModalResult = 1)) then
    EndInitForm := True;
end;

procedure StartClick(sender: TObject);
begin
   frmDesign.ModalResult:= mrOk; // Closes the form
   if CheckBox1.Checked then
   begin
     SendInterSCARInteger('id', 1);
   end;
   if CheckBox2.Checked then
   begin
     SendInterSCARInteger('id', 2);
   end;
   if CheckBox3.Checked then
   begin
     SendInterSCARInteger('id', 3);
   end;
   if CheckBox4.Checked then
   begin
     SendInterSCARInteger('id', 4);
   end;
   if CheckBox5.Checked then
   begin
     SendInterSCARInteger('id', 5);
   end;
end;

procedure InitForm;
var
  TimeInitForm : Integer;
begin
  TimeInitForm := GetSystemTime;
  frmDesign := CreateForm;
  with frmDesign do
  begin
    OnClose := @InitFormOnClose;
    Position := poScreenCenter;
    BorderStyle := bsSingle;
    BorderIcons := [biMinimize,biSystemMenu];
    ClientWidth := 183;
    ClientHeight := 213;
    Caption := 'Remote Control';
    Color := clBtnFace;
    Font.Color := clWindowText;
    Font.Height := -16;
    Font.Name := 'MS Sans Serif';
    Font.Style := [];
    PixelsPerInch := 96;
  end;
  Label1 := TLabel.Create(frmDesign);
  with Label1 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 8;
    Width := 127;
    Height := 20;
    Caption := 'Remote Control';
    Font.Color := clGreen;
    Font.Height := -16;
    Font.Name := 'MS Sans Serif';
    Font.Style := [fsBold, fsUnderline];
  end;
  CheckBox1 := TCheckBox.Create(frmDesign);
  with CheckBox1 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 40;
    Width := 137;
    Height := 17;
    Caption := 'Terminate Script';
    TabOrder := 8;
  end;
  CheckBox2 := TCheckBox.Create(frmDesign);
  with CheckBox2 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 64;
    Width := 145;
    Height := 25;
    Caption := 'Progress Report';
    TabOrder := 9;
  end;
  CheckBox3 := TCheckBox.Create(frmDesign);
  with CheckBox3 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 96;
    Width := 105;
    Height := 17;
    Caption := 'Next Player';
    TabOrder := 10;
  end;
  CheckBox4 := TCheckBox.Create(frmDesign);
  with CheckBox4 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 120;
    Width := 97;
    Height := 25;
    Caption := 'Log Out';
    TabOrder := 11;
  end;
  CheckBox5 := TCheckBox.Create(frmDesign);
  with CheckBox5 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 144;
    Width := 97;
    Height := 25;
    Caption := 'Log In';
    TabOrder := 12;
  end;
  Button1 := TButton.Create(frmDesign);
  with Button1 do
  begin
    Parent := frmDesign;
    Left := 40;
    Top := 176;
    Width := 75;
    Height := 25;
    Caption := 'Go';
    TabOrder := 13;
    Button1.OnClick := @StartClick;
  end;
  WriteLn('InitForm compiled in ' + IntToStr(GetSystemTime - TimeInitForm) + ' milliseconds!');
end;

procedure SafeInitForm;
var
  v : TVariantArray;
begin
  SetArrayLength(v, 0);
  ThreadSafeCall('InitForm', v);
end;

procedure ShowInitFormModal;
begin
  frmDesign.ShowModal;
end;

procedure SafeShowInitFormModal;
var
  v : TVariantArray;
begin
  SetArrayLength(v, 0);
  ThreadSafeCall('ShowInitFormModal', v);
end;

procedure MainInitForm;
begin
  try
    SafeInitForm;
    SafeShowInitFormModal;
  finally
    FreeForm(frmDesign);
  except
    WriteLn('An error seems to have occurred in: InitForm');
  end;
end;

begin
  ClearDebug;
  GetSelf.WindowState := wsMinimized;
  MainInitForm;
  GetSelf.WindowState := wsNormal;
  if (EndInitForm) then
    TerminateScript;
end.

and the receiver procedure:

procedure InterScarControl;
begin
  case readinterscarinteger('id') of
    1: begin
         writeln('Inter Scar Control: Terminating');
         terminatescript;
       end;
    2: begin
         writeln('Inter Scar Control: Progress Report');
         //your own progress report procedure
       end;
    3: begin
         writeln('Inter Scar Control: Next Player');
         //your own Next player procedure
       end;
    4: begin
         writeln('Inter Scar Control: Log Out');
         Logout;
         while not readinterscarinteger('id') = 5 do wait(100 + random(1000));
       end;
    5: begin
         writeln('Inter Scar Control: Log In');
         Loginplayer;
       end;
  end;
  sendinterscarinteger('id', 0);
end;

hopefully i get some ideas going to make better and more usefull commands, and the same goes with you guys

enjoy and post feed back :)

To me this seems kind of pointless.

From: Feroc1ty
To me this seems kind of pointless.

To me you seem kind of arrogant.

Nice work Awkward, definitely helps rather than having loads of seperate Senders.

If SetTimeout() doesnt crash SCAR anymore, it could help with this aswell.
Nice job.

Nice work, but it can be much more powerful much more easily using a very nice friend we call "ThreadSafeCall", which allows us to call any user defined procedure :)

procedure Meow;
begin
  Writeln('Meow');
end;

procedure TermScript;
begin
  TerminateScript;
end;

procedure ScriptTerminate;
begin
  Writeln('TERMINATED');
end;

var
  a: string;
  v: TVariantArray;
begin
  Writeln('Woof');
  SendInterSCARBoolean('action', false);
  repeat
    if(ReadInterSCARBoolean('action')) then
    begin
      SendInterSCARBoolean('action', false);
      a := ReadInterSCARMessage('mess');
      if (a = '') then
        Continue;
      v := [];
      try
        ThreadSafeCall(a, v);
      except
        try
          Writeln('Failed to execute action: ' + a);
        except
          TerminateScript;
        end;
      end;
    end;
    Wait(500);
    Writeln('loopy');
  until false;
  Writeln('End');
end.

Then, using another client:

program New;
begin
  Writeln('Begin');
  SendInterSCARMessage('mess', 'Meow');
  SendInterSCARBoolean('action', True);
  while (ReadInterSCARBoolean('action') = False) do
    Wait(250);
  Wait(250);
  SendInterSCARMessage('mess', 'TermScript');
  SendInterSCARBoolean('action', True);
  Writeln('End');
end.

and voila. With a bit of extra scripting, you could make it able to execute procedures that take variables etc. but it wouldn't be hard to do. Oh, and if you're wondering about TermScript, ThreadSafeCall can only execute user defined procedures as far as I know as trying to access Scar ones were giving me problems.

From: noidea
If SetTimeout() doesnt crash SCAR anymore, it could help with this aswell.
Nice job.

SetTimeout crashes SCAR? No one reported that…

hmm, settimeout and threadsafecall are some things that i need to look into :P if anyone wants to "teach" me pm :)

From: Freddy1990
SetTimeout crashes SCAR? No one reported that…

It doesn't for me, it did in 3.15b though…

lol freddy fixed a bug without even knowing it :p

~shut

I havent tried it in 3.2. So I wouldn't know about if still is crashing. (Thats why I asked)

noidea, yeah it still does have problems & I reported about em to Freddy earlier today.. :/

Run this, and see how many times you can get before SCAR faces "the death" (in SCAR v3.20+, in SCAR v3.15 replace 1000 with 1 for SetTimeout):

var
  i: Integer;

procedure Test;
begin
  Inc(i);
  ClearDebug;
  WriteLn('This test has ran... ' + IntToStr(i) + ' times!');
  SetTimeout(1000, 'Test');
end;

begin
  Test;
  while (not(IsFKeyDown(12))) do
    Wait(25);
end.

Maybe better system will be place into v4 of SCAR? :p

From: Janilabo
noidea, yeah it still does have problems & I reported about em to Freddy earlier today.. :/

Run this, and see how many times you can get before SCAR faces "the death" (in SCAR v3.20+, in SCAR v3.15 replace 1000 with 1 for SetTimeout):

var
  i: Integer;

procedure Test;
begin
  Inc(i);
  ClearDebug;
  WriteLn('This test has ran... ' + IntToStr(i) + ' times!');
  SetTimeout(1000, 'Test');
end;

begin
  Test;
  while (not(IsFKeyDown(12))) do
    Wait(25);
end.

Maybe better system will be place into v4 of SCAR? :p

It ran 1437 times, then SCAR stopped responding.

well, what does SetTimeout(1000, 'Test'); actually do?

also, how would i be able to use it in the remote control

Calls procedure supplied as second argument after x amount of time supplied by first argument - seconds or ms depending on Scar version. ThreadSafeCall, primarily, calls the procedure supplied as first argument and a TVariantArray, though I don't know what it's for. It does other stuff, but that's the main bit to know for this.

From: mixster
and a TVariantArray, though I don't know what it's for.

It's the arguments:

program New;
var
  V: TVariantArray;

procedure writeline(S: String; I: Integer);
begin
  writeln(S);
  writeln(I);
end;

begin
  V:= ['lulz', 42];
  ThreadSafeCall('writeline', V);
end.

So can't that be incorporated into the SRL user defined procedures thing..?

Also, this can be used with functions too:

program New;
var
  V: TVariantArray;

function Test(s : string) : string;
begin
  result := s;
end;

begin
  V:= ['Hello'];
  Writeln(ThreadSafeCall('Test', V));
end.

so, using threadsafecall, this is what the new procedures look like( thanks to Da 0wner :D).

sender script:

program New;

var
  // InitForm variables.
  EndInitForm : Boolean;
  frmDesign : TForm;
  Label1 : TLabel;
  CheckBox1, CheckBox2, CheckBox3, CheckBox4,
  CheckBox5 : TCheckBox;
  Button1 : TButton;

procedure InitFormOnClose(Sender : TObject; var Action : TCloseAction);
begin
  if (not(frmDesign.ModalResult = 1)) then
    EndInitForm := True;
end;

procedure StartClick(sender: TObject);
begin
   frmDesign.ModalResult:= mrOk; // Closes the form
   if CheckBox1.Checked then
   begin
     SendInterSCARMessage('id', 'TS');
   end;
   if CheckBox2.Checked then
   begin
     SendInterSCARMessage('id', 'Progressreport');
   end;
   if CheckBox3.Checked then
   begin
     SendInterSCARMessage('id', 'NextPlayerP');
   end;
   if CheckBox4.Checked then
   begin
     SendInterSCARMessage('id', 'LogOutPlayer');
   end;
   if CheckBox5.Checked then
   begin
     SendInterSCARMessage('id', 'LogIn');
   end;
end;

procedure InitForm;
var
  TimeInitForm : Integer;
begin
  TimeInitForm := GetSystemTime;
  frmDesign := CreateForm;
  with frmDesign do
  begin
    OnClose := @InitFormOnClose;
    Position := poScreenCenter;
    BorderStyle := bsSingle;
    BorderIcons := [biMinimize,biSystemMenu];
    ClientWidth := 183;
    ClientHeight := 213;
    Caption := 'Remote Control';
    Color := clBtnFace;
    Font.Color := clWindowText;
    Font.Height := -16;
    Font.Name := 'MS Sans Serif';
    Font.Style := [];
    PixelsPerInch := 96;
  end;
  Label1 := TLabel.Create(frmDesign);
  with Label1 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 8;
    Width := 127;
    Height := 20;
    Caption := 'Remote Control';
    Font.Color := clGreen;
    Font.Height := -16;
    Font.Name := 'MS Sans Serif';
    Font.Style := [fsBold, fsUnderline];
  end;
  CheckBox1 := TCheckBox.Create(frmDesign);
  with CheckBox1 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 40;
    Width := 137;
    Height := 17;
    Caption := 'Terminate Script';
    TabOrder := 8;
  end;
  CheckBox2 := TCheckBox.Create(frmDesign);
  with CheckBox2 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 64;
    Width := 145;
    Height := 25;
    Caption := 'Progress Report';
    TabOrder := 9;
  end;
  CheckBox3 := TCheckBox.Create(frmDesign);
  with CheckBox3 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 96;
    Width := 105;
    Height := 17;
    Caption := 'Next Player';
    TabOrder := 10;
  end;
  CheckBox4 := TCheckBox.Create(frmDesign);
  with CheckBox4 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 120;
    Width := 97;
    Height := 25;
    Caption := 'Log Out';
    TabOrder := 11;
  end;
  CheckBox5 := TCheckBox.Create(frmDesign);
  with CheckBox5 do
  begin
    Parent := frmDesign;
    Left := 24;
    Top := 144;
    Width := 97;
    Height := 25;
    Caption := 'Log In';
    TabOrder := 12;
  end;
  Button1 := TButton.Create(frmDesign);
  with Button1 do
  begin
    Parent := frmDesign;
    Left := 40;
    Top := 176;
    Width := 75;
    Height := 25;
    Caption := 'Go';
    TabOrder := 13;
    Button1.OnClick := @StartClick;
  end;
  WriteLn('InitForm compiled in ' + IntToStr(GetSystemTime - TimeInitForm) + ' milliseconds!');
end;

procedure SafeInitForm;
var
  v : TVariantArray;
begin
  SetArrayLength(v, 0);
  ThreadSafeCall('InitForm', v);
end;

procedure ShowInitFormModal;
begin
  frmDesign.ShowModal;
end;

procedure SafeShowInitFormModal;
var
  v : TVariantArray;
begin
  SetArrayLength(v, 0);
  ThreadSafeCall('ShowInitFormModal', v);
end;

procedure MainInitForm;
begin
  try
    SafeInitForm;
    SafeShowInitFormModal;
  finally
    FreeForm(frmDesign);
  except
    WriteLn('An error seems to have occurred in: InitForm');
  end;
end;

begin
  ClearDebug;
  GetSelf.WindowState := wsMinimized;
  MainInitForm;
  GetSelf.WindowState := wsNormal;
  if (EndInitForm) then
    TerminateScript;
end.

reciever script:

program New;
{.include SRL/SRL.scar}

procedure TS;
begin
  writeln('Test procedure');
end;

procedure Progressreport;
begin
  writeln('Test procedure 1');
end;

procedure NextPlayerP;
begin
  writeln('Test procedure 2');
end;

procedure LogOutPlayer;
begin
  writeln('Test procedure 3');
end;

procedure LogIn;
begin
  writeln('Test procedure 4');
end;

procedure RemoteControl;
var s: string; V: TVariantArray;
begin
  s:= readinterscarmessage('id');
  ThreadSafeCall(S, V);
  writeln('Remote Control: ' + s);
  sendinterscarmessage('id', '');
end;

begin
  RemoteControl;
end.

post teh feed back nao

You should add failsafes :).

meh, :P i'll do it later

var
  i: Integer;

procedure Test;
begin
  Inc(i);
  ClearDebug;
  ClearTimeout('Test');
  WriteLn('This test has ran... ' + IntToStr(i) + ' times!');
  SetTimeout(1, 'Test');
end;

begin
  Test;
  while (not(IsFKeyDown(12))) do
    Wait(25);
end.

2k and running.

~Sandstorm

Set the Wait(25) to Wait(1) and try again :p

I did, it only gets to two or three ^.^.

~Sandstorm

With 25 it is still going at and 3k.

With 1 it gets to 3.