Software Wartung und Evolution | Portierung eines Altsystems von PL/I nach Java

PROGRAMXYZ.pli

*process names ('äöüß', 'ÄÖÜ$');
 PROGRAMXYZ:
 procedure options (main reorder);

 define ordinal COLOR
    (INVALID, OPTION1, OPTION2, OPTION3, OPTION4, OPTION5, OPTION6);

 dcl ANSWER          char (72) var;
 dcl Code             dim (4) type COLOR;
 dcl HITS fixed bin;
 dcl TIP             dim (4) type COLOR;
 dcl HITS_OTHER_POSITION   fixed bin;

 Code = RANDOM();
 display ('YOUR OPTIONS: '
          || ' OPTION1, OPTION2, OPTION3, OPTION4, OPTION5, OPTION6');
 do loop;
    display ('TIP?') reply (ANSWER);
    if ANSWER = '' then return;
    call TRANSLATION (ANSWER, TIP);
    if any(TIP = INVALID) then
       display ('INVALID COLOR!');
    if all(TIP = Code) then leave;
    call EVALUATION (Code, TIP,
                   HITS, HITS_OTHER_POSITION);
    display ('HITS: '
             || trim(HITS) ||
             ', ' || 'HITS_OTHER_POSITION: '
             || trim(HITS_OTHER_POSITION));
    end;

 display ('ALL RIGHT! PRESS ENTER')
    reply (ANSWER);

 RANDOM:
 procedure returns (type COLOR);

 dcl Zahl     float init (0)               static;
 dcl COLORCODE dim (0:5) type COLOR nonasgn static
              init (OPTION1, OPTION2, OPTION3, OPTION4, OPTION5, OPTION6);

 if Zahl = 0
    then Zahl = random(time());
    else Zahl = random();
 return (COLORCODE(trunc(Zahl*6)));

 end RANDOM;

 TRANSLATION:
 procedure (ANSWER, TIP);

 dcl ANSWER char (*) var       parm nonasgn;
 dcl TIP    dim (4) type COLOR parm    asgn;

 dcl Blankpos  fixed bin;
 dcl F         type COLOR;
 dcl I         fixed bin;
 dcl Letterpos fixed bin;
 dcl S         char (length(ANSWER)) var;

 TIP = INVALID;

 if length(ANSWER) = 0 then return;

 S = translate(ANSWER,'ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ',
                       'abcdefghijklmnopqrstuvwxyzäöü');
 Blankpos = 1;
 do I = 1 to 4;
    Letterpos = verify(S, ' ', Blankpos);
    if Letterpos = 0 then leave;
    Blankpos = search(S, ' ', Letterpos);
    if Blankpos = 0 then Blankpos = length(S)+1;
    do F = OPTION1 upthru OPTION6;
       if substr(S, Letterpos, Blankpos-Letterpos)
          = ordinalname(F) then TIP(I) = F;
       end;
    end;

 end TRANSLATION;

 EVALUATION: 
 procedure (Code, Tip,
            HITS, HITS_OTHER_POSITION);

 dcl Code             dim (4) type COLOR parm nonasgn;
 dcl Tip              dim (4) type COLOR parm nonasgn;
 dcl HITS fixed bin          parm    asgn;
 dcl HITS_OTHER_POSITION   fixed bin          parm    asgn;
 dcl F                 type COLOR auto;
 dcl HITS_OVERALL fixed bin  auto;

 HITS = sum(Tip = Code);
 HITS_OVERALL = 0;
 do F = OPTION1 upthru OPTION6;
    HITS_OVERALL +=
                       min(sum(Tip = F), sum(Code = F));
    end;
 HITS_OTHER_POSITION = HITS_OVERALL - HITS;

 end EVALUATION;

 end PROGRAMXYZ;