000100 ID DIVISION. 00010000 000200 PROGRAM-ID. TRPGM74. 00020000 000300*AUTHOR. Kenneth W. Caldwell. 00030000 000400*INSTALLATION. Train-Right. 00040000 000500*DATE-WRITTEN. December 26, 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 Map based 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 user-choice REDEFINES ws-low-value 00190000 002000 PIC X. 00200000 002100 00210000 002200 COPY TRMAP74. 00220000 002300 00230000 002400 LINKAGE SECTION. 00240000 002500 01 dfhcommarea. 00250000 002600 05 wins PIC S9(4) BINARY. 00260000 002700 05 losses PIC S9(4) BINARY. 00270000 002800 00280000 002900 PROCEDURE DIVISION. 00290000 003000 Main. 00300000 003100 COMPUTE pgm-choice ROUNDED = 00310000 003200 FUNCTION RANDOM(eibtaskn + eibtime) * 2 00320000 003300 END-COMPUTE. 00330000 003400 00340000 003500 Check-First-Time. 00350000 003600 IF eibcalen = ZERO 00360000 003700 THEN EXEC CICS GETMAIN SET(ADDRESS OF dfhcommarea) 00370000 003800 FLENGTH(LENGTH OF dfhcommarea) 00380000 003900 INITIMG(ws-low-value) 00390000 004000 END-EXEC 00400000 004100 00410000 004200 GO TO Process-Clear 00420000 004300 END-IF. 00430000 004400 00440000 004500 IF eibtrnid NOT = 'TR74' 00450000 004600 THEN GO TO Process-Clear 00460000 004700 END-IF. 00470000 004800 00480000 004900 Receive-Map-Input. 00490000 005000 EXEC CICS IGNORE CONDITION MAPFAIL END-EXEC. 00500000 005100 EXEC CICS HANDLE AID ENTER(Process-Aid) 00510000 005200 PF3(Process-Exit) 00520000 005300 CLEAR(Process-Clear) 00530000 005400 END-EXEC. 00540000 005500 EXEC CICS RECEIVE MAP('TRMAP74') 00550000 005600 MAPSET('TRMAP74') 00560000 005700 END-EXEC. 00570000 005800 00580000 005900 MOVE LOW-VALUES TO trmap74o. 00590000 006000 MOVE 'Invalid key pressed. Please try again.' TO msgo. 00600000 006100 00610000 006200 GO TO Send-Data-Map. 00620000 006300 00630000 006400 Process-Aid. 00640000 006500 MOVE choicei TO user-choice. 00650000 006600 00660000 006700 MOVE LOW-VALUES TO trmap74o. 00670000 006800 00680000 006900 EVALUATE user-choice ALSO pgm-choice 00690000 007000 WHEN 'R' ALSO 0 00700000 007100 MOVE 'Two Rocks is a tie.' TO msgo 00710000 007200 WHEN 'P' ALSO 1 00720000 007300 MOVE 'Two Papers is a tie.' TO msgo 00730000 007400 WHEN 'S' ALSO 2 00740000 007500 MOVE 'Two Scissors is a tie.' TO msgo 00750000 007600 WHEN 'R' ALSO 1 00760000 007700 MOVE 'Paper covers Rock - I win!' TO msgo 00770000 007800 ADD +1 TO losses 00780000 007900 WHEN 'R' ALSO 2 00790000 008000 MOVE 'Rock smashes Scissors - You win!' TO msgo 00800000 008100 ADD +1 TO wins 00810000 008200 WHEN 'P' ALSO 0 00820000 008300 MOVE 'Paper covers Rock - You win!' TO msgo 00830000 008400 ADD +1 TO wins 00840000 008500 WHEN 'P' ALSO 2 00850000 008600 MOVE 'Scissors cut Paper - I win!' TO msgo 00860000 008700 ADD +1 TO losses 00870000 008800 WHEN 'S' ALSO 0 00880000 008900 MOVE 'Rock smashes Scissors - I win!' TO msgo 00890000 009000 ADD +1 TO losses 00900000 009100 WHEN 'S' ALSO 1 00910000 009200 MOVE 'Scissors cut Paper - You win!' TO msgo 00920000 009300 ADD +1 TO wins 00930000 009400 WHEN OTHER 00940000 009500 MOVE 'You did not select "Rock", "Paper", or "Scissors". Pl00950000 009600- 'ease try again.' TO msgo 00960000 009700 END-EVALUATE. 00970000 009800 00980000 009900 MOVE wins TO winso. 00990000 010000 MOVE losses TO losseso. 01000000 010100 01010000 010200 Send-Data-Map. 01020000 010300 MOVE eibtaskn TO taskno. 01030000 010400* Set MDT to retransmit choice. 01040000 010500 MOVE 'A' TO choicea. 01050000 010510 01051001 010520* 3270 Web Bridge - termid begins with right curly brace. 01052001 010530* change turquoise to neutral (black). 01053001 010540 IF eibtrmid(1:1) = X'D0' 01054001 010550 THEN MOVE X'F7' TO choicec 01055001 010560 END-IF. 01056001 010600 01060000 010700 EXEC CICS SEND MAP('TRMAP74') 01070000 010800 MAPSET('TRMAP74') 01080000 010900 DATAONLY 01090000 011000 END-EXEC. 01100000 011100 01110000 011200 EXEC CICS RETURN TRANSID(eibtrnid) 01120000 011300 COMMAREA(dfhcommarea) 01130000 011400 END-EXEC. 01140000 011500 01150000 011600 Process-Exit. 01160000 011700 MOVE 'End of Application.' TO msgo. 01170000 011800 01180000 011900 EXEC CICS SEND FROM(msgo) LENGTH(19) ERASE END-EXEC. 01190000 012000 EXEC CICS RETURN END-EXEC. 01200000 012100* Dummy GOBACK. 01210000 012200 GOBACK. 01220000 012300 01230000 012400 Process-Clear. 01240000 012500 MOVE ZERO TO wins, losses. 01250000 012600 01260000 012700 MOVE LOW-VALUES TO trmap74o. 01270000 012800 MOVE wins TO winso. 01280000 012900 MOVE losses TO losseso. 01290000 013000 MOVE eibtrmid TO termido. 01300000 013100 MOVE eibtaskn TO taskno. 01310000 013200 MOVE 'Scores cleared. Please play again.' TO msgo. 01320000 013300 01330000 013400* Set MDT to retransmit choice. 01340000 013500 MOVE 'A' TO choicea. 01350000 013510 01351001 013520* 3270 Web Bridge - termid begins with right curly brace. 01352001 013530* change turquoise to neutral (black). 01353001 013540 IF eibtrmid(1:1) = X'D0' 01354001 013550 THEN MOVE X'F7' TO choicec 01355001 013560 END-IF. 01356001 013600 01360000 013700 EXEC CICS SEND MAP('TRMAP74') 01370000 013800 MAPSET('TRMAP74') 01380000 013900 ERASE 01390000 014000 END-EXEC. 01400000 014100 01410000 014200 EXEC CICS RETURN TRANSID(eibtrnid) 01420000 014300 COMMAREA(dfhcommarea) 01430000 014400 END-EXEC. 01440000