{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples  Version 1.10            █}
{█      OS/2 REXX example                                █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1995-96 fPrint UK Ltd              █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

program CallRexx;

uses Os2Base, Os2Rexx, Use32;

{$PMTYPE VIO}

{$IFDEF VPDEMO}
  {&Dynamic VP11Demo.Lib}
{$ENDIF}

const
  MaxRexxSrcBuffer      = 4096;

{ Executes a REXX procedure with one argument }

function DoCallRexx(const RexxSrc: array of PChar; const AArg: String): Longint;
var
  P:          PChar;
  I,J:        Integer;
  Arg:        RxString;
  RexxRetVal: RxString;
  RexxRC:     SmallWord;
  Instore:    array [0..1] of RxString;
  SrcBuf:     array [0..MaxRexxSrcBuffer-1] of Char;
begin
  { By setting the strlength of the output RXSTRING to zero, we   }
  { force the interpreter to allocate memory and return it to us. }
  { We could provide a buffer for the interpreter to use instead. }
  RexxRetVal.strlength := 0;
  { Create input argument }
  Arg.strlength := Length(AArg);
  Arg.strptr := @AArg[1];
  { Create REXX procedure source code in memory }
  J := 0;
  for I := Low(RexxSrc) to High(RexxSrc) do
  begin
    P := RexxSrc[I];
    while P^ <> #0 do
    begin
      SrcBuf[J] := P^;
      Inc(P);
      Inc(J);
    end;
    SrcBuf[J]   := #13;         { Carriage Return }
    SrcBuf[J+1] := #10;         { Line Feed       }
    Inc(J, 2);
  end;
  Instore[0].strlength := J;
  Instore[0].strptr := @SrcBuf;
  Instore[1].strlength := 0;
  Instore[1].strptr := nil;
  { Here we call the interpreter }
  DoCallRexx := RexxStart(1    ,        { Number of arguments        }
                  @Arg         ,        { Argument array             }
                  'VpcCallRexx',        { Name of the REXX procedure }
                  @InStore     ,        { Location of the procedure  }
                  'CMD'        ,        { Initial environment name   }
                  rxCommand    ,        { Code for how invoked       }
                  nil          ,        { No EXITs on this call      }
                  RexxRC       ,        { Rexx program output        }
                  RexxRetVal);          { Rexx program output        }
  { Release storage allocated by REXX }
  if Assigned(RexxRetVal.strptr) then DosFreeMem(RexxRetVal.strptr);
  DosFreeMem(Instore[1].strptr);
end;

{ REXX source to execute }

const
  PlayMusic: array[0..20] of PChar =
    ( 'Parse Arg Data'  ,               { Get argument string  }
      'Note.0  = 2000'  ,               { Invalid note entered }
      'Note.1  = 262'   ,               { c }
      'Note.2  = 294'   ,               { d }
      'Note.3  = 330'   ,               { e }
      'Note.4  = 349'   ,               { f }
      'Note.5  = 392'   ,               { g }
      'Note.6  = 440'   ,               { a }
      'Note.7  = 494'   ,               { b }
      'Note.8  = 524'   ,               { C }
      'Note.9  = 588'   ,               { D }
      'Note.10 = 660'   ,               { E }
      'Note.11 = 698'   ,               { F }
      'Note.12 = 784'   ,               { G }
      'Note.13 = 880'   ,               { A }
      'Note.14 = 988'   ,               { B }
      'NoteOrder = "cdefgabCDEFGAB"',
      'do i=1 to Length(Data)'      ,
      'j = Pos(SubStr(Data,i,1), NoteOrder)',
      'call Beep Note.j, 250'       ,   { Hold each note for one-quarter second }
      'end'
    );

  TypeFile: array [0..1] of PChar =
    ( 'Parse Arg Data',
      'TYPE Data'
    );

var
  RC: Longint;

{ Main program body }

begin
  WriteLn('Virtual Pascal CallRexx   Version 1.10 Copyright (C) 1995-96 fPrint UK Ltd');
  Writeln;
  Writeln( 'Play music through REXX:' );
  { Play music }
  RC := DoCallRexx(PlayMusic, 'cdefgabCDEFGAB');
  if RC <> 0 then
    WriteLn('Failed to play gamma. REXX Error Code = ', RC);

  { Type contents of the AUTOEXEC.BAT }
  Writeln;
  Writeln( 'Type content of Autoexec.bat through REXX:' );
  RC := DoCallRexx(TypeFile, 'C:\AUTOEXEC.BAT');
  if RC <> 0 then
    WriteLn('Failed to type AUTOEXEC.BAT. REXX Error Code = ', RC);
end.