一个在AS400系统中使用COBOL/RPGLE/CLP实现的贪吃蛇游戏
代码涉及DSPF弹窗；DSPF屏幕自动刷新；PF文件查改；COBOL二维数组；COBOL实现队列；COBOL生成伪随机数；CLP字符串操作；CLP获取系统日期；CLP获取用户账号；自定义命令等
运行效果
源码
README.TXT 一些实现细节
**************************************************************************
* AUTHOR: WITT *
* DESCRIPTION: README.TXT - ABOUT THE GAME *
**************************************************************************
Implementation Details
- Draw screen by DSPF
- Snake data structure is a queue implement with array
- Pseudo random number generate from system time
- Ranking data save in PF
- Auto refresh screen by RPGLE read DSPF time outSNAKE.DSPF 主屏幕
当前游戏结束的弹窗只能显示3行排行榜记录，目前还没有做出支持滚动显示记录的弹窗
A**************************************************************************
A* AUTHOR: WITT *
A* DESCRIPTION: SNAKESCRN.DSPF - MAIN SCREEN *
A**************************************************************************
A DSPSIZ(24 80 *DS3)
A INDARA
A INVITE
A CF01(01)
A CF02(02)
A CF03(03)
A CF05(05)
A CF09(09)
A CF10(10)
A CF11(11)
A CF12(12)
A R WINMAIN
A MAINLINE1 42A O 3 20
A MAINLINE2 42A O 4 20
A MAINLINE3 42A O 5 20
A MAINLINE4 42A O 6 20
A MAINLINE5 42A O 7 20
A MAINLINE6 42A O 8 20
A MAINLINE7 42A O 9 20
A MAINLINE8 42A O 10 20
A MAINLINE9 42A O 11 20
A MAINLINE10 42A O 12 20
A MAINLINE11 42A O 13 20
A MAINLINE12 42A O 14 20
A MAINLINE13 42A O 15 20
A MAINLINE14 42A O 16 20
A MAINLINE15 42A O 17 20
A MAINLINE16 42A O 18 20
A MAINLINE17 42A O 19 20
A MAINLINE18 42A O 20 20
A MAINLINE19 42A O 21 20
A MAINLINE20 42A O 22 20
A R WINGAMOVR
A WINDOW(5 22 7 34)
A BLINK
A OVERLAY
A 1 1'GAMEOVER'
A 1 21'SCORE:'
A OVRSCORE 3Y 0O 1 28
A 3 1'RANK PLAYER SCORE DATE'
A OVRL1RNK 4Y 0O 4 1
A OVRL1NAM 14A O 4 6
A OVRL1COR 3Y 0O 4 21
A OVRL1DTE 8A O 4 27
A OVRL2RNK 4Y 0O 5 1
A OVRL2NAM 14A O 5 6
A OVRL2COR 3Y 0O 5 21
A OVRL2DTE 8A O 5 27
A OVRL3RNK 4Y 0O 6 1
A OVRL3NAM 14A O 6 6
A OVRL3COR 3Y 0O 6 21
A OVRL3DTE 8A O 6 27RANKING.PF 排行榜数据表
*****************************************************************
* AUTHOR: WITT *
* DESCRIPTION: RANKING.PF - RANKING DATA *
*****************************************************************
R R001
RKSCORE 3P 0
RKPLAYER 14A
RKDTE 8A
RKTIME 8A
K RKSCORESNAKESTART.CLP 开始游戏
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: SNAKESTART.CLP - START GAME */
/******************************************************************************/
PGM
CALL PGM(WITTGAMES/SETENV)
CALL PGM(*LIBL/SNAKEMAIN)
ENDPGMSNAKE.CMD 开始新游戏的命令
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: SNAKE.CMD - CALL SNAKESTART */
/******************************************************************************/
CMDSETENV.CLP 设置游戏运行环境
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: SETENV.CLP - SETUP ENVIRONMENT */
/******************************************************************************/
PGM
MONMSG MSGID(CPF2104) /* RMVLIBLE LIB NOT FOUND */
RMVLIBLE LIB(WITTGAMES )
RMVLIBLE LIB(WITTGAMPKG)
ADDLIBLE LIB(WITTGAMES ) POSITION(*LAST)
ADDLIBLE LIB(WITTGAMPKG) POSITION(*LAST)
ENDPGMSNAKEMAIN.CBL 主程序
IDENTIFICATION DIVISION.
**************************************************************************
* AUTHOR: WITT *
* DESCRIPTION: SNAKEMAIN.CBL - MAIN PGM *
**************************************************************************
PROGRAM-ID. SNAKEMAIN.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SNAKESCRN-F ASSIGN TO WORKSTATION-SNAKESCRN-SI
ORGANIZATION IS TRANSACTION
FILE STATUS IS SNAKESCRN-STATUS
ACCESS MODE IS SEQUENTIAL
CONTROL-AREA IS TRANS-CTRL-AREA.
DATA DIVISION.
FILE SECTION.
FD SNAKESCRN-F
LABEL RECORDS ARE OMITTED
DATA RECORD IS SNAKESCRN-REC.
01 SNAKESCRN-REC.
COPY DD-ALL-FORMATS-O OF SNAKESCRN.
WORKING-STORAGE SECTION.
77 MAP-HEIGHT PIC 9(2) VALUE 15.
77 MAP-WIDTH PIC 9(2) VALUE 40.
77 MAX-SNAKE-LEN PIC 9(3) VALUE 600.
77 SCRN-LINE-MAXIDX PIC 9(2) VALUE 20.
77 SCRN-COL-MAXIDX PIC 9(2) VALUE 42.
77 SNAKEQ-FRONT-POINTER PIC 9(3) VALUE 1.
77 SNAKEQ-REAR-POINTER PIC 9(3) VALUE 0.
77 SLEEP-DURATION PIC 9(3) VALUE 300.
77 RANDOM-NUM-RANGE PIC 9(2).
77 RANDOM-NUMBER PIC 9(2).
77 QUOTIENT PIC 9(7).
77 SNAKESCRN-STATUS PIC X(2).
77 SYSTIME PIC 9(8).
77 I PIC 9(2).
01 SAVED-COORDINATE.
05 SKHEAD-LINE PIC 9(2).
05 SKHEAD-COLN PIC 9(2).
05 SKTAIL-LINE PIC 9(2).
05 SKTAIL-COLN PIC 9(2).
05 FOOD-LINE PIC 9(2).
05 FOOD-COLN PIC 9(2).
01 TRANS-CTRL-AREA.
05 FUNCTION-KEY PIC X(2).
88 FKEY-F1 VALUE "01".
88 FKEY-F2 VALUE "02".
88 FKEY-F3 VALUE "03".
88 FKEY-F5 VALUE "05".
88 FKEY-F9 VALUE "09".
88 FKEY-F10 VALUE "10".
88 FKEY-F11 VALUE "11".
88 FKEY-F12 VALUE "12".
01 SCRN-ARRAY.
05 SCRN-LINE OCCURS 20 TIMES.
15 SCRN-NODE PIC X(1) OCCURS 42 TIMES.
01 SNAKE-QUEUE.
05 SNAKEQ-COORDINATE OCCURS 600 TIMES.
10 SNAKEQ-LINE PIC 9(2).
10 SNAKEQ-COLN PIC 9(2).
01 MOVE-DIRECTION PIC X(1).
88 MOVE-RIGHT VALUE "R".
88 MOVE-LEFT VALUE "L".
88 MOVE-UP VALUE "U".
88 MOVE-DOWN VALUE "D".
01 GAME-STATUS PIC X(1).
88 NEWGAME VALUE "N".
88 GAMEOVER VALUE "O".
01 GAMOVR-POPWIN-REC.
05 CURR-ROUND-SCORE PIC 9(3) VALUE 0.
05 RANKING-TABLE.
10 RANKING-TABLE-REC OCCURS 3 TIMES.
15 RANKING-RANK PIC 9(4) VALUE 0.
15 RANKING-NAME PIC X(14) VALUE SPACES.
15 RANKING-SCORE PIC 9(3) VALUE 0.
15 RANKING-DATE PIC X(8) VALUE SPACES.
01 END-LOOP-FLG PIC X(1).
88 END-LOOP VALUE "Y".
01 CATCH-FOOD-FLG PIC X(1).
88 CATCH-FOOD VALUE "Y".
PROCEDURE DIVISION.
MAIN-PROC.
PERFORM 200-NEWGAME-INIT
THRU 200-NEWGAME-INIT-X.
PERFORM 400-LOOP-GAME
THRU 400-LOOP-GAME-X
UNTIL FKEY-F3.
MAIN-PROC-X.
GOBACK.
200-NEWGAME-INIT.
SET NEWGAME TO TRUE.
MOVE SPACE TO CATCH-FOOD-FLG.
MOVE SPACE TO FUNCTION-KEY.
COMPUTE CURR-ROUND-SCORE = 0.
PERFORM SNAKEQUEUE-INIT
THRU SNAKEQUEUE-INIT-X.
PERFORM SCREEN-INIT
THRU SCREEN-INIT-X.
PERFORM DRAW-SNAKEHEAD
THRU DRAW-SNAKEHEAD-X.
PERFORM GENERATE-FOOD
THRU GENERATE-FOOD-X.
200-NEWGAME-INIT-X.
EXIT.
400-LOOP-GAME.
PERFORM DRAW-SCRN
THRU DRAW-SCRN-X.
PERFORM HANDLE-FKEY
THRU HANDLE-FKEY-X.
IF FKEY-F3
GO TO 400-LOOP-GAME-X
END-IF.
PERFORM MOVE-SNAKE
THRU MOVE-SNAKE-X.
PERFORM GAME-OVER
THRU GAME-OVER-X.
IF FKEY-F5
PERFORM 200-NEWGAME-INIT
THRU 200-NEWGAME-INIT-X
END-IF.
400-LOOP-GAME-X.
EXIT.
HANDLE-FKEY.
PERFORM UPD-MOVE-SPEED
THRU UPD-MOVE-SPEED-X.
PERFORM UPD-MOVE-DIRECTION
THRU UPD-MOVE-DIRECTION-X.
HANDLE-FKEY-X.
EXIT.
UPD-MOVE-SPEED.
IF FKEY-F11
AND SLEEP-DURATION > 100
SUBTRACT 100 FROM SLEEP-DURATION
END-IF.
IF FKEY-F12
AND SLEEP-DURATION < 900
ADD 100 TO SLEEP-DURATION
END-IF.
UPD-MOVE-SPEED-X.
EXIT.
UPD-MOVE-DIRECTION.
EVALUATE TRUE
WHEN FKEY-F1
IF NOT MOVE-DOWN
SET MOVE-UP TO TRUE
END-IF
WHEN FKEY-F2
IF NOT MOVE-UP
SET MOVE-DOWN TO TRUE
END-IF
WHEN FKEY-F9
IF NOT MOVE-RIGHT
SET MOVE-LEFT TO TRUE
END-IF
WHEN FKEY-F10
IF NOT MOVE-LEFT
SET MOVE-RIGHT TO TRUE
END-IF
WHEN OTHER
CONTINUE
END-EVALUATE.
UPD-MOVE-DIRECTION-X.
EXIT.
MOVE-SNAKE.
PERFORM UPD-SNAKEHEAD-COORDINATE
THRU UPD-SNAKEHEAD-COORDINATE-X.
PERFORM CATCH-FOOD
THRU CATCH-FOOD-X.
PERFORM UPD-GAME-STATUS
THRU UPD-GAME-STATUS-X.
IF GAMEOVER
GO TO MOVE-SNAKE-X
END-IF.
PERFORM DRAW-SNAKEHEAD
THRU DRAW-SNAKEHEAD-X.
PERFORM ERASE-SNAKETAIL
THRU ERASE-SNAKETAIL-X.
MOVE-SNAKE-X.
EXIT.
UPD-SNAKEHEAD-COORDINATE.
EVALUATE TRUE
WHEN MOVE-RIGHT
IF SKHEAD-COLN < SCRN-COL-MAXIDX
ADD 1 TO SKHEAD-COLN
END-IF
WHEN MOVE-LEFT
IF SKHEAD-COLN > 1
SUBTRACT 1 FROM SKHEAD-COLN
END-IF
WHEN MOVE-UP
IF SKHEAD-LINE > 1
SUBTRACT 1 FROM SKHEAD-LINE
END-IF
WHEN MOVE-DOWN
IF SKHEAD-LINE < SCRN-LINE-MAXIDX
ADD 1 TO SKHEAD-LINE
END-IF
WHEN OTHER
CONTINUE
END-EVALUATE.
UPD-SNAKEHEAD-COORDINATE-X.
EXIT.
CATCH-FOOD.
IF SKHEAD-LINE NOT = FOOD-LINE
OR SKHEAD-COLN NOT = FOOD-COLN
GO TO CATCH-FOOD-X
END-IF.
ADD 1 TO CURR-ROUND-SCORE.
SET CATCH-FOOD TO TRUE.
PERFORM GENERATE-FOOD
THRU GENERATE-FOOD-X.
CATCH-FOOD-X.
EXIT.
UPD-GAME-STATUS.
IF SCRN-NODE(SKHEAD-LINE, SKHEAD-COLN) NOT = SPACE
AND NOT CATCH-FOOD
SET GAMEOVER TO TRUE
END-IF.
UPD-GAME-STATUS-X.
EXIT.
DRAW-SNAKEHEAD.
MOVE "*" TO SCRN-NODE(SKHEAD-LINE, SKHEAD-COLN).
PERFORM SNAKEQUEUE-ENQUEUE
THRU SNAKEQUEUE-ENQUEUE-X.
DRAW-SNAKEHEAD-X.
EXIT.
ERASE-SNAKETAIL.
IF CATCH-FOOD
MOVE SPACE TO CATCH-FOOD-FLG
GO TO ERASE-SNAKETAIL-X
END-IF.
MOVE SPACE TO SCRN-NODE(SKTAIL-LINE, SKTAIL-COLN).
PERFORM SNAKEQUEUE-DEQUEUE
THRU SNAKEQUEUE-DEQUEUE-X.
ERASE-SNAKETAIL-X.
EXIT.
GAME-OVER.
IF NOT GAMEOVER
GO TO GAME-OVER-X
END-IF.
PERFORM HANDLE-RANKING
THRU HANDLE-RANKING-X.
PERFORM POP-GAMEOVER-WINDOW
THRU POP-GAMEOVER-WINDOW-X
UNTIL FKEY-F3 OR FKEY-F5.
GAME-OVER-X.
EXIT.
SNAKEQUEUE-INIT.
COMPUTE SNAKEQ-FRONT-POINTER = 1.
COMPUTE SNAKEQ-REAR-POINTER = 0.
SNAKEQUEUE-INIT-X.
EXIT.
SNAKEQUEUE-ENQUEUE.
ADD 1 TO SNAKEQ-REAR-POINTER.
IF SNAKEQ-REAR-POINTER > MAX-SNAKE-LEN
DIVIDE SNAKEQ-REAR-POINTER BY MAX-SNAKE-LEN
GIVING QUOTIENT REMAINDER SNAKEQ-REAR-POINTER
END-IF.
COMPUTE SNAKEQ-LINE(SNAKEQ-REAR-POINTER) = SKHEAD-LINE.
COMPUTE SNAKEQ-COLN(SNAKEQ-REAR-POINTER) = SKHEAD-COLN.
SNAKEQUEUE-ENQUEUE-X.
EXIT.
SNAKEQUEUE-DEQUEUE.
ADD 1 TO SNAKEQ-FRONT-POINTER.
IF SNAKEQ-FRONT-POINTER > MAX-SNAKE-LEN
DIVIDE SNAKEQ-FRONT-POINTER BY MAX-SNAKE-LEN
GIVING QUOTIENT REMAINDER SNAKEQ-FRONT-POINTER
END-IF.
COMPUTE SKTAIL-LINE = SNAKEQ-LINE(SNAKEQ-FRONT-POINTER)
COMPUTE SKTAIL-COLN = SNAKEQ-COLN(SNAKEQ-FRONT-POINTER).
SNAKEQUEUE-DEQUEUE-X.
EXIT.
GENERATE-FOOD.
MOVE SPACE TO END-LOOP-FLG.
PERFORM LOOP-UPD-FOOD-COORDINATE
THRU LOOP-UPD-FOOD-COORDINATE-X
UNTIL END-LOOP.
MOVE "*" TO SCRN-NODE(FOOD-LINE, FOOD-COLN).
GENERATE-FOOD-X.
EXIT.
LOOP-UPD-FOOD-COORDINATE.
COMPUTE RANDOM-NUM-RANGE = MAP-HEIGHT.
PERFORM GENERATE-RANDOM-NUMBER
THRU GENERATE-RANDOM-NUMBER-X.
COMPUTE FOOD-LINE = RANDOM-NUMBER + 2.
COMPUTE RANDOM-NUM-RANGE = MAP-WIDTH.
PERFORM GENERATE-RANDOM-NUMBER
THRU GENERATE-RANDOM-NUMBER-X.
COMPUTE FOOD-COLN = RANDOM-NUMBER + 2.
IF SCRN-NODE(FOOD-LINE, FOOD-COLN) = SPACE
SET END-LOOP TO TRUE
END-IF.
LOOP-UPD-FOOD-COORDINATE-X.
EXIT.
GENERATE-RANDOM-NUMBER.
ACCEPT SYSTIME FROM TIME.
DIVIDE SYSTIME BY RANDOM-NUM-RANGE
GIVING QUOTIENT REMAINDER RANDOM-NUMBER.
GENERATE-RANDOM-NUMBER-X.
EXIT.
HANDLE-RANKING.
CALL "HANDLRANK" USING CURR-ROUND-SCORE
RANKING-TABLE.
CANCEL "HANDLRANK".
HANDLE-RANKING-X.
EXIT.
DRAW-SCRN.
MOVE SPACE TO FUNCTION-KEY.
CALL "DRWSCRN" USING FUNCTION-KEY
SLEEP-DURATION
SCRN-ARRAY.
CANCEL "DRWSCRN".
DRAW-SCRN-X.
EXIT.
POP-GAMEOVER-WINDOW.
OPEN I-O SNAKESCRN-F.
WRITE SNAKESCRN-REC FROM SCRN-ARRAY FORMAT "WINMAIN".
WRITE SNAKESCRN-REC FROM GAMOVR-POPWIN-REC FORMAT "WINGAMOVR".
READ SNAKESCRN-F FORMAT "WINGAMOVR".
CLOSE SNAKESCRN-F.
POP-GAMEOVER-WINDOW-X.
EXIT.
SCREEN-INIT.
INITIALIZE SCRN-ARRAY.
PERFORM LOAD-SCRN-BORDER
THRU LOAD-SCRN-BORDER-X.
INITIALIZE SAVED-COORDINATE REPLACING NUMERIC BY 2.
SET MOVE-RIGHT TO TRUE.
SCREEN-INIT-X.
EXIT.
LOAD-SCRN-BORDER.
MOVE ALL "=" TO SCRN-LINE(1)(2:40).
MOVE ALL "=" TO SCRN-LINE(17).
MOVE ALL "=" TO SCRN-LINE(20)(2:40).
PERFORM VARYING I FROM 2 BY 1
UNTIL I > 19
MOVE "|" TO SCRN-NODE(I, 1)
MOVE "|" TO SCRN-NODE(I, 42)
END-PERFORM.
MOVE "F1-UP F9-LEFT F3-QUIT F11-FASTER" TO SCRN-LINE(18)(3:38).
MOVE "F2-DOWN F10-RIGHT F5-RESUME F12-SLOWER" TO SCRN-LINE(19)(3:38).
LOAD-SCRN-BORDER-X.
EXIT.DRWSCRN.RPGLE 画屏幕
这部分功能原本打算写在主程序里面，但COBOL读取DSPF时超时限制似乎不起作用，程序会停在READ语句那里等待玩家按键，这个问题目前没能解决。于是转而使用RPGLE去自动刷新屏幕，参考: AS400 RPGLE 利用DSPF读取超时实现屏幕自动刷新_as400 dspf read-CSDN博客
值得一提的是DSPF WAITRCD属性只支持整数秒，设为1秒的话蛇移动很慢，设为0秒的话玩家又根本来不及去按键。这里的做法是将WAITRCD设为0秒然后在一段时间之内(SLEEPDUR)循环读取玩家按键，运行时可调整SLEEPDUR来改变蛇的移动速度
**************************************************************************
* AUTHOR: WITT *
* DESCRIPTION: DRWSCRN.RPGLE - DRAW SCREEN *
**************************************************************************
FSNAKESCRN CF E WORKSTN MAXDEV(*FILE) USROPN
DSYSTIME S Z
DKEYPRESSED S N
DSCRNARR S 42A DIM(20)
C *ENTRY PLIST
C PARM FKEY 2
C PARM SLEEPDUR 3
C PARM SCRNARR
C
C EVAL QCMD = 'OVRDSP
C EVAL QCMD =
C 'OVRDSPF FILE(SNAKESCRN) WAITRCD(*IMMED)'
C CALL 'QCMDEXC' QCMDEXC
C OPEN SNAKESCRN
C EXSR LOADSCRDATA
C EXSR REFSCREEN
C CLOSE SNAKESCRN
C
C ENDPGM TAG
C MOVE *ON *INLR
C
C QCMDEXC PLIST
C PARM QCMD 200
C PARM 200 QLEN 15 5
C
C LOADSCRDATA BEGSR
C MOVE SCRNARR(1) MAINLINE1
C MOVE SCRNARR(2) MAINLINE2
C MOVE SCRNARR(3) MAINLINE3
C MOVE SCRNARR(4) MAINLINE4
C MOVE SCRNARR(5) MAINLINE5
C MOVE SCRNARR(6) MAINLINE6
C MOVE SCRNARR(7) MAINLINE7
C MOVE SCRNARR(8) MAINLINE8
C MOVE SCRNARR(9) MAINLINE9
C MOVE SCRNARR(10) MAINLINE10
C MOVE SCRNARR(11) MAINLINE11
C MOVE SCRNARR(12) MAINLINE12
C MOVE SCRNARR(13) MAINLINE13
C MOVE SCRNARR(14) MAINLINE14
C MOVE SCRNARR(15) MAINLINE15
C MOVE SCRNARR(16) MAINLINE16
C MOVE SCRNARR(17) MAINLINE17
C MOVE SCRNARR(18) MAINLINE18
C MOVE SCRNARR(19) MAINLINE19
C MOVE SCRNARR(20) MAINLINE20
C ENDSR
C
C REFSCREEN BEGSR
C Z-ADD 0 TIMER 7 0
C MOVE SLEEPDUR SLEEPDURNUM 3 0
C EXSR GETTIMESTMP
C MOVE TIMESTMP SLEEPSTART 7 0
C WRITE WINMAIN
C
C DOW TIMER < SLEEPDURNUM
C IF NOT KEYPRESSED
C READ SNAKESCRN 9699
C EXSR SETFKEY
C ENDIF
C EXSR REFTIMER
C ENDDO
C ENDSR
C
C SETFKEY BEGSR
C IF *IN01 OR *IN02 OR *IN03 OR *IN05 OR
C *IN09 OR *IN10 OR *IN11 OR *IN12
C MOVE *ON KEYPRESSED
C ENDIF
C
C IF *IN01
C EVAL FKEY = '01'
C ENDIF
C
C IF *IN02
C EVAL FKEY = '02'
C ENDIF
C
C IF *IN03
C EVAL FKEY = '03'
C ENDIF
C
C IF *IN05
C EVAL FKEY = '05'
C ENDIF
C
C IF *IN09
C EVAL FKEY = '09'
C ENDIF
C
C IF *IN10
C EVAL FKEY = '10'
C ENDIF
C
C IF *IN11
C EVAL FKEY = '11'
C ENDIF
C
C IF *IN12
C EVAL FKEY = '12'
C ENDIF
C ENDSR
C
C GETTIMESTMP BEGSR
C TIME SYSTIME
C MOVEL SYSTIME TIMESTMPL 26
C MOVE *BLANK TIMESTMP 7
C EVAL TIMESTMP = %SUBST(TIMESTMPL:15:2)
C + %SUBST(TIMESTMPL:18:2)
C + %SUBST(TIMESTMPL:21:3)
C ENDSR
C
C REFTIMER BEGSR
C EXSR GETTIMESTMP
C MOVE TIMESTMP TIMESTMPNUM 7 0
C EVAL TIMER = TIMESTMPNUM - SLEEPSTART
C ENDSRHANDLRANK.CBL 写入及查询排行榜文件
IDENTIFICATION DIVISION.
**************************************************************************
* AUTHOR: WITT *
* DESCRIPTION: HANDLRANK.CBL - QRY AND UPD RANKING *
**************************************************************************
PROGRAM-ID. HANDLERANK.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT RANKING ASSIGN TO DATABASE-RANKING
ACCESS MODE IS DYNAMIC
ORGANIZATION IS INDEXED
FILE STATUS IS RANKING-STATUS
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY WITH DUPLICATES.
DATA DIVISION.
FILE SECTION.
FD RANKING
LABEL RECORDS ARE STANDARD.
01 RANKING-REC.
COPY DDS-ALL-FORMATS OF RANKING.
WORKING-STORAGE SECTION.
77 SYS-TIME PIC X(8) VALUE SPACES.
77 MAP-HEIGHT PIC 9(2) VALUE 15.
77 MAP-WIDTH PIC 9(2) VALUE 40.
77 MAX-SCORE PIC 9(4).
77 I PIC 9(1) VALUE 0.
01 SYS-DATE.
05 SYS-DATE-CC PIC X(2) VALUE "20".
05 SYS-DATE-YYMMDD PIC X(6) VALUE SPACES.
01 FILE-STATUS.
05 RANKING-STATUS PIC X(2) VALUE SPACES.
LINKAGE SECTION.
01 LINK-CURR-ROUND-SCORE PIC 9(3).
01 LINK-RANKING-TABLE.
05 LINK-RANKING-TABLE-REC OCCURS 3 TIMES.
10 LINK-RANKING-RANK PIC 9(4).
10 LINK-RANKING-NAME PIC X(14).
10 LINK-RANKING-SCORE PIC 9(3).
10 LINK-RANKING-DATE PIC X(8).
PROCEDURE DIVISION USING LINK-CURR-ROUND-SCORE
LINK-RANKING-TABLE.
MAIN-PROC.
PERFORM 000-INIT
THRU 000-INIT-X.
PERFORM 200-UPD-RANKING
THRU 200-UPD-RANKING-X.
PERFORM 400-CHK-SCORE-999
THRU 400-CHK-SCORE-999-X.
PERFORM 600-QRY-RANKING
THRU 600-QRY-RANKING-X.
PERFORM 900-END
THRU 900-END-X.
MAIN-PROC-X.
GOBACK.
000-INIT.
INITIALIZE LINK-RANKING-TABLE.
OPEN I-O RANKING.
ACCEPT SYS-DATE-YYMMDD FROM DATE.
ACCEPT SYS-TIME FROM TIME.
000-INIT-X.
EXIT.
200-UPD-RANKING.
COMPUTE MAX-SCORE = MAP-HEIGHT * MAP-WIDTH.
IF LINK-CURR-ROUND-SCORE > MAX-SCORE
GO TO 200-UPD-RANKING-X
END-IF.
INITIALIZE RANKING-REC.
CALL "GETUSERID" USING RKPLAYER.
IF RKPLAYER = SPACE
MOVE "NOBODY" TO RKPLAYER
END-IF.
COMPUTE RKSCORE = LINK-CURR-ROUND-SCORE.
PERFORM WRITE-RANKING
THRU WRITE-RANKING-X.
200-UPD-RANKING-X.
EXIT.
400-CHK-SCORE-999.
INITIALIZE RANKING-REC.
COMPUTE RKSCORE = 999.
READ RANKING INVALID KEY CONTINUE.
IF RANKING-STATUS = ZEROS
GO TO 400-CHK-SCORE-999-X
END-IF.
MOVE "SYSTEM" TO RKPLAYER.
PERFORM WRITE-RANKING
THRU WRITE-RANKING-X.
400-CHK-SCORE-999-X.
EXIT.
600-QRY-RANKING.
PERFORM START-RANKING-TO-LAST-REC
THRU START-RANKING-TO-LAST-REC-X.
PERFORM LOOP-RANKING
THRU LOOP-RANKING-X.
600-QRY-RANKING-X.
EXIT.
900-END.
CLOSE RANKING.
900-END-X.
EXIT.
WRITE-RANKING.
MOVE SYS-DATE TO RKDTE.
MOVE SYS-TIME TO RKTIME.
WRITE RANKING-REC INVALID KEY CONTINUE.
WRITE-RANKING-X.
EXIT.
START-RANKING-TO-LAST-REC.
COMPUTE RKSCORE = 999.
START RANKING
KEY IS NOT LESS THAN EXTERNALLY-DESCRIBED-KEY
INVALID KEY CONTINUE
END-START.
START-RANKING-TO-LAST-REC-X.
EXIT.
LOOP-RANKING.
PERFORM VARYING I FROM 1 BY 1
UNTIL I > 3
OR RANKING-STATUS NOT = ZEROS
READ RANKING PRIOR AT END CONTINUE END-READ
IF RANKING-STATUS = ZEROS
MOVE I TO LINK-RANKING-RANK(I)
MOVE RKPLAYER TO LINK-RANKING-NAME(I)
MOVE RKSCORE TO LINK-RANKING-SCORE(I)
MOVE RKDTE TO LINK-RANKING-DATE(I)
END-IF
END-PERFORM.
LOOP-RANKING-X.
EXIT.GETUSERID.CLP 获取玩家ID
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: GETUSERID.CLP - GET USER ID */
/******************************************************************************/
PGM PARM(&USERID)
DCL VAR(&USERID) TYPE(*CHAR) LEN(10)
RTVJOBA USER(&USERID)
ENDPGM 非功能性源码
非功能性源码对贪吃蛇游戏特性没有影响，但是对增量开发有帮助
MAKE.CLP 编译源文件
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: MAKE.CLP - COMPILE ALL PGM */
/******************************************************************************/
PGM
DCL VAR(&LIVELIB) TYPE(*CHAR) LEN(10)
DCL VAR(&PKGLIB) TYPE(*CHAR) LEN(10)
DCLF FILE(WITTGAMPKG/PGMLIST) RCDFMT(QWHFDMBR)
CHGVAR VAR(&LIVELIB) VALUE('WITTGAMES')
CHGVAR VAR(&PKGLIB) VALUE('WITTGAMPKG')
CALL PGM(&PKGLIB/SETENV)
CRTDSPF FILE(&LIVELIB/SNAKESCRN) SRCFILE(&LIVELIB/SNAKESRC) -
SRCMBR(SNAKESCRN)
DLTOBJ OBJ(&LIVELIB/RANKING) OBJTYPE(*FILE)
MONMSG MSGID(CPF2105) /* OBJ NOT FOUND */
CRTPF FILE(&LIVELIB/RANKING) SRCFILE(&LIVELIB/SNAKESRC) SRCMBR(RANKING) -
SIZE(*NOMAX) REUSEDLT(*YES)
DSPFD FILE(&LIVELIB/SNAKESRC) TYPE(*MBR) OUTPUT(*OUTFILE) -
OUTFILE(&PKGLIB/PGMLIST)
LOOPCRTP:
RCVF RCDFMT(QWHFDMBR)
MONMSG MSGID(CPF0864) EXEC(GOTO LOOPCRTPX) /* EOF */
IF COND(&MBSEU *EQ 'RPGL') THEN(DO)
CRTBNDRPG PGM(&LIVELIB/&MBNAME) SRCFILE(&LIVELIB/&MBFILE) SRCMBR(*PGM)
ENDDO
IF COND(&MBSEU *EQ 'CBL') THEN(DO)
CRTCBLPGM PGM(&LIVELIB/&MBNAME) SRCFILE(&LIVELIB/&MBFILE) SRCMBR(*PGM)
ENDDO
IF COND(&MBSEU *EQ 'CLP') THEN(DO)
CRTCLPGM PGM(&LIVELIB/&MBNAME) SRCFILE(&LIVELIB/&MBFILE) SRCMBR(*PGM)
ENDDO
GOTO CMDLBL(LOOPCRTP)
LOOPCRTPX:
CRTCMD CMD(&LIVELIB/SNAKE) PGM(&LIVELIB/SNAKESTART) -
SRCFILE(&LIVELIB/SNAKESRC) SRCMBR(*CMD)
CRTCMD CMD(&LIVELIB/MYSAV) PGM(&LIVELIB/MYSAVP) -
SRCFILE(&LIVELIB/SNAKESRC) SRCMBR(*CMD)
CRTCLPGM PGM(&PKGLIB/MYRSTP) SRCFILE(&LIVELIB/SNAKESRC) SRCMBR(*PGM)
CRTCLPGM PGM(&PKGLIB/MAKE) SRCFILE(&LIVELIB/SNAKESRC) SRCMBR(*PGM)
CRTCLPGM PGM(&PKGLIB/SETENV) SRCFILE(&LIVELIB/SNAKESRC) SRCMBR(*PGM)
CRTCMD CMD(&PKGLIB/MYRST) PGM(&PKGLIB/MYRSTP) -
SRCFILE(&LIVELIB/SNAKESRC) SRCMBR(*CMD)
ENDPGMMYSAVP.CLP 打包备份源码
程序会创建SAVF，取系统日期做为TEXT，便于多版本源码备份
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: MYSAVP.CLP - SAVE OBJ INTO SAVF */
/******************************************************************************/
PGM PARM(&SAVLIB &SAVOBJ &BKPLIB &SAVF)
DCL VAR(&SAVLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SAVOBJ) TYPE(*CHAR) LEN(10)
DCL VAR(&BKPLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SAVF) TYPE(*CHAR) LEN(10)
DCL VAR(&SYSTIMETMP) TYPE(*CHAR) LEN(6)
DCL VAR(&SYSTIME) TYPE(*CHAR) LEN(8)
DCL VAR(&SYSDTE) TYPE(*CHAR) LEN(8)
DCL VAR(&SYSYY) TYPE(*CHAR) LEN(2)
DCL VAR(&SYSMM) TYPE(*CHAR) LEN(2)
DCL VAR(&SYSDD) TYPE(*CHAR) LEN(2)
MONMSG MSGID(CPF7302)
MONMSG MSGID(CPF2105)
RTVSYSVAL SYSVAL(QYEAR) RTNVAR(&SYSYY)
RTVSYSVAL SYSVAL(QMONTH) RTNVAR(&SYSMM)
RTVSYSVAL SYSVAL(QDAY) RTNVAR(&SYSDD)
CHGVAR VAR(&SYSDTE) VALUE(&SYSYY||'/'||&SYSMM||'/'||&SYSDD)
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&SYSTIMETMP)
CHGVAR VAR(&SYSTIME) VALUE(%SST(&SYSTIMETMP 1 2)||':'|| -
%SST(&SYSTIMETMP 3 2)||':'|| -
%SST(&SYSTIMETMP 5 2))
DLTOBJ OBJ(&BKPLIB/&SAVF) OBJTYPE(*FILE)
CRTSAVF FILE(&BKPLIB/&SAVF) TEXT(&SYSDTE *BCAT &SYSTIME *BCAT &SAVLIB -
*TCAT'/'||&SAVOBJ)
SAVOBJ OBJ(&SAVOBJ) LIB(&SAVLIB) DEV(*SAVF) OBJTYPE(*ALL) -
SAVF(&BKPLIB/&SAVF)
SNDPGMMSG MSG(&SAVLIB *TCAT '/'||&SAVOBJ *BCAT 'SAVED INTO' *BCAT -
&BKPLIB *TCAT '/'||&SAVF)
ENDPGMMYSAV.CMD 打包备份源码的命令
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: MYSAV.CMD - CALL MYSAVP */
/******************************************************************************/
CMD PROMPT('SAVLIB/SAVOBJ TO BKPLIB/SAVF')
PARM KWD(SAVLIB) TYPE(*CHAR) LEN(10) PROMPT('SAVLIB')
PARM KWD(SAVOBJ) TYPE(*CHAR) LEN(10) PROMPT('SAVOBJ')
PARM KWD(BKPLIB) TYPE(*CHAR) LEN(10) PROMPT('BKPLIB')
PARM KWD(SAVF) TYPE(*CHAR) LEN(10) PROMPT('SAVF')MYRSTP.CLP 从备份中恢复源码
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: MYRSTP.CLP - RESTORE OBJ FROM SAVF */
/******************************************************************************/
PGM PARM(&SAVLIB &SAVOBJ &BKPLIB &SAVF &RSTLIB)
DCL VAR(&SAVLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SAVOBJ) TYPE(*CHAR) LEN(10)
DCL VAR(&BKPLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SAVF) TYPE(*CHAR) LEN(10)
DCL VAR(&RSTLIB) TYPE(*CHAR) LEN(10)
MONMSG MSGID(CPF2125)
MONMSG MSGID(CPF2105)
DLTOBJ OBJ(&RSTLIB/&SAVOBJ) OBJTYPE(*FILE)
RSTOBJ OBJ(&SAVOBJ) SAVLIB(&SAVLIB) DEV(*SAVF) OBJTYPE(*FILE) -
SAVF(&BKPLIB/&SAVF) RSTLIB(&RSTLIB)
SNDPGMMSG MSG(&BKPLIB *TCAT '/'||&SAVF *TCAT '/'|| -
&SAVOBJ *BCAT 'RESTORED INTO' *BCAT &RSTLIB)
ENDPGMMYRST.CMD 从备份中恢复源码的命令
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: MYRST.CMD - CALL MYRSTP */
/******************************************************************************/
CMD PROMPT('BKPLIB/SAVF/SAVOBJ TO RSTLIB')
PARM KWD(SAVLIB) TYPE(*CHAR) LEN(10) PROMPT('SAVLIB')
PARM KWD(SAVOBJ) TYPE(*CHAR) LEN(10) PROMPT('SAVOBJ')
PARM KWD(BKPLIB) TYPE(*CHAR) LEN(10) PROMPT('BKPLIB')
PARM KWD(SAVF) TYPE(*CHAR) LEN(10) PROMPT('SAVF')
PARM KWD(RSTLIB) TYPE(*CHAR) LEN(10) PROMPT('RSTLIB')GRTAUT.CLP 赋权限
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: GRTAUT.CLP - GRANT AUTH */
/******************************************************************************/
PGM
GRTOBJAUT OBJ(WITTGAMES/*ALL) OBJTYPE(*ALL) USER(*PUBLIC) AUT(*USE)
GRTOBJAUT OBJ(WITTGAMPKG/*ALL) OBJTYPE(*ALL) USER(*PUBLIC) AUT(*USE)
GRTOBJAUT OBJ(WITTGAMES/RANKING) OBJTYPE(*FILE) USER(*PUBLIC) AUT(*ALL)
ENDPGMMERGE.CLP 将全部源文件合并到一个PF MEMBER中
/******************************************************************************/
/* AUTHOR : WITT */
/* DESCRIPTION: MERGE.CLP - MERGE SRC */
/******************************************************************************/
PGM
MONMSG CPF7310 /* MEMBER NOT FOUND */
RMVM FILE(WITTGAMES/SNAKESRC) MBR(SRCCODE)
CPYF FROMFILE(WITTGAMES/SNAKESRC) TOFILE(WITTGAMES/SNAKESRC) -
FROMMBR(*ALL) TOMBR(SRCCODE) MBROPT(*REPLACE) CRTFILE(*NO)
CHGPFM FILE(WITTGAMES/SNAKESRC) MBR(SRCCODE) SRCTYPE(TXT) -
TEXT('MERGED SRC CODE')
ENDPGM
扫一扫
1112
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
