Case Structures
In-line case operations.
RPG II did not have true case structures, but did include branching logic in the form of the GOTO op code. THe first case structures to be introduced, naturally enough, resembled the branching operations of early RPG. The CASE Op code in this case was 'compare and execute subroutine', similar in nature to the early 360/DOS assembler instruction 'BALR' (branch and link register).
CASxx Fixed Format Only
*----------------------------------------------------------------
* Determine if an ENTER key, or ROLL key was detected. If not
* perform an edit of the command function key to get requested
* program function. (For example; EXIT, RESET, etc.)
*----------------------------------------------------------------
C EXSR @EDTKY
<--- C #KEY CASEQ ENTER @ENTER
<--- C #KEY CASEQ ROLLUP @LOAD
<--- C #KEY CASEQ ROLLDN @DOWN
<--- C SUBOP CASEQ 'CALL' @CALLS
<--- C FUNCT CASEQ 'EXIT' @EXIT
<--- C FUNCT CASEQ 'RESET' @RESET
<--- C FUNCT CASEQ 'MORE' @MORE
<--- C FUNCT CASEQ 'MOREOPT' @MOREO
---> C ENDCS
The COMPARE an EXECUTE SUBROUTINE operation is only supported as a fixed-column operation. In-line CASE structures were introduced with the SELECT operation. This structure is common in free-format code and more nearly resembles the case structure in other languages.
SELECT;
WHEN KeyPressed = functionKey.ENTER;
processChanges();
READ SC032001;
If ScreenChange ;
resetDisplay() ;
ENDIF;
WHEN KeyPressed = functionKey.ROLLUP;
loadSubfile();
WHEN KeyPressed = functionKey.ROLLDN;
pageDown();
WHEN KeyPressed = functionKey.F23;
DisplayOptions(option: z$opt1: z$opt2: O);
WHEN KeyPressed = functionKey.F24;
DisplayKeys(cmdkey: z$key1: z$key2: M);
WHEN Function = 'EXIT';
QUIT();
WHEN Function = 'CANCEL';
EXSR returnToCaller;
WHEN Function = 'RESET';
resetDisplay();
WHEN Function = 'HELP';
HelpText(ThisPgm:fmt);
WHEN SUBOP = 'CALL';
callProgram();
WHEN Function = 'CMDLINE';
CommandLine();
ENDSL;
.
.
.
SELECT;
WHEN rtnfld = 'ZFSTS';
zfsts = %trim(PromptDta);
WHEN rtnfld = 'ZFSEQ';
promptDta = %xlate(' ':'0':promptDta);
zfseq = %dec(%subst(PromptDta:1:7):7:0);
WHEN rtnfld = 'ZFCAT';
promptDta = %xlate(' ':'0':promptDta);
zfcat = %dec(%subst(PromptDta:1:3):3:0);
WHEN rtnfld = 'ZFOBJ';
zfobj = %trim(PromptDta);
WHEN rtnfld = 'ZFTYP';
zftyp = %trim(PromptDta);
WHEN rtnfld = 'ZFDSC';
zfdsc = %trim(PromptDta);
OTHER;
PromptDta = *blanks;
ENDSL;