home *** CD-ROM | disk | FTP | other *** search
/ Sams Cobol 24 Hours / Sams_Cobol_24_Hours.iso / source / ch12 / CHAPT12X.COB < prev    next >
Encoding:
Text File  |  1998-09-15  |  3.9 KB  |  90 lines
  1. 000010 @OPTIONS MAIN,TEST
  2. 000020 Identification Division.
  3. 000030 Program-Id.  Chapt12x.
  4. 000040* This Is But One Solution, Yours May Differ.
  5. 000044 Environment Division.
  6. 000050 Configuration Section.
  7. 000051 Source-Computer.  IBM-PC.
  8. 000055 Object-Computer.  IBM-PC.
  9. 000056 Data Division.
  10. 000057 Working-Storage Section.
  11. 000058* Setup A Table With The Different Sack Colors.
  12. 000059 01  Sack-Table-Area.
  13. 000060     03  Sack-Colors.
  14. 000061         05  Filler Pic X(10) Value "Blue".
  15. 000062         05  Filler Pic X(10) Value "Red".
  16. 000063         05  Filler Pic X(10) Value "Yellow".
  17. 000064         05  Filler Pic X(10) Value "Green".
  18. 000065         05  Filler Pic X(10) Value "Purple".
  19. 000066         05  Filler Pic X(10) Value "Black".
  20. 000067         05  Filler Pic X(10) Value "White".
  21. 000068     03  The-Sacks Redefines Sack-Colors.
  22. 000069         05  Sack-Color-To-Use Pic X(10) Occurs 7 Times
  23. 000070             Indexed By Sack-Color-Index.
  24. 000071 01  The-Man-On-The-Road.
  25. 000072     03  Wife               Occurs 7 Times
  26. 000073         Indexed By Wife-Index.
  27. 000074         05  Wife-Name                   Pic X(20).
  28. 000075         05  Sack           Occurs 7 Times
  29. 000076             Indexed By Sack-Index.
  30. 000077             10  Sack-Color              Pic X(10).
  31. 000078             10  Cat        Occurs 7 Times
  32. 000079                 Indexed By Cat-Index.
  33. 000080                 15  Cat-Name            Pic X(20).
  34. 000081                 15  Kitten Occurs 7 Times
  35. 000082                     Indexed By Kitten-Index.
  36. 000083                     20  Kitten-Name     Pic X(20).
  37. 000084 01  Found-Flag  Pic X Value Spaces.
  38. 000085     88  Kitten-Found Value "Y".
  39. 000086 Procedure Division.
  40. 000207 Chapt12x-Start.
  41. 000208* Color The Different Wives Sacks.
  42. 000209*
  43. 000210* The Set Is Used To Properly Set The Correct Index For
  44. 000211* The Actual Sack.  In Our Example, The Sack Color Number Is Going
  45. 000212* Into That Sack Item, So They Are The Same.
  46. 000213*
  47. 000215     Perform Varying Wife-Index From 1 By 1 Until Wife-Index > 7
  48. 000216        Perform Varying Sack-Color-Index From 1 By 1
  49. 000217                        Until Sack-Color-Index > 7
  50. 000218                 Set Sack-Index To Sack-Color-Index
  51. 000220                 Move Sack-Color-To-Use (Sack-Color-Index) To
  52. 000221                     Sack-Color (Wife-Index, Sack-Index)
  53. 000222        End-Perform
  54. 000223     End-Perform
  55. 000224* Setup The Rest Of The Search So We Can Find Hershey
  56. 000225     Move "Hershey" To Kitten-Name (1, 3, 2, 6)
  57. 000226     Move "Darlene" To Wife-Name (1)
  58. 000227     Perform With Test After
  59. 000228                     Varying Wife-Index From 1 By 1 Until
  60. 000229                     Wife-Index = 7 Or
  61. 000230                     Kitten-Found
  62. 000231        Perform With Test After
  63. 000232                        Varying Sack-Index From 1 By 1 Until
  64. 000233                        Sack-Index = 7 Or
  65. 000234                        Kitten-Found
  66. 000235           Perform With Test After
  67. 000236                           Varying Cat-Index From 1 By 1 Until
  68. 000237                           Cat-Index = 7 Or
  69. 000238                           Kitten-Found
  70. 000239              Set Kitten-Index To 1
  71. 000240              Search Kitten
  72. 000241                When
  73. 000242                 Kitten-Name (Wife-Index, Sack-Index,
  74. 000243                              Cat-Index, Kitten-Index) =
  75. 000244                 "Hershey"
  76. 000245                 Set Kitten-Found To True
  77. 000246              End-Search
  78. 000247           End-Perform
  79. 000248        End-Perform
  80. 000249     End-Perform
  81. 000250     If Kitten-Found
  82. 000251        Display "Hershey found in the "
  83. 000252                Sack-Color (Wife-Index, Sack-Index)
  84. 000253                " Sack, Being carried by "
  85. 000254                Wife-Name (Wife-Index)
  86. 000255     Else
  87. 000256       Display "Hershey Escaped"
  88. 000257     End-If
  89. 000258     Stop Run
  90. 000259     .
  91.