000100 ID DIVISION. 00010000 000200 PROGRAM-ID. TRPGM73. 00020000 000300*AUTHOR. Kenneth W. Caldwell. 00030000 000400*INSTALLATION. Train-Right. 00040000 000500*DATE-WRITTEN. December 5, 2010. 00050000 000600*DATE-COMPILED. 00060000 000700* 00070000 000800*SECURITY. This program is for students of Train-Right 00080000 000900* courses ONLY!. 00090000 001000* 00100000 001100*REMARKS. This program plays Rock, Paper, Scissors. 00110000 001200* It is a Psuedo-Conversational program. 00120000 001300* 00130000 001400 DATA DIVISION. 00140000 001500 WORKING-STORAGE SECTION. 00150000 001600 01. 00160000 001700 05 pgm-choice PIC 9 PACKED-DECIMAL. 00170000 001800 05 ws-low-value PIC X VALUE LOW-VALUE. 00180000 001900 05 result. 00190000 002000 10. 00200000 002100 15 user-input-first. 00210000 002200 20 PIC X(5) VALUE SPACES. 00220000 002300 20 user-input PIC X(8) VALUE SPACES. 00230000 002400 15 user-choice REDEFINES user-input-first 00240000 002500 PIC X(13). 00250000 002600 15 PIC X(67) VALUE SPACES. 00260000 002700 10 msg1 PIC X(80). 00270000 002800 10 msg2 PIC X(80) VALUE 00280000 002900 'Change your choice and press ENTER to play again. Ent00290000 003000- 'er EXIT to stop playing.'. 00300000 003100 10 msg3. 00310000 003200 15 PIC X(6) VALUE 'Wins: '. 00320000 003300 15 msg3-wins PIC ZZ,ZZ9. 00330000 003400 15 PIC X(2) VALUE '. '. 00340000 003500 15 PIC X(8) VALUE 'Losses: '. 00350000 003600 15 msg3-losses PIC ZZ,ZZ9. 00360000 003700 15 PIC X(2) VALUE '. '. 00370000 003800 00380000 003900 LINKAGE SECTION. 00390000 004000 01 dfhcommarea. 00400000 004100 05 wins PIC S9(4) BINARY. 00410000 004200 05 losses PIC S9(4) BINARY. 00420000 004300 00430000 004400 PROCEDURE DIVISION. 00440000 004500 Main. 00450000 004600 COMPUTE pgm-choice ROUNDED = 00460000 004700 FUNCTION RANDOM(eibtaskn + eibtime) * 2 00470000 004800 END-COMPUTE. 00480000 004900 00490000 005000 Check-First-Time. 00500000 005100 EXEC CICS IGNORE CONDITION LENGERR END-EXEC. 00510000 005200 00520000 005300 IF eibcalen = ZERO 00530000 005400 THEN EXEC CICS GETMAIN SET(ADDRESS OF dfhcommarea) 00540000 005500 FLENGTH(LENGTH OF dfhcommarea) 00550000 005600 INITIMG(ws-low-value) 00560000 005700 END-EXEC 00570000 005800 EXEC CICS RECEIVE INTO(user-input-first) 00580000 005900 MAXFLENGTH(LENGTH OF user-input-first)00590000 006000 END-EXEC 00600000 006100 00610000 006200 MOVE user-input TO user-choice 00620000 006300 ELSE 00630000 006400 EXEC CICS RECEIVE INTO(user-choice) 00640000 006500 MAXFLENGTH(LENGTH OF user-choice) 00650000 006600 END-EXEC 00660000 006700 END-IF. 00670000 006800 00680000 006900 Process-Data. 00690000 007000 EVALUATE user-choice ALSO pgm-choice 00700000 007100 WHEN 'EXIT' ALSO ANY 00710000 007200 GO TO Process-Exit 00720000 007300 WHEN 'ROCK' ALSO 0 00730000 007400 MOVE 'Two Rocks is a tie.' TO msg1 00740000 007500 WHEN 'PAPER' ALSO 1 00750000 007600 MOVE 'Two Papers is a tie.' TO msg1 00760000 007700 WHEN 'SCISSORS' ALSO 2 00770000 007800 MOVE 'Two Scissors is a tie.' TO msg1 00780000 007900 WHEN 'ROCK' ALSO 1 00790000 008000 MOVE 'Paper covers Rock - I win!' TO msg1 00800000 008100 ADD +1 TO losses 00810000 008200 WHEN 'ROCK' ALSO 2 00820000 008300 MOVE 'Rock smashes Scissors - You win!' TO msg1 00830000 008400 ADD +1 TO wins 00840000 008500 WHEN 'PAPER' ALSO 0 00850000 008600 MOVE 'Paper covers Rock - You win!' TO msg1 00860000 008700 ADD +1 TO wins 00870000 008800 WHEN 'PAPER' ALSO 2 00880000 008900 MOVE 'Scissors cut Paper - I win!' TO msg1 00890000 009000 ADD +1 TO losses 00900000 009100 WHEN 'SCISSORS' ALSO 0 00910000 009200 MOVE 'Rock smashes Scissors - I win!' TO msg1 00920000 009300 ADD +1 TO losses 00930000 009400 WHEN 'SCISSORS' ALSO 1 00940000 009500 MOVE 'Scissors cut Paper - You win!' TO msg1 00950000 009600 ADD +1 TO wins 00960000 009700 WHEN OTHER 00970000 009800 MOVE 'You did not select "Rock", "Paper", or "Scissors". Pl00980000 009900- 'ease try again.' TO msg1 00990000 010000 END-EVALUATE. 01000000 010100 01010000 010200 MOVE wins TO msg3-wins. 01020000 010300 MOVE losses TO msg3-losses. 01030000 010400 01040000 010500 Send-Result-And-Restart. 01050000 010600 EXEC CICS SEND FROM(result) ERASE END-EXEC. 01060000 010700 EXEC CICS RETURN TRANSID(eibtrnid) 01070000 010800 COMMAREA(dfhcommarea) 01080000 010900 END-EXEC. 01090000 011000 01100000 011100 Process-Exit. 01110000 011200 EXEC CICS SEND CONTROL ERASE END-EXEC. 01120000 011300 EXEC CICS RETURN END-EXEC. 01130000 011400* Dummy GOBACK. 01140000 011500 GOBACK. 01150000