运行效果
源码
README.TXT 一些实现的细节
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: ABOUT THE GAME */
/* DATE WRITTEN: 2024-08-15 */
/**********************************************************************/
Implementation details
.draw screen by DSPF
.snake data structure is a queue implement by array
.pseudo random number generate from system time
.ranking data save in PF
.get user ID by CLP command RTVJOBA
.auto refresh screen by RPGLE read DSPF time outSSNAKE.DSPF 游戏主屏幕
20行 * 42列的字符阵列，包含一个游戏结束的弹窗，边框由程序运行时画出
当前游戏结束的弹窗只能显示3行排行榜记录，目前还不太会实现可以滚动显示记录的弹窗
A**************************************************************************
A* AUTHOR: WITT *
A* DESCRIPTION: SNAKE SCREEN *
A* DATE WRITTEN: 2024-08-19 *
A**************************************************************************
A DSPSIZ(24 80 *DS3)
A INDARA
A R HEADER
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 MAPLINE1 42A O 3 20
A MAPLINE2 42A O 4 20
A MAPLINE3 42A O 5 20
A MAPLINE4 42A O 6 20
A MAPLINE5 42A O 7 20
A MAPLINE6 42A O 8 20
A MAPLINE7 42A O 9 20
A MAPLINE8 42A O 10 20
A MAPLINE9 42A O 11 20
A MAPLINE10 42A O 12 20
A MAPLINE11 42A O 13 20
A MAPLINE12 42A O 14 20
A MAPLINE13 42A O 15 20
A MAPLINE14 42A O 16 20
A MAPLINE15 42A O 17 20
A MAPLINE16 42A O 18 20
A MAPLINE17 42A O 19 20
A MAPLINE18 42A O 20 20
A MAPLINE19 42A O 21 20
A MAPLINE20 42A O 22 20
A R WINGAMOVR
A WINDOW(5 22 7 34)
A BLINK
A OVERLAY
A CF03(03)
A CF05(05)
A 1 1'GAMEOVER'
A 1 21'SCORE:'
A SCORE 3Y 0O 1 28
A 3 1'RANK PLAYER SCORE DATE'
A RNKREC1RNK 4Y 0O 4 1
A RNKREC1NAM 14A O 4 6
A RNKREC1COR 3Y 0O 4 21
A RNKREC1DTE 8A O 4 27
A RNKREC2RNK 4Y 0O 5 1
A RNKREC2NAM 14A O 5 6
A RNKREC2COR 3Y 0O 5 21
A RNKREC2DTE 8A O 5 27
A RNKREC3RNK 4Y 0O 6 1
A RNKREC3NAM 14A O 6 6
A RNKREC3COR 3Y 0O 6 21
A RNKREC3DTE 8A O 6 27FRANKING.PF 排行榜数据表
*****************************************************************
* AUTHOR: WITT *
* DESCRIPTION: RANKING DATA *
* DATE WRITTEN: 2024-08-08 *
*****************************************************************
R R001
RKSCORE 3P 0
RKPLAYER 14A
RKDTE 8A
RKTIME 8A
RKVIDEOLNK 3P 0
K RKSCOREPSNAKE.CLP 开始新游戏
这里是为了能够直接1条命令运行游戏 (CALL WITTGAMES/PSNAKE)
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: START A NEW SNAKE GAME */
/* DATE WRITTEN: 2024-08-14 */
/**********************************************************************/
PGM
CALL PGM(WITTGAMES/PSETENV)
CALL PGM(*LIBL/PSNAKEMAIN)
END: ENDPGMPSETENV.CLP 设置游戏运行环境
这里将存放游戏的库(WITTGAMES)加到库列表最后面，这样相关的程序/文件就可以被访问到
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: SETUP ENVIRONMENT */
/* DATE WRITTEN: 2024-08-09 */
/**********************************************************************/
PGM
MONMSG MSGID(CPF2104)
RMVLIBLE LIB(WITTGAMES )
ADDLIBLE LIB(WITTGAMES ) POSITION(*LAST)
END: ENDPGMPSNAKEMAIN.CBL 游戏主程序
1. 蛇的移动(MOVE-SNAKE)实现方法为把蛇头画到屏幕并把蛇尾从屏幕擦除，
整条蛇的坐标数据结构是一个先进(画到屏幕)先出(从屏幕擦除)的队列
2. 蛇队列的维护
蛇队列是由数组实现的(WK-SNAKEQUEUE)，它的每个元素是一个坐标(行，列)
出队(SNAKEQUEUE-DEQUEUE)操作之后，数组前面出队的元素存储空间就闲置下来，而入队(SNAKEQUEUE-ENQUEUE)操作则会写入新的元素到数组中。在蛇的移动过程中会不断的做蛇头入队，蛇尾出队，这样最终会造成数组右侧下标越界而左侧却有很多闲置空间。
所以需要在数组最右侧存储空间被写入之后做一次维护(SNAKEQUEUE-REARRANGE)，方法是把整条蛇从数组的右边移动到左边，重新利用起数组左侧的闲置空间
整个数组长度为蛇的最大长度 15 * 40 = 600
3. 生成随机数的方法
生成食物时需要生成食物行列坐标的随机数
以生成行坐标为例: 除去边框剩余的2 - 16行可以放置食物，所以行坐标为2 - 16之间的随机数，生成方法(GENERATE-RANDOM-NUMBER)为系统时间对15求余之后再加2
IDENTIFICATION DIVISION.
*****************************************************************
* AUTHOR: WITT *
* DESCRIPTION: SNAKE MAIN PROGRAM *
* DATE WRITTEN: 2024-08-19 *
*****************************************************************
PROGRAM-ID. PSNAKEMAIN.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SSNAKE-FILE
ASSIGN TO WORKSTATION-SSNAKE-SI
ORGANIZATION IS TRANSACTION
FILE STATUS IS WK-SSNAKE-STATUS
CONTROL-AREA IS WK-TRANS-CTRL-AREA.
DATA DIVISION.
FILE SECTION.
FD SSNAKE-FILE
LABEL RECORDS ARE OMITTED
DATA RECORD IS SSNAKE-REC.
01 SSNAKE-REC.
COPY DD-ALL-FORMATS-I-O OF SSNAKE.
WORKING-STORAGE SECTION.
77 WK-CONST-MAX-LINE PIC 9(2) VALUE 15.
77 WK-CONST-MAX-COLN PIC 9(2) VALUE 40.
77 WK-SNAKEQ-FRONT-POINTER PIC 9(3) VALUE 1.
77 WK-SNAKEQ-REAR-POINTER PIC 9(3) VALUE 0.
77 WK-SYSTIME PIC 9(8).
77 WK-RANDOM-NUMBER-RANGE PIC 9(2).
77 WK-RANDOM-NUMBER PIC 9(2).
77 WK-QUOTIENT PIC 9(7).
77 WK-OFFSET PIC 9(3) VALUE 0.
77 WK-DEPA-POINTER PIC 9(3) VALUE 0.
77 WK-DEST-POINTER PIC 9(3) VALUE 0.
77 WK-SLEEP-DURATION PIC 9(3) VALUE 800.
77 WK-LINE-IDX PIC 9(2).
01 WK-SAVED-COORDINATE.
05 WK-SKHEAD-LINE PIC 9(2).
05 WK-SKHEAD-COLN PIC 9(2).
05 WK-SKTAIL-LINE PIC 9(2).
05 WK-SKTAIL-COLN PIC 9(2).
05 WK-FOOD-LINE PIC 9(2).
05 WK-FOOD-COLN PIC 9(2).
01 WK-FILE-STATUS.
05 WK-SSNAKE-STATUS PIC X(2).
01 WK-TRANS-CTRL-AREA.
05 WK-FUNCTION-KEY PIC X(2).
88 WK-FKEY-F1 VALUE "01".
88 WK-FKEY-F2 VALUE "02".
88 WK-FKEY-F3 VALUE "03".
88 WK-FKEY-F5 VALUE "05".
88 WK-FKEY-F9 VALUE "09".
88 WK-FKEY-F10 VALUE "10".
88 WK-FKEY-F11 VALUE "11".
88 WK-FKEY-F12 VALUE "12".
01 WK-SCREEN-ARRAY.
05 WK-MAP-LINE OCCURS 20 TIMES.
15 WK-MAP-NODE PIC X(1) OCCURS 42 TIMES.
01 WK-SNAKEQUEUE.
05 WK-SNAKE-COORDINATE OCCURS 600 TIMES.
15 WK-SNAKEQ-LINE PIC 9(2).
15 WK-SNAKEQ-COLN PIC 9(2).
01 WK-MOVE-DIRECTION PIC X(1).
88 WK-MOVE-RIGHT VALUE "R".
88 WK-MOVE-LEFT VALUE "L".
88 WK-MOVE-UP VALUE "U".
88 WK-MOVE-DOWN VALUE "D".
01 WK-GAME-STATUS PIC X(1).
88 WK-NEWGAME VALUE "N".
88 WK-GAMEOVER VALUE "O".
01 WK-WINGAMOVR-O.
05 WK-CURR-ROUND-SCORE PIC 9(3) VALUE 0.
05 WK-RANKING-TABLE.
10 WK-RANKING-TABLE-REC OCCURS 3 TIMES.
15 WK-RANKING-RANK PIC 9(4) VALUE 0.
15 WK-RANKING-NAME PIC X(14) VALUE SPACES.
15 WK-RANKING-SCORE PIC 9(3) VALUE 0.
15 WK-RANKING-DATE PIC X(8) VALUE SPACES.
01 WK-END-LOOP-FLG PIC X(1).
88 WK-END-LOOP VALUE "Y".
01 WK-CATCH-FOOD-FLG PIC X(1).
88 WK-CATCH-FOOD VALUE "Y".
LINKAGE SECTION.
PROCEDURE DIVISION.
MAIN-PROC.
PERFORM 200-NEWGAME-INIT
THRU 200-NEWGAME-INIT-X.
MOVE SPACE TO WK-FUNCTION-KEY.
PERFORM 400-LOOP-GAME
THRU 400-LOOP-GAME-X
UNTIL WK-FKEY-F3.
MAIN-PROC-X.
GOBACK.
200-NEWGAME-INIT.
SET WK-NEWGAME TO TRUE.
MOVE SPACE TO WK-CATCH-FOOD-FLG.
COMPUTE WK-CURR-ROUND-SCORE = 0.
PERFORM SNAKEQUEUE-INIT
THRU SNAKEQUEUE-INIT-X.
PERFORM SCREEN-INIT
THRU SCREEN-INIT-X.
PERFORM DRAW-SNAKEHEAD-TO-SCREEN
THRU DRAW-SNAKEHEAD-TO-SCREEN-X.
PERFORM GENERATE-FOOD
THRU GENERATE-FOOD-X.
200-NEWGAME-INIT-X.
EXIT.
400-LOOP-GAME.
PERFORM REFRESH-SCREEN
THRU REFRESH-SCREEN-X.
PERFORM HANDLE-FKEY
THRU HANDLE-FKEY-X.
IF WK-FKEY-F3
GO TO 400-LOOP-GAME-X
END-IF.
PERFORM MOVE-SNAKE
THRU MOVE-SNAKE-X.
IF WK-GAMEOVER
PERFORM GAME-OVER
THRU GAME-OVER-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 WK-FKEY-F11
AND WK-SLEEP-DURATION > 100
SUBTRACT 100 FROM WK-SLEEP-DURATION
END-IF.
IF WK-FKEY-F12
AND WK-SLEEP-DURATION < 900
ADD 100 TO WK-SLEEP-DURATION
END-IF.
UPD-MOVE-SPEED-X.
EXIT.
UPD-MOVE-DIRECTION.
EVALUATE TRUE
WHEN WK-FKEY-F1
IF NOT WK-MOVE-DOWN
SET WK-MOVE-UP TO TRUE
END-IF
WHEN WK-FKEY-F2
IF NOT WK-MOVE-UP
SET WK-MOVE-DOWN TO TRUE
END-IF
WHEN WK-FKEY-F9
IF NOT WK-MOVE-RIGHT
SET WK-MOVE-LEFT TO TRUE
END-IF
WHEN WK-FKEY-F10
IF NOT WK-MOVE-LEFT
SET WK-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 WK-GAMEOVER
GO TO MOVE-SNAKE-X
END-IF.
PERFORM DRAW-SNAKEHEAD-TO-SCREEN
THRU DRAW-SNAKEHEAD-TO-SCREEN-X.
PERFORM ERASE-SNAKETAIL-FROM-SCREEN
THRU ERASE-SNAKETAIL-FROM-SCREEN-X.
MOVE-SNAKE-X.
EXIT.
UPD-SNAKEHEAD-COORDINATE.
EVALUATE TRUE
WHEN WK-MOVE-RIGHT
ADD 1 TO WK-SKHEAD-COLN
WHEN WK-MOVE-LEFT
SUBTRACT 1 FROM WK-SKHEAD-COLN
WHEN WK-MOVE-UP
SUBTRACT 1 FROM WK-SKHEAD-LINE
WHEN WK-MOVE-DOWN
ADD 1 TO WK-SKHEAD-LINE
WHEN OTHER
CONTINUE
END-EVALUATE.
UPD-SNAKEHEAD-COORDINATE-X.
EXIT.
CATCH-FOOD.
IF WK-SKHEAD-LINE NOT = WK-FOOD-LINE
OR WK-SKHEAD-COLN NOT = WK-FOOD-COLN
GO TO CATCH-FOOD-X
END-IF.
ADD 1 TO WK-CURR-ROUND-SCORE.
SET WK-CATCH-FOOD TO TRUE.
PERFORM GENERATE-FOOD
THRU GENERATE-FOOD-X.
CATCH-FOOD-X.
EXIT.
UPD-GAME-STATUS.
IF WK-MAP-NODE(WK-SKHEAD-LINE, WK-SKHEAD-COLN) NOT = SPACE
AND NOT WK-CATCH-FOOD
SET WK-GAMEOVER TO TRUE
END-IF.
UPD-GAME-STATUS-X.
EXIT.
DRAW-SNAKEHEAD-TO-SCREEN.
MOVE "*" TO
WK-MAP-NODE(WK-SKHEAD-LINE, WK-SKHEAD-COLN).
PERFORM SNAKEQUEUE-ENQUEUE
THRU SNAKEQUEUE-ENQUEUE-X.
DRAW-SNAKEHEAD-TO-SCREEN-X.
EXIT.
ERASE-SNAKETAIL-FROM-SCREEN.
IF WK-CATCH-FOOD
MOVE SPACE TO WK-CATCH-FOOD-FLG
GO TO ERASE-SNAKETAIL-FROM-SCREEN-X
END-IF.
MOVE SPACE TO
WK-MAP-NODE(WK-SKTAIL-LINE, WK-SKTAIL-COLN).
PERFORM SNAKEQUEUE-DEQUEUE
THRU SNAKEQUEUE-DEQUEUE-X.
ERASE-SNAKETAIL-FROM-SCREEN-X.
EXIT.
GAME-OVER.
PERFORM UPD-FRANKING
THRU UPD-FRANKING-X.
PERFORM QRY-FRANKING
THRU QRY-FRANKING-X.
PERFORM POP-GAMEOVER-WINDOW
THRU POP-GAMEOVER-WINDOW-X.
IF WK-FKEY-F5
PERFORM 200-NEWGAME-INIT
THRU 200-NEWGAME-INIT-X
END-IF.
GAME-OVER-X.
EXIT.
SNAKEQUEUE-INIT.
COMPUTE WK-SNAKEQ-FRONT-POINTER = 1.
COMPUTE WK-SNAKEQ-REAR-POINTER = 0.
SNAKEQUEUE-INIT-X.
EXIT.
SNAKEQUEUE-ENQUEUE.
ADD 1 TO WK-SNAKEQ-REAR-POINTER.
COMPUTE WK-SNAKEQ-LINE(WK-SNAKEQ-REAR-POINTER) =
WK-SKHEAD-LINE.
COMPUTE WK-SNAKEQ-COLN(WK-SNAKEQ-REAR-POINTER) =
WK-SKHEAD-COLN.
IF WK-SNAKEQ-REAR-POINTER >= 600
PERFORM SNAKEQUEUE-REARRANGE
THRU SNAKEQUEUE-REARRANGE-X
END-IF.
SNAKEQUEUE-ENQUEUE-X.
EXIT.
SNAKEQUEUE-DEQUEUE.
IF WK-SNAKEQ-FRONT-POINTER > WK-SNAKEQ-REAR-POINTER
GO TO SNAKEQUEUE-DEQUEUE-X
END-IF.
ADD 1 TO WK-SNAKEQ-FRONT-POINTER.
COMPUTE WK-SKTAIL-LINE =
WK-SNAKEQ-LINE(WK-SNAKEQ-FRONT-POINTER)
COMPUTE WK-SKTAIL-COLN =
WK-SNAKEQ-COLN(WK-SNAKEQ-FRONT-POINTER).
SNAKEQUEUE-DEQUEUE-X.
EXIT.
SNAKEQUEUE-REARRANGE.
COMPUTE WK-OFFSET = WK-SNAKEQ-FRONT-POINTER - 1.
IF WK-OFFSET <= 0
GO TO SNAKEQUEUE-REARRANGE-X
END-IF.
PERFORM
VARYING WK-DEPA-POINTER FROM WK-SNAKEQ-FRONT-POINTER BY 1
UNTIL WK-DEPA-POINTER > WK-SNAKEQ-REAR-POINTER
COMPUTE WK-DEST-POINTER = WK-DEPA-POINTER - WK-OFFSET
COMPUTE WK-SNAKEQ-LINE(WK-DEST-POINTER) =
WK-SNAKEQ-LINE(WK-DEPA-POINTER)
COMPUTE WK-SNAKEQ-COLN(WK-DEST-POINTER) =
WK-SNAKEQ-COLN(WK-DEPA-POINTER)
END-PERFORM.
COMPUTE WK-SNAKEQ-FRONT-POINTER = 1.
COMPUTE WK-SNAKEQ-REAR-POINTER = WK-DEST-POINTER.
SNAKEQUEUE-REARRANGE-X.
EXIT.
GENERATE-FOOD.
MOVE SPACE TO WK-END-LOOP-FLG.
PERFORM LOOP-UPD-FOOD-COORDINATE
THRU LOOP-UPD-FOOD-COORDINATE-X
UNTIL WK-END-LOOP.
MOVE "*" TO WK-MAP-NODE(WK-FOOD-LINE, WK-FOOD-COLN).
GENERATE-FOOD-X.
EXIT.
LOOP-UPD-FOOD-COORDINATE.
COMPUTE WK-RANDOM-NUMBER-RANGE = WK-CONST-MAX-LINE.
PERFORM GENERATE-RANDOM-NUMBER
THRU GENERATE-RANDOM-NUMBER-X.
COMPUTE WK-FOOD-LINE = WK-RANDOM-NUMBER + 2.
COMPUTE WK-RANDOM-NUMBER-RANGE = WK-CONST-MAX-COLN.
PERFORM GENERATE-RANDOM-NUMBER
THRU GENERATE-RANDOM-NUMBER-X.
COMPUTE WK-FOOD-COLN = WK-RANDOM-NUMBER + 2.
IF WK-MAP-NODE(WK-FOOD-LINE, WK-FOOD-COLN) = SPACE
SET WK-END-LOOP TO TRUE
END-IF.
LOOP-UPD-FOOD-COORDINATE-X.
EXIT.
GENERATE-RANDOM-NUMBER.
ACCEPT WK-SYSTIME FROM TIME.
DIVIDE WK-SYSTIME BY WK-RANDOM-NUMBER-RANGE
GIVING WK-QUOTIENT REMAINDER WK-RANDOM-NUMBER END-DIVIDE.
GENERATE-RANDOM-NUMBER-X.
EXIT.
UPD-FRANKING.
CALL "PUPDRANK" USING WK-CURR-ROUND-SCORE.
CANCEL "PUPDRANK".
UPD-FRANKING-X.
EXIT.
QRY-FRANKING.
CALL "PQRYRANK" USING WK-RANKING-TABLE.
CANCEL "PQRYRANK".
QRY-FRANKING-X.
EXIT.
REFRESH-SCREEN.
MOVE SPACE TO WK-FUNCTION-KEY.
CALL "PREFSCREEN" USING WK-FUNCTION-KEY
WK-SLEEP-DURATION
WK-MAP-LINE(1)
WK-MAP-LINE(2)
WK-MAP-LINE(3)
WK-MAP-LINE(4)
WK-MAP-LINE(5)
WK-MAP-LINE(6)
WK-MAP-LINE(7)
WK-MAP-LINE(8)
WK-MAP-LINE(9)
WK-MAP-LINE(10)
WK-MAP-LINE(11)
WK-MAP-LINE(12)
WK-MAP-LINE(13)
WK-MAP-LINE(14)
WK-MAP-LINE(15)
WK-MAP-LINE(16)
WK-MAP-LINE(17)
WK-MAP-LINE(18)
WK-MAP-LINE(19)
WK-MAP-LINE(20).
CANCEL "PREFSCREEN".
REFRESH-SCREEN-X.
EXIT.
POP-GAMEOVER-WINDOW.
OPEN I-O SSNAKE-FILE.
WRITE SSNAKE-REC FROM WK-SCREEN-ARRAY FORMAT "HEADER".
WRITE SSNAKE-REC FROM WK-WINGAMOVR-O FORMAT "WINGAMOVR".
READ SSNAKE-FILE FORMAT "WINGAMOVR".
CLOSE SSNAKE-FILE.
POP-GAMEOVER-WINDOW-X.
EXIT.
SCREEN-INIT.
INITIALIZE WK-SCREEN-ARRAY.
PERFORM DRAW-SCREEN-BORDER
THRU DRAW-SCREEN-BORDER-X.
INITIALIZE WK-SAVED-COORDINATE REPLACING NUMERIC BY 2.
SET WK-MOVE-RIGHT TO TRUE.
SCREEN-INIT-X.
EXIT.
DRAW-SCREEN-BORDER.
MOVE ALL "=" TO WK-MAP-LINE(1)(2:40).
MOVE ALL "=" TO WK-MAP-LINE(17).
MOVE ALL "=" TO WK-MAP-LINE(20)(2:40).
PERFORM VARYING WK-LINE-IDX FROM 2 BY 1
UNTIL WK-LINE-IDX > 19
MOVE "|" TO WK-MAP-NODE(WK-LINE-IDX , 1)
MOVE "|" TO WK-MAP-NODE(WK-LINE-IDX , 42)
END-PERFORM.
MOVE "F1-UP F9-LEFT F3-QUIT F11-FASTER"
TO WK-MAP-LINE(18)(3:38).
MOVE "F2-DOWN F10-RIGHT F5-RESUME F12-SLOWER"
TO WK-MAP-LINE(19)(3:38).
DRAW-SCREEN-BORDER-X.
EXIT.PREFSCREEN.RPGLE 自动刷新屏幕
自动刷新屏幕是基于RPGLE程序读取DSPF超时来实现的，这里可以参考下面这篇文章
AS400 RPGLE 利用DSPF读取超时实现屏幕自动刷新-CSDN博客
当用COBOL读取DSPF时，即便设置了DSPF读取时限，程序依然会停在READ语句那里持续等待玩家输入(这个问题目前还不太会解决)，所以这里写了RPGLE子程序来做屏幕的自动刷新
值得一提的是单纯依靠DSPF WAITRCD属性是不好的，因为WAITRCD只支持设置为整数秒，设置为1秒的话蛇的移动很慢，设置为0秒的话玩家又根本来不及去按键。这里的做法是将WAITRCD设为0秒然后在一段时间之内(SLEEPDUR)循环读取玩家的按键，通过改变循环时间(SLEEPDUR)来改变屏幕刷新速度，也就是蛇的移动速度
**********************************************************************
* AUTHOR: WITT *
* DESCRIPTION: REFRESH SNAKE SCREEN *
* DATE WRITTEN: 2024-08-20 *
**********************************************************************
FSSNAKE CF E WORKSTN MAXDEV(*FILE)
F USROPN
DSYSTIME S Z
DTIMESTMP S 7A
DTIMESTMPNUM S 7S 0
DTIMERSTART S 7S 0
DTIMERDUR S 7S 0
DSLEEPDURNUM S 3S 0
DFKEYPRESSED S N
C *ENTRY PLIST
C PARM FKEY 2
C PARM SLEEPDUR 3
C PARM SCRLINE1 42
C PARM SCRLINE2 42
C PARM SCRLINE3 42
C PARM SCRLINE4 42
C PARM SCRLINE5 42
C PARM SCRLINE6 42
C PARM SCRLINE7 42
C PARM SCRLINE8 42
C PARM SCRLINE9 42
C PARM SCRLINE10 42
C PARM SCRLINE11 42
C PARM SCRLINE12 42
C PARM SCRLINE13 42
C PARM SCRLINE14 42
C PARM SCRLINE15 42
C PARM SCRLINE16 42
C PARM SCRLINE17 42
C PARM SCRLINE18 42
C PARM SCRLINE19 42
C PARM SCRLINE20 42
C
C EVAL QCMD = 'OVRDSPF FILE(SSNAKE) WAITRCD(*IMMED)'
C CALL 'QCMDEXC' QCMDEXC
C OPEN SSNAKE
C EXSR LOADSCRDATA
C EXSR REFSCREEN
C CLOSE SSNAKE
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 SCRLINE1 MAPLINE1
C MOVE SCRLINE2 MAPLINE2
C MOVE SCRLINE3 MAPLINE3
C MOVE SCRLINE4 MAPLINE4
C MOVE SCRLINE5 MAPLINE5
C MOVE SCRLINE6 MAPLINE6
C MOVE SCRLINE7 MAPLINE7
C MOVE SCRLINE8 MAPLINE8
C MOVE SCRLINE9 MAPLINE9
C MOVE SCRLINE10 MAPLINE10
C MOVE SCRLINE11 MAPLINE11
C MOVE SCRLINE12 MAPLINE12
C MOVE SCRLINE13 MAPLINE13
C MOVE SCRLINE14 MAPLINE14
C MOVE SCRLINE15 MAPLINE15
C MOVE SCRLINE16 MAPLINE16
C MOVE SCRLINE17 MAPLINE17
C MOVE SCRLINE18 MAPLINE18
C MOVE SCRLINE19 MAPLINE19
C MOVE SCRLINE20 MAPLINE20
C ENDSR
C
C REFSCREEN BEGSR
C EVAL TIMERDUR = 0
C MOVE SLEEPDUR SLEEPDURNUM
C EXSR GETTIMESTMP
C MOVE TIMESTMP TIMERSTART
C WRITE HEADER
C
C DOW TIMERDUR < SLEEPDURNUM
C READ SSNAKE 9699
C IF NOT FKEYPRESSED
C EXSR SETFKEY
C ENDIF
C EXSR REFTIMERDUR
C ENDDO
C
C ENDSR
C
C SETFKEY BEGSR
C MOVE *OFF FKEYPRESSED
C
C IF *IN01
C EVAL FKEY = '01'
C MOVE *ON FKEYPRESSED
C ENDIF
C
C IF *IN02
C EVAL FKEY = '02'
C MOVE *ON FKEYPRESSED
C ENDIF
C
C IF *IN03
C EVAL FKEY = '03'
C MOVE *ON FKEYPRESSED
C ENDIF
C
C IF *IN05
C EVAL FKEY = '05'
C MOVE *ON FKEYPRESSED
C ENDIF
C
C IF *IN09
C EVAL FKEY = '09'
C MOVE *ON FKEYPRESSED
C ENDIF
C
C IF *IN10
C EVAL FKEY = '10'
C MOVE *ON FKEYPRESSED
C ENDIF
C
C IF *IN11
C EVAL FKEY = '11'
C MOVE *ON FKEYPRESSED
C ENDIF
C
C IF *IN12
C EVAL FKEY = '12'
C MOVE *ON FKEYPRESSED
C ENDIF
C
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 REFTIMERDUR BEGSR
C EXSR GETTIMESTMP
C MOVE TIMESTMP TIMESTMPNUM
C EVAL TIMERDUR = TIMESTMPNUM - TIMERSTART
C ENDSR
CPUPDRANK.CBL 更新排行榜文件
IDENTIFICATION DIVISION.
*****************************************************************
* AUTHOR: WITT *
* DESCRIPTION: UPDATE FRANKING *
* DATE WRITTEN: 2024-08-19 *
*****************************************************************
PROGRAM-ID. PUPDRANK.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FRANKING
ASSIGN TO DATABASE-FRANKING
ACCESS MODE IS DYNAMIC
ORGANIZATION IS INDEXED
FILE STATUS IS WK-FRANKING-STATUS
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
WITH DUPLICATES.
DATA DIVISION.
FILE SECTION.
FD FRANKING
LABEL RECORDS ARE STANDARD.
01 FRANKING-REC.
COPY DDS-ALL-FORMATS OF FRANKING.
WORKING-STORAGE SECTION.
77 WK-SYS-TIME PIC X(8) VALUE SPACES.
77 WK-CONST-MAX-LINE PIC 9(2) VALUE 15.
77 WK-CONST-MAX-COLN PIC 9(2) VALUE 40.
77 WK-MAX-SCORE PIC 9(4).
01 WK-SYS-DATE.
05 WK-SYS-DATE-CC PIC X(2) VALUE "20".
05 WK-SYS-DATE-YYMMDD PIC X(6) VALUE SPACES.
01 WK-FILE-STATUS.
05 WK-FRANKING-STATUS PIC X(2) VALUE SPACES.
01 WK-END-LOOP-FLG PIC X(1) VALUE SPACE.
88 WK-END-LOOP VALUE "Y".
LINKAGE SECTION.
01 LINK-CURR-ROUND-SCORE PIC 9(3).
PROCEDURE DIVISION USING LINK-CURR-ROUND-SCORE.
MAIN-PROC.
PERFORM 000-INIT
THRU 000-INIT-X.
PERFORM 400-UPD-FRANKING
THRU 400-UPD-FRANKING-X.
PERFORM 600-CHK-SCORE-999
THRU 600-CHK-SCORE-999-X.
PERFORM 900-END
THRU 900-END-X.
MAIN-PROC-X.
GOBACK.
000-INIT.
OPEN I-O FRANKING.
ACCEPT WK-SYS-DATE-YYMMDD FROM DATE.
ACCEPT WK-SYS-TIME FROM TIME.
000-INIT-X.
EXIT.
400-UPD-FRANKING.
COMPUTE WK-MAX-SCORE = WK-CONST-MAX-LINE * WK-CONST-MAX-COLN.
IF LINK-CURR-ROUND-SCORE > WK-MAX-SCORE
GO TO 400-UPD-FRANKING-X
END-IF.
INITIALIZE FRANKING-REC.
CALL "PGETUSERID" USING RKPLAYER.
IF RKPLAYER = SPACE
MOVE "NOBODY" TO RKPLAYER
END-IF.
COMPUTE RKSCORE = LINK-CURR-ROUND-SCORE.
PERFORM WRITE-FRANKING
THRU WRITE-FRANKING-X.
400-UPD-FRANKING-X.
EXIT.
600-CHK-SCORE-999.
INITIALIZE FRANKING-REC.
COMPUTE RKSCORE = 999.
READ FRANKING INVALID KEY CONTINUE END-READ.
IF WK-FRANKING-STATUS = ZEROS
GO TO 600-CHK-SCORE-999-X
END-IF.
MOVE "SYSTEM" TO RKPLAYER.
PERFORM WRITE-FRANKING
THRU WRITE-FRANKING-X.
600-CHK-SCORE-999-X.
EXIT.
900-END.
CLOSE FRANKING.
900-END-X.
EXIT.
WRITE-FRANKING.
MOVE WK-SYS-DATE TO RKDTE.
MOVE WK-SYS-TIME TO RKTIME.
COMPUTE RKVIDEOLNK = 0.
WRITE FRANKING-REC INVALID KEY CONTINUE END-WRITE.
WRITE-FRANKING-X.
EXIT.PGETUSERID.CLP 获取玩家ID
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: GET USER ID */
/* DATE WRITTEN: 2024-08-14 */
/**********************************************************************/
PGM PARM(&USERID)
DCL VAR(&USERID) TYPE(*CHAR) LEN(14) VALUE(' ')
RTVJOBA USER(&USERID)
END: ENDPGMPQRYRANK.CBL 查询排行榜文件
IDENTIFICATION DIVISION.
*****************************************************************
* AUTHOR: WITT *
* DESCRIPTION: QUREY FRANKING *
* DATE WRITTEN: 2024-08-16 *
*****************************************************************
PROGRAM-ID. PQRYRANK.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FRANKING
ASSIGN TO DATABASE-FRANKING
ACCESS MODE IS DYNAMIC
ORGANIZATION IS INDEXED
FILE STATUS IS WK-FRANKING-STATUS
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
WITH DUPLICATES.
DATA DIVISION.
FILE SECTION.
FD FRANKING
LABEL RECORDS ARE STANDARD.
01 FRANKING-REC.
COPY DDS-ALL-FORMATS OF FRANKING.
WORKING-STORAGE SECTION.
77 WK-TABLE-IDX PIC 9(4) VALUE 0.
01 WK-FILE-STATUS.
05 WK-FRANKING-STATUS PIC X(2) VALUE SPACES.
01 WK-END-LOOP-FLG PIC X(1) VALUE SPACE.
88 WK-END-LOOP VALUE "Y".
LINKAGE SECTION.
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-RANKING-TABLE.
MAIN-PROC.
PERFORM 000-INIT
THRU 000-INIT-X.
PERFORM 400-QRY-FRANKING
THRU 400-QRY-FRANKING-X.
PERFORM 900-END
THRU 900-END-X.
MAIN-PROC-X.
GOBACK.
000-INIT.
INITIALIZE LINK-RANKING-TABLE.
OPEN INPUT FRANKING.
000-INIT-X.
EXIT.
400-QRY-FRANKING.
PERFORM START-FRANKING-TO-LAST-REC
THRU START-FRANKING-TO-LAST-REC-X.
MOVE SPACE TO WK-END-LOOP-FLG.
COMPUTE WK-TABLE-IDX = 0.
PERFORM LOOP-FRANKING
THRU LOOP-FRANKING-X
UNTIL WK-END-LOOP.
400-QRY-FRANKING-X.
EXIT.
900-END.
CLOSE FRANKING.
900-END-X.
EXIT.
START-FRANKING-TO-LAST-REC.
COMPUTE RKSCORE = 999.
START FRANKING
KEY IS NOT LESS THAN EXTERNALLY-DESCRIBED-KEY
INVALID KEY CONTINUE
END-START.
START-FRANKING-TO-LAST-REC-X.
EXIT.
LOOP-FRANKING.
IF WK-TABLE-IDX >= 3
SET WK-END-LOOP TO TRUE
GO TO LOOP-FRANKING-X
END-IF.
ADD 1 TO WK-TABLE-IDX.
READ FRANKING PRIOR AT END CONTINUE END-READ.
IF WK-FRANKING-STATUS NOT = ZEROS
SET WK-END-LOOP TO TRUE
GO TO LOOP-FRANKING-X
END-IF.
COMPUTE LINK-RANKING-RANK(WK-TABLE-IDX) = WK-TABLE-IDX.
MOVE RKPLAYER TO LINK-RANKING-NAME(WK-TABLE-IDX).
COMPUTE LINK-RANKING-SCORE(WK-TABLE-IDX) = RKSCORE.
MOVE RKDTE TO LINK-RANKING-DATE(WK-TABLE-IDX).
LOOP-FRANKING-X.
EXIT.非功能性源码
非功能性源码对贪吃蛇游戏特性没有影响，但是对增量开发有帮助
(时时常拂拭，莫使惹尘埃 —— 《Clean Code》Robert C. Martin)
如果需要重构代码，可以使用其中的PCOMPILE程序来重编译所有的源文件，用PSAVPKG来将当前版本中的全部对象打包备份到SAVF文件里面
PCOMPILE.CLP 编译源文件
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: COMPILE SNAKE SOURCE */
/* DATE WRITTEN: 2024-08-15 */
/**********************************************************************/
PGM
CRTCBLPGM PGM(WITTGAMES/PSNAKEMAIN) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PSNAKEMAIN)
CRTCBLPGM PGM(WITTGAMES/PUPDRANK) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PUPDRANK)
CRTCBLPGM PGM(WITTGAMES/PQRYRANK) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PQRYRANK)
CRTBNDRPG PGM(WITTGAMES/PREFSCREEN) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PREFSCREEN)
CRTCLPGM PGM(WITTGAMES/PCOMPILE) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PCOMPILE)
CRTCLPGM PGM(WITTGAMES/PGETUSERID) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PGETUSERID)
CRTCLPGM PGM(WITTGAMES/PGRTAUT) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PGRTAUT)
CRTCLPGM PGM(WITTGAMES/PRSTPKG) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PRSTPKG)
CRTCLPGM PGM(WITTGAMES/PSAVPKG) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PSAVPKG)
CRTCLPGM PGM(WITTGAMES/PSETENV) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PSETENV)
CRTCLPGM PGM(WITTGAMES/PSNAKE) SRCFILE(WITTGAMES/SNAKESRC) -
SRCMBR(PSNAKE)
END: ENDPGMPSAVPKG.CLP 打包备份全部对象
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: BKP&RST - SAVE OBJ INTO WITTGAMPKG/SNAKEPKG */
/* DATE WRITTEN: 2024-08-15 */
/**********************************************************************/
PGM
CLRSAVF FILE(WITTGAMPKG/SNAKEPKG)
SAVOBJ OBJ(*ALL) LIB(WITTGAMES) DEV(*SAVF) -
SAVF(WITTGAMPKG/SNAKEPKG)
END: ENDPGMPRSTPKG.CLP 从备份中恢复全部对象
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: BKP&RST - RESTORE OBJ FROM WITTGAMPKG/SNAKEPKG */
/* DATE WRITTEN: 2024-08-15 */
/**********************************************************************/
PGM PARM(&RSTLIB)
DCL VAR(&RSTLIB) TYPE(*CHAR) LEN(10)
MONMSG MSGID(CPF2111)
MONMSG MSGID(CPF2125)
MONMSG MSGID(CPF2104)
CRTLIB LIB(&RSTLIB) TYPE(*TEST) TEXT(GAMES)
RSTOBJ OBJ(*ALL) SAVLIB(WITTGAMES) DEV(*SAVF) -
SAVF(WITTGAMPKG/SNAKEPKG) RSTLIB(&RSTLIB)
END: ENDPGMPGRTAUT.CLP 赋权限给玩家
这里给玩家赋予了排行榜文件(FRANKING)的*ALL权限，因为每轮游戏结束要将当轮的游戏结果写入到排行榜文件中，如果玩家ID没有对排行榜文件的写入权限，程序(PUPDRANK)的写入操作则会执行失败
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: GRANT AUTHORITY TO PLAYERS */
/* DATE WRITTEN: 2024-08-09 */
/**********************************************************************/
PGM
GRTOBJAUT OBJ(WITTGAMES/*ALL) OBJTYPE(*ALL) -
USER(*PUBLIC) AUT(*USE)
GRTOBJAUT OBJ(WITTGAMES/FRANKING) OBJTYPE(*FILE) -
USER(*PUBLIC) AUT(*ALL)
GRTOBJAUT OBJ(WITTGAMPKG/*ALL) OBJTYPE(*ALL) -
USER(*PUBLIC) AUT(*USE)
END: ENDPGMPMERGE.CLP 将全部源文件合并到一个PF MEMBER中
/**********************************************************************/
/* AUTHOR: WITT */
/* DESCRIPTION: MERGE ALL SNAKE SRC INTO MERGEDSRC */
/* DATE WRITTEN: 2024-08-19 */
/**********************************************************************/
PGM
MONMSG CPF3142
CLRPFM FILE(WITTGAMES/MERGEDSRC) MBR(SNAKESRC)
CPYF FROMFILE(WITTGAMES/SNAKESRC) TOFILE(WITTGAMES/MERGEDSRC) -
FROMMBR(*ALL) TOMBR(SNAKESRC) MBROPT(*ADD) CRTFILE(*YES)
END: ENDPGM
扫一扫
195
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
