$set ans85 mf align(2) ************************************************************ * * * (C) Micro Focus Ltd. 1989 * * * * TICTAC.CBL * * * * This program demonstrates how to use a CRT. * * * ************************************************************ identification division. program-id. tictac. environment division. configuration section. source-computer. ibm-pc. object-computer. ibm-pc. special-names. console is crt. data division. working-storage section. 01 tictac-00. 02 tictac-q. 03 game pic x(10) value spaces. 03 filler-0 pic x(70) value spaces. 03 question pic x(20) value spaces. 02 filler. 03 filler-1 pic x(414) value all spaces. 03 tictac-00-0735 pic x(17) value "7บ 8บ 9". 03 filler-2 pic x(64) value all spaces. 03 tictac-00-0836 pic x(09) value "บ บ". 03 filler-3 pic x(71) value all spaces. 03 tictac-00-0936 pic x(09) value "บ บ". 03 filler-4 pic x(64) value all spaces. 03 tictac-00-1029 pic x(23) value "อออออออฮอออออออฮอออออออ". 03 filler-5 pic x(63) value all spaces. 03 tictac-00-1135 pic x(17) value "4บ 5บ 6". 03 filler-6 pic x(64) value all spaces. 03 tictac-00-1236 pic x(09) value "บ บ". 03 filler-7 pic x(71) value all spaces. 03 tictac-00-1336 pic x(09) value "บ บ". 03 filler-8 pic x(64) value all spaces. 03 tictac-00-1429 pic x(23) value "อออออออฮอออออออฮอออออออ". 03 filler-9 pic x(63) value all spaces. 03 tictac-00-1535 pic x(17) value "1บ 2บ 3". 03 filler-10 pic x(64) value all spaces. 03 tictac-00-1636 pic x(09) value "บ บ". 03 filler-11 pic x(71) value all spaces. 03 tictac-00-1736 pic x(09) value "บ บ". 03 filler-12 pic x(595) value all spaces. 01 entry-array. 03 entry-char pic x occurs 9 times. 01 check-array. 03 check pic s99 comp occurs 9 times. 01 xcount pic 9(2) comp. 01 ocount pic 9(2) comp. 01 factor pic s9(2) comp. 01 char pic x. 01 char9 redefines char pic 9. 01 idx pic 9(2) comp. 01 result pic 9(2) comp. 01 cursor-pos. 03 row pic 9(2) comp value 99. 03 filler pic 9(2) comp value 99. 01 address-init. 03 filler pic 9(4) value 1732. 03 filler pic 9(4) value 1740. 03 filler pic 9(4) value 1748. 03 filler pic 9(4) value 1332. 03 filler pic 9(4) value 1340. 03 filler pic 9(4) value 1348. 03 filler pic 9(4) value 0932. 03 filler pic 9(4) value 0940. 03 filler pic 9(4) value 0948. 01 address-array redefines address-init. 03 addr pic 9(4) occurs 9 times. 01 location pic 9(4). 01 game-lines value "147123311113332436978979". 03 a pic 9 occurs 8 times. 03 b pic 9 occurs 8 times. 03 c pic 9 occurs 8 times. 01 i pic 9(2) comp. 01 j pic 9(2) comp. 01 moves pic 9(2) comp. 78 clear-screen value x"e4". 78 sound-bell value x"e5". procedure division. play-game section. play-1. perform with test after until char not = "Y" and char not = "y" call clear-screen display "To select a square type a number between 1 and 9" upon crt perform init move "Shall I start ? " to question perform get-reply if char = "Y" or char = "y" move 10 to check(5) perform put-move end-if perform new-move until game not = spaces move "Play again ? " to question perform get-reply end-perform. play-stop. display space stop run. get-reply section. display tictac-q at 0201 accept char at 0317 with no-echo auto-skip move spaces to question display tictac-00 at 0201. init section. move "y" to char move spaces to entry-array move low-values to check-array move spaces to game move zero to moves. new-move section. perform get-move with test after until char9 not = 0 perform move-check if game not = "stalemate" move low-values to check-array perform check-line varying i from 1 by 1 until i > 8 or game not = spaces if game not = "You win" perform put-move end-if if game = "I win" or game = "You win" perform varying idx from a(j) by b(j) until idx > c(j) move addr(idx) to location move entry-char(idx) to char display char at location with blink highlight end-perform end-if end-if. check-line section. move zero to xcount,ocount,factor perform count-up varying idx from a(i) by b(i) until idx > c(i) if ocount = 0 or xcount = 0 evaluate true when ocount = 2 if i = 4 move 6 to j move zero to xcount,ocount perform count-up varying idx from a(j) by b(j) until idx > c(j) if xcount = 3 move 6 to i end-if end-if if xcount not = 3 move 50 to factor move "I win" to game move i to j end-if when xcount = 2 move 20 to factor when ocount = 1 move 4 to factor when xcount = 1 if entry-char(5) = "x" move 1 to factor else move -1 to factor end-if when ocount = 0 if xcount = 0 move 2 to factor end-if end-evaluate end-if if xcount = 3 move "You win" to game move i to j else perform varying idx from a(i) by b(i) until idx > c(i) if entry-char(idx) = space add factor to check(idx) end-if end-perform end-if. count-up section. if entry-char(idx) = "X" add 1 to xcount else if entry-char(idx) = "O" add 1 to ocount. put-move section. move zero to idx move -99 to factor perform find-pos varying i from 1 by 1 until i > 9 move "O" to entry-char(idx) perform move-check. move-check section. move addr(idx) to location move entry-char(idx) to char display char at location add 1 to moves if moves > 8 and game = spaces move "stalemate" to game end-if. find-pos section. if entry-char(5) = space move check(5) to factor move 5 to idx else if check(i) not < factor and entry-char(i) = space move check(i) to factor move i to idx end-if end-if. get-move section. display "Please select an empty square" at 0201 move 0 to char9 accept char9 at 0231 with auto-skip if char9 = 0 call sound-bell else move char9 to idx if entry-char(idx) = space move "X" to entry-char(idx) else move 0 to char9 call sound-bell end-if end-if.