-
Notifications
You must be signed in to change notification settings - Fork 0
/
game.cbl
220 lines (204 loc) · 8.69 KB
/
game.cbl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
*================================================================*
IDENTIFICATION DIVISION.
*================================================================*
* Compile with param: cobc -xjd game.cbl -lraylib
PROGRAM-ID. PONG0001.
AUTHOR. RODRIGO DORNELLES.
INSTALLATION. PSYWAVE GAMES.
DATE-WRITTEN. 31/01/2021.
DATE-COMPILED. 31/01/2021.
*================================================================*
ENVIRONMENT DIVISION.
*================================================================*
CONFIGURATION SECTION.
REPOSITORY.
FUNCTION ALL INTRINSIC.
*================================================================*
DATA DIVISION.
*================================================================*
WORKING-STORAGE SECTION.
*----------------------------------------------------------------*
* GAME-VARIABLES
*----------------------------------------------------------------*
* R: RETURN
* W: WINDOW
* K: KEY
* C: COLOR
01 R-CODE USAGE BINARY-LONG.
01 R-KEY-UP PIC 9.
01 R-KEY-DOWN PIC 9.
01 R-KEY-ENTER PIC 9.
01 K-UP PIC 9(8) VALUE 265.
01 K-DOWN PIC 9(9) VALUE 264.
01 K-ESC PIC 9(8) VALUE 256.
01 K-ENTER PIC 9(8) VALUE 257.
78 K-PRESSED VALUE 7.
78 W-WIDTH VALUE 800.
78 W-HEIGHT VALUE 450.
78 W-NAME VALUE "PONG COBOL GAME".
78 W-GAMEOVER VALUE "GAMEOVER! PRESS ENTER TO RESTART".
01 W-FINISHED PIC 9 VALUE ZERO.
01 C-WHITE.
02 R PIC S9(3) VALUE 245 BINARY.
02 G PIC S9(3) VALUE 245 BINARY.
02 B PIC S9(3) VALUE 245 BINARY.
02 A PIC S9(3) VALUE 255 BINARY.
78 C-BLACK VALUE 0.
*----------------------------------------------------------------*
* PLAYER-VARIABLES
*----------------------------------------------------------------*
* P: PLAYER
78 P-WIDTH VALUE 16.
78 P-HEIGHT VALUE 80.
78 P-POSX VALUE 0.
78 P-SPEED VALUE 16.
77 P-POSY PIC 999V99.
*----------------------------------------------------------------*
* BALL-VARIABLES
*----------------------------------------------------------------*
* B: BALL
78 B-SIZE VALUE 16.
77 B-POSX PIC 9(3)V9.
77 B-POSY PIC 9(3)V9.
77 B-HSPEED PIC S9(2)V9.
77 B-VSPEED PIC S9(2)V9.
*================================================================*
PROCEDURE DIVISION.
*================================================================*
MAIN-PROCEDURE.
PERFORM INIT-WINDOW.
PERFORM GAME-INIT.
PERFORM GAME-LOOP.
PERFORM CLOSE-WINDOW.
GOBACK.
*----------------------------------------------------------------*
INIT-WINDOW SECTION.
CALL "InitWindow" USING
BY VALUE W-WIDTH W-HEIGHT
BY REFERENCE W-NAME RETURNING R-CODE
ON EXCEPTION
DISPLAY "exception error: raylib not found"
UPON SYSERR
END-DISPLAY
END-CALL
CALL "SetTargetFPS" USING BY VALUE 30
RETURNING OMITTED
END-CALL.
*----------------------------------------------------------------*
GAME-INIT SECTION.
MOVE 0 TO W-FINISHED
MOVE -5.0 TO B-HSPEED
MOVE 780 TO B-POSX
MOVE 225 TO B-POSY
PERFORM BALL-RANDOM.
*----------------------------------------------------------------*
GAME-LOOP SECTION.
PERFORM UNTIL K-ESC = 1
CALL "WindowShouldClose"
RETURNING K-ESC
END-CALL
IF R-KEY-ENTER = K-PRESSED THEN
PERFORM GAME-INIT
END-IF
PERFORM GAME-INPUT
PERFORM PLAYER-MOVE
PERFORM BALL-COLISION
PERFORM BALL-MOVE
PERFORM GAME-DRAW
END-PERFORM.
*----------------------------------------------------------------*
GAME-INPUT SECTION.
CALL "IsKeyDown" USING
BY VALUE K-UP
RETURNING R-KEY-UP
END-CALL
CALL "IsKeyDown" USING
BY VALUE K-DOWN
RETURNING R-KEY-DOWN
END-CALL
CALL "IsKeyDown" USING
BY VALUE K-ENTER
RETURNING R-KEY-ENTER
END-CALL.
*----------------------------------------------------------------*
GAME-DRAW SECTION.
CALL STATIC "BeginDrawing"
RETURNING OMITTED
END-CALL
CALL "ClearBackground" USING BY VALUE C-BLACK
RETURNING OMITTED
END-CALL
IF W-FINISHED <> 0 THEN
CALL static "DrawText" USING
BY REFERENCE W-GAMEOVER
BY VALUE 32 200 32
BY CONTENT C-WHITE
END-CALL
ELSE
PERFORM PLAYER-DRAW
PERFORM BALL-DRAW
END-IF
CALL STATIC "EndDrawing"
RETURNING OMITTED
END-CALL.
*----------------------------------------------------------------*
PLAYER-MOVE SECTION.
IF R-KEY-DOWN = K-PRESSED
AND SUM(P-POSY, P-HEIGHT, 1) < W-HEIGHT THEN
ADD P-SPEED TO P-POSY
ELSE
IF R-KEY-UP = K-PRESSED AND P-POSY > 1 THEN
SUBTRACT P-SPEED FROM P-POSY
END-IF.
*----------------------------------------------------------------*
PLAYER-DRAW SECTION.
CALL static "DrawRectangle" USING
BY VALUE P-POSX P-POSY
BY VALUE P-WIDTH P-HEIGHT
BY CONTENT C-WHITE
END-CALL.
*----------------------------------------------------------------*
BALL-RANDOM SECTION.
PERFORM WITH TEST AFTER UNTIL ABS (B-VSPEED) > 4
CALL "GetRandomValue" USING
BY VALUE -7
BY VALUE 7
RETURNING B-VSPEED
END-CALL
END-PERFORM.
*----------------------------------------------------------------*
BALL-MOVE SECTION.
ADD B-HSPEED TO B-POSX
ADD B-VSPEED TO B-POSY.
*----------------------------------------------------------------*
BALL-COLISION SECTION.
IF B-POSY <= B-SIZE/2
OR B-POSY >= W-HEIGHT - B-SIZE/2 THEN
MULTIPLY -1 BY B-VSPEED
END-IF
IF B-POSX >= W-WIDTH - B-SIZE/2 THEN
MULTIPLY -1 BY B-HSPEED
PERFORM BALL-RANDOM
END-IF
IF B-POSX <= P-WIDTH THEN
IF B-POSY > P-POSY
AND B-POSY < P-POSY + P-HEIGHT THEN
MULTIPLY -1.2 BY B-HSPEED
PERFORM BALL-RANDOM
PERFORM BALL-RANDOM
PERFORM BALL-RANDOM
ELSE
MOVE 1 TO W-FINISHED
END-IF
END-IF.
*----------------------------------------------------------------*
BALL-DRAW SECTION.
CALL static "DrawRectangle" USING
BY VALUE B-POSX B-POSY B-SIZE B-SIZE
BY CONTENT C-WHITE
END-CALL.
*----------------------------------------------------------------*
CLOSE-WINDOW SECTION.
CALL "CloseWindow"
RETURNING OMITTED
END-CALL.