Create a gist now

Instantly share code, notes, and snippets.

Software Wartung und Evolution | Portierung eines Altsystems von PL/I nach Java
*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;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment