239 lines
9.5 KiB
Plaintext
239 lines
9.5 KiB
Plaintext
|
$set ans85 mf
|
|||
|
|
************************************************************
|
|||
|
|
* *
|
|||
|
|
* (C) Micro Focus Ltd. 1989 *
|
|||
|
|
* *
|
|||
|
|
* TICBUG.CBL *
|
|||
|
|
* *
|
|||
|
|
* This program demonstrates how to debug a program. *
|
|||
|
|
* *
|
|||
|
|
************************************************************
|
|||
|
|
identification division.
|
|||
|
|
program-id. ticbug.
|
|||
|
|
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 "<22> <20>".
|
|||
|
|
03 filler-3 pic x(71) value all spaces.
|
|||
|
|
03 tictac-00-0936 pic x(09) value "<22> <20>".
|
|||
|
|
03 filler-4 pic x(64) value all spaces.
|
|||
|
|
03 tictac-00-1029 pic x(23) value "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>".
|
|||
|
|
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 "<22> <20>".
|
|||
|
|
03 filler-7 pic x(71) value all spaces.
|
|||
|
|
03 tictac-00-1336 pic x(09) value "<22> <20>".
|
|||
|
|
03 filler-8 pic x(64) value all spaces.
|
|||
|
|
03 tictac-00-1429 pic x(23) value "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>".
|
|||
|
|
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 "<22> <20>".
|
|||
|
|
03 filler-11 pic x(71) value all spaces.
|
|||
|
|
03 tictac-00-1736 pic x(09) value "<22> <20>".
|
|||
|
|
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"
|
|||
|
|
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.
|
|||
|
|
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.
|