Want more features on Pastebin? Sign Up, it's FREE!
Guest

/r/dailyprogrammer #133 COBOL alternate

By: Edward_H on Sep 13th, 2013  |  syntax: COBOL  |  size: 8.42 KB  |  views: 59  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. *> chain-reaction.cob
  2.        IDENTIFICATION DIVISION.
  3.        PROGRAM-ID. chain-reaction.
  4.  
  5.        DATA DIVISION.
  6.        WORKING-STORAGE SECTION.
  7.        01  input-str               PIC X(30).
  8.  
  9.        COPY "num-elements.cpy".
  10.  
  11.        COPY "elements-grid.cpy".
  12.  
  13.        COPY "first-elt-coords.cpy".
  14.  
  15.        COPY "change-flag.cpy".
  16.  
  17.        PROCEDURE DIVISION.
  18.            ACCEPT input-str
  19.            UNSTRING input-str DELIMITED BY SPACES
  20.                INTO num-elements, grid-size
  21.  
  22.            *> Read in the elements.
  23.            CALL "read-in-elements" USING elements-grid-area,
  24.                num-elements, first-elt-coords
  25.  
  26.            *> Display state before any elements have reacted.
  27.            CALL "display-state" USING elements-grid-area
  28.  
  29.            *> Start the chain reaction
  30.            SET reacting (first-elt-x, first-elt-y) TO TRUE
  31.  
  32.            *> Simulate and display the chain reaction.
  33.            PERFORM UNTIL no-change
  34.                CALL "display-state" USING elements-grid-area
  35.                CALL "step-reaction" USING elements-grid-area,
  36.                    change-flag
  37.            END-PERFORM
  38.  
  39.            GOBACK
  40.            .
  41.  
  42.        IDENTIFICATION DIVISION.
  43.        PROGRAM-ID. read-in-elements.
  44.  
  45.        DATA DIVISION.
  46.        WORKING-STORAGE SECTION.
  47.        01  i                       PIC 99.
  48.        01  j                       PIC 9.
  49.  
  50.        01  input-str               PIC X(30).
  51.  
  52.        01  x                       PIC 99.
  53.        01  y                       PIC 99.
  54.  
  55.        01  element-radius          PIC 99.
  56.        01  char-num                PIC 9(3).
  57.        01  prop-dirs               PIC X(4).
  58.  
  59.        LINKAGE SECTION.
  60.        COPY "elements-grid.cpy".
  61.  
  62.        COPY "num-elements.cpy".
  63.  
  64.        COPY "first-elt-coords.cpy".
  65.  
  66.        PROCEDURE DIVISION USING elements-grid-area, num-elements,
  67.                  first-elt-coords.
  68.            PERFORM VARYING i FROM 1 BY 1 UNTIL i > num-elements
  69.                ACCEPT input-str
  70.                UNSTRING input-str DELIMITED BY SPACES
  71.                    INTO x, y, element-radius, prop-dirs
  72.  
  73.                ADD 1 TO x, y
  74.                MOVE element-radius TO radius (x, y)
  75.  
  76.                COMPUTE char-num = FUNCTION ORD("A") + i - 1
  77.                MOVE FUNCTION CHAR(char-num)
  78.                    TO element-char (x, y)
  79.  
  80.                MOVE FUNCTION LOWER-CASE(prop-dirs) TO prop-dirs
  81.                PERFORM VARYING j FROM 1 BY 1
  82.                        UNTIL j > 4 OR prop-dirs (j:1) = SPACE
  83.                    EVALUATE prop-dirs (j:1)
  84.                        WHEN "u"
  85.                            SET prop-up (x, y) TO TRUE
  86.                        WHEN "d"
  87.                            SET prop-down (x, y) TO TRUE
  88.                        WHEN "l"
  89.                            SET prop-left (x, y) TO TRUE
  90.                        WHEN "r"
  91.                            SET prop-right (x, y) TO TRUE
  92.                    END-EVALUATE
  93.                END-PERFORM
  94.  
  95.                SET is-empty (x, y) TO FALSE
  96.  
  97.                IF i = 1
  98.                    MOVE x TO first-elt-x
  99.                    MOVE y TO first-elt-y
  100.                END-IF
  101.            END-PERFORM
  102.            .      
  103.        END PROGRAM read-in-elements.
  104.  
  105.  
  106.        IDENTIFICATION DIVISION.
  107.        PROGRAM-ID. display-state.
  108.  
  109.        DATA DIVISION.
  110.        WORKING-STORAGE SECTION.
  111.        01  step-counter            PIC 99.
  112.  
  113.        01  x                       PIC 99.
  114.        01  y                       PIC 99.
  115.  
  116.        LINKAGE SECTION.
  117.        COPY "elements-grid.cpy".
  118.  
  119.        PROCEDURE DIVISION USING elements-grid-area.
  120.            DISPLAY "Step " step-counter ":"
  121.            ADD 1 TO step-counter
  122.  
  123.            PERFORM VARYING y FROM 1 BY 1 UNTIL y > grid-size
  124.                PERFORM VARYING x FROM 1 BY 1 UNTIL x > grid-size
  125.                    IF reacting (x, y) OR reacted (x, y)
  126.                        DISPLAY "X" NO ADVANCING
  127.                    ELSE
  128.                        DISPLAY element-char (x, y) NO ADVANCING
  129.                    END-IF
  130.                END-PERFORM
  131.                DISPLAY SPACE
  132.            END-PERFORM
  133.            .
  134.        END PROGRAM display-state.
  135.  
  136.        
  137.        IDENTIFICATION DIVISION.
  138.        PROGRAM-ID. step-reaction.
  139.  
  140.        DATA DIVISION.
  141.        WORKING-STORAGE SECTION.
  142.        01  grid-x                  PIC 99.
  143.        01  grid-y                  PIC 99.
  144.  
  145.        01  prop-x                  PIC 99.
  146.        01  prop-y                  PIC 99.
  147.  
  148.        LINKAGE SECTION.
  149.        COPY "elements-grid.cpy".
  150.  
  151.        COPY "change-flag.cpy".
  152.  
  153.        PROCEDURE DIVISION USING elements-grid-area, change-flag.
  154.            SET no-change TO TRUE
  155.            
  156.            *> Find the next elements that will be reacted.
  157.            PERFORM VARYING grid-y FROM 1 BY 1
  158.                        UNTIL grid-y > grid-size
  159.                    AFTER grid-x FROM 1 BY 1 UNTIL grid-x > grid-size
  160.                IF reacting (grid-x, grid-y)
  161.                    IF prop-up (grid-x, grid-y)
  162.                        PERFORM propagate-up
  163.                    END-IF
  164.                    IF prop-down (grid-x, grid-y)
  165.                        PERFORM propagate-down
  166.                    END-IF
  167.                    IF prop-left (grid-x, grid-y)
  168.                        PERFORM propagate-left
  169.                    END-IF
  170.                    IF prop-right (grid-x, grid-y)
  171.                        PERFORM propagate-right
  172.                    END-IF
  173.                    SET reacted (grid-x, grid-y) TO TRUE
  174.                END-IF
  175.            END-PERFORM
  176.  
  177.            *> Update the reaction to its next state.
  178.            PERFORM VARYING grid-y FROM 1 BY 1
  179.                        UNTIL grid-y > grid-size
  180.                    AFTER grid-x FROM 1 BY 1 UNTIL grid-x > grid-size
  181.                IF will-react (grid-x, grid-y)
  182.                    SET reacting (grid-x, grid-y) TO TRUE
  183.                END-IF
  184.            END-PERFORM
  185.            
  186.            GOBACK
  187.            .
  188.        propagate-up.
  189.            MOVE grid-x TO prop-x
  190.            PERFORM react-element VARYING prop-y FROM grid-y BY 1
  191.                UNTIL prop-y > grid-size
  192.                OR prop-y - grid-y > radius (grid-x, grid-y)
  193.            .
  194.        propagate-down.
  195.            MOVE grid-x TO prop-x
  196.            PERFORM react-element VARYING prop-y FROM grid-y BY -1
  197.                UNTIL prop-y = 0
  198.                OR grid-y - prop-y > radius (grid-x, grid-y)
  199.            .
  200.        propagate-left.
  201.            MOVE grid-y TO prop-y
  202.            PERFORM react-element VARYING prop-x FROM grid-x BY -1
  203.                UNTIL prop-x = 0
  204.                OR grid-x - prop-x > radius (grid-x, grid-y)
  205.            .
  206.        propagate-right.
  207.            MOVE grid-y TO prop-y
  208.            PERFORM react-element VARYING prop-x FROM grid-x BY 1
  209.                UNTIL prop-x > grid-size
  210.                OR prop-x - grid-x > radius (grid-x, grid-y)
  211.            .
  212.        react-element.
  213.            IF NOT(is-empty (prop-x, prop-y) OR reacted (prop-x, prop-y)
  214.                    OR reacting (prop-x, prop-y))
  215.                SET will-react (prop-x, prop-y) TO TRUE
  216.                SET no-change TO FALSE
  217.            END-IF
  218.            .
  219.        END PROGRAM step-reaction.
  220.  
  221. *> change-flag.cpy
  222.        01  change-flag             PIC X.
  223.            88  no-change           VALUE "Y", FALSE "N".
  224.  
  225. *> elements-grid.cpy
  226.        01  elements-grid-area.
  227.            03  grid-size           PIC 99.
  228.            03  elements-x-grid     OCCURS 10 TIMES.
  229.                05  elements-y-grid OCCURS 10 TIMES.
  230.                    07  radius          PIC 99.
  231.                    07  element-char    PIC X VALUE SPACE.
  232.                    07  empty-flag      PIC X.
  233.                        88  is-empty    VALUE SPACE, FALSE "N".
  234.                    07  prop-up-flag    PIC X.
  235.                        88  prop-up     VALUE "Y".
  236.                    07  prop-down-flag  PIC X.
  237.                        88  prop-down   VALUE "Y".
  238.                    07  prop-left-flag  PIC X.
  239.                        88  prop-left   VALUE "Y".
  240.                    07  prop-right-flag PIC X.
  241.                        88  prop-right  VALUE "Y".
  242.                    07  reacting-flag   PIC X.
  243.                        88  reacting    VALUE "Y".
  244.                        88  reacted     VALUE "X".
  245.                        88  will-react  VALUE "W".
  246.  
  247. *> first-elt-coords.cpy
  248.        01  first-elt-coords.
  249.            03  first-elt-x         PIC 99.
  250.            03  first-elt-y         PIC 99.
  251.  
  252. *> num-elements.cpy
  253.        01  num-elements            PIC 99.
clone this paste RAW Paste Data