home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / TICTAC.@EM / TICTAC.CBL next >
Encoding:
Text File  |  1991-04-08  |  9.6 KB  |  240 lines
  1.       $set ans85 mf align(2)
  2.       ************************************************************
  3.       *                                                          *
  4.       *              (C) Micro Focus Ltd. 1989                   *
  5.       *                                                          *
  6.       *                     TICTAC.CBL                           *
  7.       *                                                          *
  8.       *    This program demonstrates how to use a CRT.           *
  9.       *                                                          *
  10.       ************************************************************
  11.        identification division.
  12.            program-id. tictac.
  13.        environment division.
  14.        configuration section.
  15.            source-computer. ibm-pc.
  16.            object-computer. ibm-pc.
  17.        special-names.
  18.            console is crt.
  19.        data division.
  20.        working-storage section.
  21.        01 tictac-00.
  22.         02 tictac-q.
  23.            03 game             pic x(10) value spaces.
  24.            03 filler-0         pic x(70) value spaces.
  25.            03 question         pic x(20) value spaces.
  26.         02 filler.
  27.            03 filler-1         pic x(414) value all spaces.
  28.            03 tictac-00-0735   pic x(17) value "7║      8║      9".
  29.            03 filler-2         pic x(64) value all spaces.
  30.            03 tictac-00-0836   pic x(09) value "║       ║".
  31.            03 filler-3         pic x(71) value all spaces.
  32.            03 tictac-00-0936   pic x(09) value "║       ║".
  33.            03 filler-4         pic x(64) value all spaces.
  34.            03 tictac-00-1029 pic x(23) value "═══════╬═══════╬═══════".
  35.            03 filler-5         pic x(63) value all spaces.
  36.            03 tictac-00-1135   pic x(17) value "4║      5║      6".
  37.            03 filler-6         pic x(64) value all spaces.
  38.            03 tictac-00-1236   pic x(09) value "║       ║".
  39.            03 filler-7         pic x(71) value all spaces.
  40.            03 tictac-00-1336   pic x(09) value "║       ║".
  41.            03 filler-8         pic x(64) value all spaces.
  42.            03 tictac-00-1429 pic x(23) value "═══════╬═══════╬═══════".
  43.            03 filler-9         pic x(63) value all spaces.
  44.            03 tictac-00-1535   pic x(17) value "1║      2║      3".
  45.            03 filler-10        pic x(64) value all spaces.
  46.            03 tictac-00-1636   pic x(09) value "║       ║".
  47.            03 filler-11        pic x(71) value all spaces.
  48.            03 tictac-00-1736   pic x(09) value "║       ║".
  49.            03 filler-12        pic x(595) value all spaces.
  50.        01 entry-array.
  51.            03 entry-char       pic x               occurs 9 times.
  52.        01 check-array.
  53.            03 check            pic s99     comp  occurs 9 times.
  54.        01 xcount               pic 9(2)    comp.
  55.        01 ocount               pic 9(2)    comp.
  56.        01 factor               pic s9(2)   comp.
  57.        01 char                 pic x.
  58.        01 char9 redefines char pic 9.
  59.        01 idx                  pic 9(2)    comp.
  60.        01 result               pic 9(2)    comp.
  61.        01 cursor-pos.
  62.            03 row              pic 9(2)    comp  value 99.
  63.            03 filler           pic 9(2)    comp  value 99.
  64.        01 address-init.
  65.            03 filler           pic 9(4)    value   1732.
  66.            03 filler           pic 9(4)    value   1740.
  67.            03 filler           pic 9(4)    value   1748.
  68.            03 filler           pic 9(4)    value   1332.
  69.            03 filler           pic 9(4)    value   1340.
  70.            03 filler           pic 9(4)    value   1348.
  71.            03 filler           pic 9(4)    value   0932.
  72.            03 filler           pic 9(4)    value   0940.
  73.            03 filler           pic 9(4)    value   0948.
  74.        01 address-array        redefines   address-init.
  75.            03 addr             pic 9(4)    occurs 9 times.
  76.        01 location             pic 9(4).
  77.        01 game-lines value     "147123311113332436978979".
  78.            03 a                pic 9       occurs 8 times.
  79.            03 b                pic 9       occurs 8 times.
  80.            03 c                pic 9       occurs 8 times.
  81.        01 i                    pic 9(2)    comp.
  82.        01 j                    pic 9(2)    comp.
  83.        01 moves                pic 9(2)    comp.
  84.  
  85.        78 clear-screen        value x"e4".
  86.        78 sound-bell          value x"e5".
  87.  
  88.        procedure division.
  89.        play-game section.
  90.        play-1.
  91.            perform with test after
  92.                until char not = "Y" and char not = "y"
  93.                call clear-screen
  94.                display
  95.                    "To select a square type a number between 1 and 9"
  96.                    upon crt
  97.                perform init
  98.                move "Shall I start ? " to question
  99.                perform get-reply
  100.                if char = "Y" or char = "y"
  101.                    move 10 to check(5)
  102.                    perform put-move
  103.                end-if
  104.                perform new-move until game not = spaces
  105.                move "Play again ?    " to question
  106.                perform get-reply
  107.            end-perform.
  108.  
  109.        play-stop.
  110.            display space
  111.            stop run.
  112.  
  113.        get-reply section.
  114.            display tictac-q at 0201
  115.            accept char at 0317 with no-echo auto-skip
  116.            move spaces to question
  117.            display tictac-00 at 0201.
  118.  
  119.        init section.
  120.            move "y" to char
  121.            move spaces to entry-array
  122.            move low-values to check-array
  123.            move spaces to game
  124.            move zero to moves.
  125.  
  126.        new-move section.
  127.            perform get-move with test after until char9 not = 0
  128.            perform move-check
  129.            if game not = "stalemate"
  130.                move low-values to check-array
  131.                perform check-line varying i from 1 by 1
  132.                                until i > 8 or game not = spaces
  133.                if game not = "You win"
  134.                    perform put-move
  135.                end-if
  136.                if game = "I win" or game = "You win"
  137.                      perform varying idx from a(j) by b(j)
  138.                                                 until idx > c(j)
  139.                          move addr(idx) to location
  140.                          move entry-char(idx) to char
  141.                          display char at location with blink highlight
  142.                      end-perform
  143.                end-if
  144.            end-if.
  145.  
  146.        check-line section.
  147.            move zero to xcount,ocount,factor
  148.            perform count-up varying idx from a(i) by b(i)
  149.                                             until idx > c(i)
  150.            if ocount = 0 or xcount = 0
  151.                evaluate true
  152.                when ocount = 2
  153.                    if i = 4
  154.                        move 6 to j
  155.                        move zero to xcount,ocount
  156.                        perform count-up varying idx from a(j) by b(j)
  157.                                                 until idx > c(j)
  158.                        if xcount = 3
  159.                            move 6 to i
  160.                        end-if
  161.                    end-if
  162.                    if xcount not = 3
  163.                        move 50 to factor
  164.                        move "I win" to game
  165.                        move i to j
  166.                    end-if
  167.                when xcount = 2
  168.                    move 20 to factor
  169.                when ocount = 1
  170.                    move  4 to factor
  171.                when xcount = 1
  172.                    if entry-char(5) = "x"
  173.                        move  1 to factor
  174.                    else
  175.                        move -1 to factor
  176.                    end-if
  177.                when ocount = 0
  178.                    if xcount = 0
  179.                        move  2 to factor
  180.                    end-if
  181.                end-evaluate
  182.            end-if
  183.            if xcount = 3
  184.                move "You win" to game
  185.                move i to j
  186.            else
  187.                perform varying idx from a(i) by b(i) until idx > c(i)
  188.                    if entry-char(idx) = space
  189.                        add factor to check(idx)
  190.                    end-if
  191.                end-perform
  192.            end-if.
  193.  
  194.        count-up section.
  195.            if entry-char(idx) = "X"        add 1 to xcount
  196.            else if entry-char(idx) = "O"   add 1 to ocount.
  197.  
  198.        put-move section.
  199.            move zero to idx
  200.            move -99 to factor
  201.            perform find-pos varying i from 1 by 1 until i > 9
  202.            move "O" to entry-char(idx)
  203.            perform move-check.
  204.  
  205.        move-check section.
  206.            move addr(idx) to location
  207.            move entry-char(idx) to char
  208.            display char at location
  209.            add 1 to moves
  210.            if moves > 8 and game = spaces
  211.                move "stalemate" to game
  212.            end-if.
  213.  
  214.        find-pos section.
  215.            if entry-char(5) = space
  216.                move check(5) to factor
  217.                move 5 to idx
  218.            else
  219.                if check(i) not < factor and entry-char(i) = space
  220.                    move check(i) to factor
  221.                    move i to idx
  222.                end-if
  223.            end-if.
  224.  
  225.        get-move section.
  226.            display "Please select an empty square" at 0201
  227.            move 0 to char9
  228.            accept char9 at 0231 with auto-skip
  229.            if char9 = 0
  230.                call sound-bell
  231.            else
  232.                move char9 to idx
  233.                if entry-char(idx) = space
  234.                    move "X" to entry-char(idx)
  235.                else
  236.                    move 0 to char9
  237.                    call sound-bell
  238.                end-if
  239.            end-if.
  240.