OpenEuphoria

Translate from Pascal to Euphoria

• Posted by Paulo Fernandes <paulof1953 at gmail.com> Jun 01, 2007
• 833 views

Hi, ALL!

I would like somebody here translate MyProg below, from Pascal to
Euphoria, because I intend to mensure the performances of both.
Who would have the kindness to do for me? Thanks a lot!

Paulo Fernandes
P.Alegre/RS
Brazil


{----------------------------------------------------------------------*
* Prog.: MyProg.pas
* Data : 19/05/2007
* Obs. : Faz trabalho parcial de outro software
*----------------------------------------------------------------------}
Program  MyProg (p1, p2, p3);
Uses  Dos;
Const TAMBLOCO = 10000;
      NUMJOGOS = 14;
Var   totCPs   : longint;
      limTol   : longint;
      aCPs     : array [1..TAMBLOCO]      of string[NUMJOGOS];
      mMgs     : array [1..TAMBLOCO,1..4] of byte;
{----------------------------------------------------------------------}
procedure MostHora;
var   s1, s2   : string;
      f9       : text;
begin
   s1:='C:\Windows\System32\Cmd.exe ';
   s2:='/C Time < C:\Enter. > Wrk09.txt';
   exec(s1,s2);
   assign(f9,'Wrk09.txt');
   reset (f9);
   readln(f9,s1);
   close (f9);
   s2:=copy(s1,13,20);
   write(s2);
end;
{----------------------------------------------------------------------}
procedure PegaCPs;
var   comb  : string[NUMJOGOS];
      i, j  : longint;
      f1    : text;
begin
   MostHora;
   writeln('--Pegando CPs...');
   assign (f1,'KillCPs.txt');
   reset  (f1);
   totCPs:=1;
   while not(eof(f1)) do begin
      read(f1,comb);
      aCPs[totCPs]:=comb;
      for i:=1 to 4 do begin           {lê limites}
         read(f1,mMgs[totCPs,i]);
      end;
      read(f1,limTol);
      readln(f1);
      totCPs:=totCPs+1;
   end;
   totCPs:=totCPs-1;
   for i:=1 to totCPs do begin
      write(aCPs[i]:NUMJOGOS);
      for j:=1 to 4 do begin
         write(mMgs[i,j]:3);
      end;
      write(limTol:3);
      writeln('');
   end;
   close(f1);
end;
{----------------------------------------------------------------------}
procedure Expurga (arqEnt, arqSai, arqRes: string);
var   comb        : string[NUMJOGOS];
      f1, f2, f3  : text;
      iReg, oks   : longint;
      i, j, nTol  : longint;
      nPts        : byte;
      perc        : real;
      eBoa        : boolean;
begin
   MostHora;
   writeln('--Fazendo Expurgo...');
   assign (f1,arqEnt);
   reset  (f1);
   assign (f2,arqSai);
   rewrite(f2);
   iReg:=0; oks:=0;
   while not(eof(f1)) do begin
      readln(f1,comb);
      iReg:=iReg+1;
      eBoa:=true;
      nTol:=0;
      for i:=1 to totCPs do begin
         nPts:=0;
         for j:=1 to NUMJOGOS do begin
            if comb[j]=aCPs[i,j] then begin
               nPts:=nPts+1;
            end;
         end;
         if (nPts < mMgs[i,1]) or (nPts > mMgs[i,2]) then begin
            nTol:=nTol+1;
            if nTol > limTol then begin
               eBoa:=false;
               break;
            end;
         end;
      end;
      if eBoa=true then begin
         oks:=oks+1;
         writeln(f2,comb);
      end;
   end;
   perc:=(oks*1.00)/iReg*100.00;
   writeln(iReg:10, oks:10, perc:09:2,'%');
   { salva dados em arquivo }
   assign (f3,arqRes);
   append (f3);
   writeln(f3, iReg:7, ' ', oks, ' ', perc:5:2, '%');
   close(f1);
   close(f2);
   close(f3);
end;
Begin
   if ParamCount <> 3 then begin
      write(#7, #7);
      writeln('>> Necessário informar *arqEnt*, *arqSai*, *arqRes* ');
      readln;
      halt(1);
   end;
   PegaCPs;
   Expurga(ParamStr(1),ParamStr(2),ParamStr(3));
   MostHora;
   writeln('--Fim de Programa======');
End.