Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: Table-Prog.cob Sprache: Cobol

Original von: verschiedene^©

000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. TABLE-PROG.
000030 AUTHOR.     TIMOTHY R P BROWN.
000035
000037*****************************************************
000040* Program to update a football league table         *
000045* and output a new updated table                    *
000046* Based on English Premiership season 1999-2000     *
000047*****************************************************
000048
000050 ENVIRONMENT DIVISION.
000060 INPUT-OUTPUT SECTION.
000070 FILE-CONTROL.
000080     SELECT TEAM-REC-IN ASSIGN TO "INPUT.REC"
000090        ORGANIZATION IS SEQUENTIAL.
000100     SELECT WORK-FILE ASSIGN TO SORTWK01.
000105* for MicroFocus compiler
000107* replace SORTWK01 with 'WORKFILE.DAT'
000110     SELECT SORT-OUT ASSIGN TO "SORTED.REC"
000120        ORGANIZATION IS SEQUENTIAL.
000130     SELECT PRINT-FILE ASSIGN TO PRINTER.
000140
000150
000160 DATA DIVISION.
000170 FILE SECTION.
000180 FD TEAM-REC-IN.
000190 01 TEAM-REC.
000200     03  TEAM-CODE   PIC XXX.
000210     03  TEAM-NAME   PIC X(20).
000220     03  PLAYED      PIC 99.
000230     03  GOALS-FOR   PIC 99.
000240     03  GOALS-AGST  PIC 99.
000250     03  G-WON       PIC 99.
000260     03  G-LOST      PIC 99.
000270     03  G-DRAWN     PIC 99.
000280     03  GOAL-DIFF   PIC S99 SIGN LEADING SEPARATE.
000290     03  POINTS      PIC 99.
000300
000310 SD WORK-FILE.
000320 01 WORK-REC.
000330     03  TEAM-CODE-KEY PIC XXX.
000340     03                PIC X(22).
000350     03  GF-KEY        PIC 99.
000360     03                PIC X(8).
000370     03  GD-KEY        PIC S99  SIGN LEADING SEPARATE.
000380     03  POINTS-KEY    PIC 99.
000390
000400
000410 FD PRINT-FILE.
000420 01 TEXT-OUT     PIC X(60).
000430
000440 FD SORT-OUT.
000450 01 TEAM-REC-OUT.
000460     03  STEAM-CODE  PIC XXX.
000470     03  STEAM-NAME  PIC X(20).
000480     03  SPLAYED     PIC 99.
000490     03  SGOALS-FOR  PIC 99.
000500     03  SGOALS-AGST PIC 99.
000510     03  SG-WON      PIC 99.
000520     03  SG-LOST     PIC 99.
000530     03  SG-DRAWN    PIC 99.
000540     03  SGOAL-DIFF  PIC S999.
000550     03  SPOINTS     PIC 99.
000560
000570
000580
000590
000600 WORKING-STORAGE SECTION.
000610
000620 01 M              PIC 99.
000630 01 REAL-GOAL-DIFF PIC S999.
000640
000650 01 W-DATE.
000660     03  W-YEAR    PIC 99.
000670     03  W-MON     PIC 99.
000680     03  W-DAY     PIC 99.
000690
000700
000710 01 SCORE.
000720     03 W-H-SCR    PIC 9.
000730     03            PIC X VALUE "-".
000740     03 W-A-SCR    PIC 9.
000750
000760 01 P-TITLE.
000770     03            PIC X(5) VALUE SPACES.
000780     03 TAB-TITLE  PIC X(34)
000790         VALUE "The English FA Premier League".
000800
000810     03 P-DATE.
000820         05 P-DAY  PIC XX.
000830         05        PIC X VALUE "/".
000840         05 P-MON  PIC XX.
000850         05        PIC X VALUE "/".
000860         05 P-YEAR PIC XX.
000870
000880 01 P-UNDERLINE    PIC X(45) VALUE ALL "-".
000890 01 P-GAP          PIC X VALUE SPACE.
000900
000910 01 P-HEADER.
000920     03          PIC X(6) VALUE SPACES.
000930     03 TAB-TEAM PIC X(4) VALUE "TEAM".
000940     03          PIC X(11) VALUE SPACES.
000950     03 PLY      PIC X(5) VALUE "Playd".
000960     03          PIC X VALUE SPACE.
000970     03 WO       PIC XXX VALUE "Won".
000980     03          PIC X VALUE SPACE.
000990     03 DR       PIC XXXX VALUE "Drwn".
001000     03          PIC X VALUE SPACE.
001010     03 LO       PIC XXXX VALUE "Lost".
001020     03          PIC X VALUE SPACE.
001030     03 GF       PIC XXX VALUE "For".
001040     03          PIC X VALUE SPACE.
001050     03 GA       PIC X(5) VALUE "Agnst".
001060     03          PIC X VALUE SPACE.
001070     03 GD       PIC XX VALUE "GD".
001080     03          PIC X VALUE SPACE.
001090     03 PTS      PIC XXX VALUE "PTS".
001100
001110 01 W-TEXT-OUT.
001120     03  P-TAB-POS   PIC 99.
001130     03              PIC X VALUE SPACE.
001140     03  P-TEAM      PIC X(20).
001150     03  P-PLAYED    PIC 99.
001160     03              PIC XXX VALUE SPACES.
001170     03  P-G-WON     PIC Z9.
001180     03              PIC XX VALUE SPACES.
001190     03  P-G-DRAWN   PIC Z9.
001200     03              PIC XXX VALUE SPACES.
001210     03  P-G-LOST    PIC Z9.
001220     03              PIC XXX VALUE SPACES.
001230     03  P-GOALS-FOR PIC 99.
001240     03              PIC XX VALUE SPACES.
001250     03  P-GOALS-AGST  PIC 99.
001260     03              PIC XX VALUE SPACES.
001270     03  P-GOAL-DIFF PIC ZZ9.
001280     03              PIC XX VALUE SPACES.
001290     03  P-POINTS    PIC Z9.
001300
001310
001320 01 SCORE-TAB.
001330     03 TAB-SCORE    PIC 9 OCCURS 2.
001340 01 T-POINTS-TAB.
001350     03 T-POINTS     PIC 99 OCCURS 20.
001360 01 POINTS-TAB.
001370     03  TAB-POINTS  PIC 9 OCCURS 2.
001380 01 T-G-FOR-TAB.
001390     03 T-G-FOR      PIC 99 OCCURS 20.
001400 01 T-G-AGST-TAB.
001410     03 T-G-AGST     PIC 99 OCCURS 20.
001420 01 T-G-DIFF-TAB.
001430     03 T-G-DIFF     PIC 99 OCCURS 20.
001440 01 TAB-TEAM-NAME.
001450     03  TEAM        PIC XXX OCCURS 2.
001460
001470
001480 01 V-TEAM-FLAG      PIC X.
001490     88  V-TEAM      VALUE "Y".
001500 01 V-SCORE-FLAG     PIC X.
001510     88  V-SCORE     VALUE "Y".
001520 01 SORT-ONLY-FLAG   PIC X.
001530     88 SORT-ONLY    VALUE "Y".
001540
001550
001560 01 ENDING-KEY       PIC X VALUE SPACE.
001570 01 SWITCH           PIC 9.
001580 01 EOF-FLAG         PIC X VALUE "N".
001590 01 COUNTER          PIC 99.
001600 01 W-GOAL-DIFF      PIC 99.
001610 01 LAST-SCORE       PIC X.
001620 01 N                PIC 99.
001630
001640*****************************************************
001650
001660 PROCEDURE DIVISION.
001670
001680 MAIN-PARAGRAPH.
001690
001700     PERFORM DISPLAY-INSTRUCTIONS
001710     PERFORM INPUT-DATA
001720     PERFORM SORT-TABLE
001730     PERFORM PRINT-TABLE
001740     DISPLAY " Type Q or X to exit program."
001750     ACCEPT ENDING-KEY
001760     STOP RUN.
001770*******************************************************************
001780 DISPLAY-INSTRUCTIONS.
001790     DISPLAY " Instructions"
001800     DISPLAY " "
001810     DISPLAY " Following prompts, enter the first "
001820     DISPLAY "3 letters of the team in lower case. "
001830     DISPLAY " Then enter the score (home team score first)."
001840     DISPLAY " To perform SORT ONLY function, type 'xxx' "
001850     DISPLAY "at both team prompts. ".
001860*******************************************************************
001870 INPUT-DATA.
001880     MOVE "n" TO LAST-SCORE
001890     MOVE "N" TO SORT-ONLY-FLAG
001900     PERFORM UNTIL LAST-SCORE = "y" OR "Y"
001910        MOVE "N" TO V-SCORE-FLAG
001920        MOVE "N" TO V-TEAM-FLAG
001930        PERFORM UNTIL V-TEAM
001940            DISPLAY "INPUT HOME TEAM >"
001950            ACCEPT TEAM (1)
001960            DISPLAY "INPUT AWAY TEAM >"
001970            ACCEPT TEAM (2)
001980            PERFORM VAL-TEAM
001990         END-PERFORM
002000         IF TEAM (1) = "XXX" OR "xxx" THEN
002010             MOVE "Y" TO LAST-SCORE
002020             PERFORM SORT-TABLE
002030         ELSE
002040         PERFORM UNTIL V-SCORE or SORT-ONLY
002050            DISPLAY "INPUT RESULT AS 'X-Y'"
002060            ACCEPT SCORE
002070            MOVE W-H-SCR TO TAB-SCORE (1)
002080            MOVE W-A-SCR TO TAB-SCORE (2)
002090            PERFORM VAL-SCORE
002100         END-PERFORM
002110         DISPLAY "LAST RESULT? Y/N"
002120         ACCEPT LAST-SCORE
002130         PERFORM CALC-POINTS
002140         PERFORM UPDATE-RECORD
002150         END-IF
002160     END-PERFORM.
002170*******************************************************************
002180 VAL-TEAM.
002190     PERFORM VARYING COUNTER FROM 1 BY 1
002200                 UNTIL COUNTER > 2
002210
002220        EVALUATE TRUE
002230           WHEN TEAM (COUNTER) = "ars" or "ast" or "bra" or
002240                     "che" or "cov" or "der" or
002250                     "eve" or "lee" or "lei" or
002260                     "liv" or "man" or "mid" or
002270                     "new" or "she" or "sou" or
002280                     "sun" or "tot" or "wat" or
002290                     "wes" or "wim"
002300               MOVE "Y" TO V-TEAM-FLAG
002310           WHEN OTHER MOVE "N" TO V-TEAM-FLAG
002320        END-EVALUATE
002340     END-PERFORM
002350     IF NOT V-TEAM THEN DISPLAY
002360             "INVALID TEAM CODE ENTERED-"
002370             "RE-ENTER BOTH TEAM CODES AGAIN."
002380     END-IF.
002390*******************************************************************
002400 VAL-SCORE.
002410     IF ( W-H-SCR > 9 ) OR ( W-A-SCR > 9 )
002420         THEN PERFORM BIG-SCORE
002430     END-IF
002440     IF ( W-H-SCR NOT NUMERIC) OR ( W-H-SCR NOT NUMERIC)
002450         THEN MOVE "N" TO V-SCORE-FLAG
002460     ELSE MOVE "Y" TO V-SCORE-FLAG
002470     END-IF
002480     IF NOT V-SCORE THEN
002490        DISPLAY "INVALID SCORE ENTRY. PLEASE RE-ENTER SCORE."
002500     END-IF.
002510*******************************************************************
002520 BIG-SCORE.
002525* Putting a STOP RUN in this paragraph is probably
002527* very bad programming practise. Better logic could be used!
002530     DISPLAY "A team has scored more than 10 goals. "
002540     DISPLAY "This program will terminate now. "
002550     DISPLAY "Following this, the record in Input.rec "
002560     DISPLAY "will have to be ammended manually"
002580     DISPLAY " Following this perform SORT ONLY procedure."
002600     ACCEPT ENDING-KEY
002610     STOP RUN.
002620
002630*******************************************************************
002640 CALC-POINTS.
002650     IF TAB-SCORE (1) > TAB-SCORE (2) THEN
002660         MOVE 3 TO TAB-POINTS (1)
002670     ELSE
002680         IF TAB-SCORE (2) > TAB-SCORE (1) THEN
002690             ADD 3 TO TAB-POINTS (2)
002700         ELSE
002710             MOVE 1 TO TAB-POINTS (1)
002720             MOVE 1 TO TAB-POINTS (2)
002730         END-IF
002740     END-IF.
002750
002760*******************************************************************
002770 UPDATE-RECORD.
002790     MOVE 1 TO N
002800     MOVE 1 TO M
002810     OPEN I-O TEAM-REC-IN
002820     PERFORM UNTIL M > 20
002830     READ TEAM-REC-IN
002840     AT END
002850         DISPLAY TEAM (1) " has details ammended"
002860     NOT AT END
002870     IF TEAM (1) = TEAM-CODE THEN
002880         PERFORM ADJUST-DATA
002890
002900     END-IF
002910     ADD 1 TO M
002920     END-READ
002930     END-PERFORM
002940
002950     CLOSE TEAM-REC-IN
002955
002970     MOVE 2 TO N
002980     MOVE 1 TO M
002980
002990     OPEN I-O TEAM-REC-IN
003000     PERFORM UNTIL M > 20
003010        READ TEAM-REC-IN
003020           AT END
003030               DISPLAY TEAM (2) " has details ammended"
003040           NOT AT END
003050             IF TEAM (2) = TEAM-CODE THEN
003060                PERFORM ADJUST-DATA
003080             END-IF
003090             ADD 1 TO M
003100        END-READ
003110     END-PERFORM
003120     CLOSE TEAM-REC-IN
003130     DISPLAY "Table has been updated".
003140*******************************************************************
003150 ADJUST-DATA.
003160     IF N = 1 THEN MOVE 2 TO SWITCH
003170     ELSE MOVE 1 TO SWITCH
003180     END-IF
003190         ADD TAB-SCORE (N) TO GOALS-FOR
003200         ADD TAB-SCORE (SWITCH) TO GOALS-AGST
003210         SUBTRACT GOALS-AGST FROM GOALS-FOR GIVING GOAL-DIFF
003220         ADD TAB-POINTS (N) TO POINTS
003230         ADD 1 TO PLAYED
003240         EVALUATE TAB-POINTS (N)
003250             WHEN 3 ADD 1 TO G-WON
003260             WHEN ZERO ADD 1 TO G-LOST
003270             WHEN 1 ADD 1 TO G-DRAWN
003280         END-EVALUATE
003290         REWRITE TEAM-REC.
003300*******************************************************************
003310 SORT-TABLE.
003320     SORT WORK-FILE
003330         ON DESCENDING KEY POINTS-KEY GD-KEY GF-KEY
003340         USING TEAM-REC-IN
003350         GIVING SORT-OUT.
003360
003370*******************************************************************
003380 PRINT-TABLE.
003390     ACCEPT W-DATE FROM DATE
003400     MOVE W-DAY TO P-DAY
003410     MOVE W-MON TO P-MON
003420     MOVE W-YEAR TO P-YEAR
003430
003440     OPEN INPUT SORT-OUT
003450          OUTPUT PRINT-FILE
003460
003470     WRITE TEXT-OUT FROM P-TITLE AFTER 1 LINE
003480     WRITE TEXT-OUT FROM P-UNDERLINE AFTER 1 LINE
003490     WRITE TEXT-OUT FROM P-GAP AFTER 1 LINE
003500     WRITE TEXT-OUT FROM P-HEADER AFTER 1 LINE
003510     MOVE 1 TO N
003520     PERFORM UNTIL N > 20
003530        READ SORT-OUT
003540           AT END MOVE "Y" TO EOF-FLAG
003550           NOT AT END
003560              MOVE N TO P-TAB-POS
003570              MOVE STEAM-NAME TO P-TEAM
003580              MOVE SPLAYED TO P-PLAYED
003590              MOVE SG-WON TO P-G-WON
003600              MOVE SG-LOST TO P-G-LOST
003610              MOVE SG-DRAWN TO P-G-DRAWN
003620              MOVE SGOALS-FOR TO P-GOALS-FOR
003630              MOVE SGOALS-AGST TO P-GOALS-AGST
003650              MOVE SGOAL-DIFF TO P-GOAL-DIFF
003660              MOVE SPOINTS TO P-POINTS
003670
003680              WRITE TEXT-OUT FROM W-TEXT-OUT
003700        END-READ
003710        ADD 1 TO N
003720     END-PERFORM
003730     CLOSE SORT-OUT PRINT-FILE
003740     DISPLAY "Table is now written to the printer".
003750*******************************************************************

¤ Dauer der Verarbeitung: 0.16 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.