[main page] [download] [links] [faq] [sample programs]


pong

My world-famous pong example implementation. It's fun to see it work on the emulator.

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
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
rem *********************************************************
rem
rem PONG - Classic pong game
rem
rem Author: Pieter-Bas IJdens
rem         spam@monad.freeserve.co.uk
rem         10 Feb 2001
rem
rem *********************************************************
rem
rem Legal stuff:
rem   This code is specifically copyright free and may be
rem   used by anyone for any purpose.
rem
rem *********************************************************

rem *********************************************************
rem GLOBALS
rem
rem PADS
rem   The number of pads. Usually a player would use
rem   up, down. In one-pad mode TRI, X control the
rem   right bat
rem
rem BAT_HEIGHT and BAT_WIDTH
rem   Dimensions of the bats. They are placed vertically
rem   so it is a good idea to make the height larger than
rem   the width.
rem
rem BAT_OFFSET
rem   Number of pixels the centre of each bat is away from
rem   the screen border in the horizontal direction.
rem   Note: By changing this number you can move the bats
rem         horizontally. You could even do this in the
rem         input loop.
rem
rem BAT_SPEED
rem   Number of units that the bats may move per input 
rem   cycle
rem
rem BALL_SPEED
rem   Number of units that the ball moves per input 
rem   cycle
rem
rem XSIZE, YSIZE
rem   Should be 640, 512 for PAL. If at some point of time
rem   an NTSC version of YaBasic is released, this should
rem   probably be changed to the proper resolution for NTSC.
rem
rem *********************************************************

PADS = 2
BAT_HEIGHT = 80
BAT_WIDTH = 8
BAT_SPEED = 10
BAT_OFFSET = 20
BALL_RADIUS = 6
BALL_SPEED = 11
XSIZE = 640
YSIZE = 512

rem *********************************************************
rem
rem Call the main loop
rem
rem *********************************************************
main()

rem *********************************************************
rem
rem Main program loop. In an infinite loop calls all updating
rem and input checking code.
rem
rem The 'cont' variable may be zet to zero to terminate the
rem program. This is something a more advanced implementation
rem could do.
rem
rem Note that the PADS global is checked here rather than in
rem the update_bast() function.
rem
rem *********************************************************
sub main()
  init()

  cont = 1

  wait_controller("Press any button to start.")

  while(cont = 1)
    draw_new_field()

    update_bat(left_bat(), "PORT1", 16, 64)
    if (PADS = 2) then
      update_bat(right_bat(), "PORT2", 16, 64)
    else
      update_bat(right_bat(), "PORT1", 4096, 16384)
    endif

    update_ball()

   pause 0.05
  wend
end sub

rem *********************************************************
rem
rem Called from the main loop to check the controller state
rem and update the position of the bat accordingly.
rem
rem Parameters:
rem - bat()
rem   Reference to a structure describing the position of a
rem   single bat.
rem - addr$
rem   Either "PORT1" for the left controller or "PORT2" for
rem   the right controller.
rem - up, down
rem   Specify the bitmask the controller's state value must
rem   match in order for the respective action to take place.
rem
rem Comments:
rem   The name 'maxstep' is maybe not clear enough here. It
rem   actually indicates the exact number of pixels the bat
rem   must move in order to hit the top or bottom wall in the
rem   specified direction. So, it is the maximum step that
rem   the bat can make without leaving the screen.
rem
rem *********************************************************
sub update_bat(bat(), addr$, up, down)
  local maxstep

  if (and(peek(addr$), down) > 0) then
    maxstep = YSIZE - (bat(2) + (bat(4) / 2))
    bat(2) = bat(2) + min(maxstep, BAT_SPEED)
  elsif (and(peek(addr$), up) > 0) then
    maxstep = bat(2) - (bat(4) / 2)
    bat(2) = bat(2) - min(maxstep, BAT_SPEED)
  endif
end sub

rem *********************************************************
rem
rem Extremely ugly function that takes care of the ball
rem movement and position checking.
rem
rem First the new position of the ball is calculated without
rem updating the old one. This is done because the rest of
rem the functions actually use the 'line' defined by the two
rem points to see what happened in this move.
rem
rem For example, for the bounce the intersection point of 
rem this line with the top or bottom border is calculated,
rem and the remainder of the line segment is mirrorred to
rem calculate the new position of the ball.
rem
rem *********************************************************
sub update_ball()
  b_newx = ball(1) + ball(5) * cos(ball(4))
  b_newy = ball(2) + ball(5) * sin(ball(4))
  b_newr = ball(3)
  b_newa = ball(4)
  b_news = ball(5)

  check_topbot_collission()
  check_bat_collission(left_bat())
  check_bat_collission(right_bat())
  check_leftright_collission()

  ball(1) = b_newx
  ball(2) = b_newy
  ball(3) = b_newr
  ball(4) = b_newa
  ball(5) = b_news
end sub

rem *********************************************************
rem
rem Checks if moving the ball would cause it to collide with
rem the top or bottom border of the screen. If that happens
rem then the ball is 'bounced' by this function.
rem
rem Note that 'r' must be used here. The ball will hit the
rem border if the centre is 'r' pixels away from the border.
rem
rem *********************************************************
sub check_topbot_collission()
  local r, y_toomuch

  r = ball(3)

  if (b_newy < r) then
    b_newy = r + (r - b_newy)
    b_newa = (2 * pi) - b_newa
    beep
  endif

  if (b_newy > (YSIZE - r)) then
    y_toomuch = r + (b_newy - YSIZE)
    b_newy = YSIZE - (y_toomuch + r)
    b_newa = (2 * pi) - b_newa
    beep
  endif
end sub

rem *********************************************************
rem
rem Checks if moving the ball would cause it to collide with
rem the left or right border of the screen. If that happens
rem then a point is loft, depending on which side was hit
rem and the game is resumed.
rem
rem Note that 'r' must be used here. The ball will hit the
rem border if the centre is 'r' pixels away from the border.
rem
rem *********************************************************
sub check_leftright_collission()
  local r, reinit

  r = b_newr
  reinit = 0

  if (b_newx < r) then
    score(2) = score(2) + 2
    reinit = 1
    beep
  elsif (b_newx > (XSIZE - r)) then
    score(1) = score(1) + 1
    reinit = 1
    beep
  endif

  if (reinit = 1) then
    b_newx = XSIZE / 2
    b_newy = YSIZE / 2
    b_newa = random_angle()

    wait_controller("Press any button to start.")
  endif
end sub

rem *********************************************************
rem
rem Checks if the ball hit one of the bats. This is quite a
rem tricky function.
rem
rem Basically what this function does is calculate the
rem intersection point of the line defined by the left (or 
rem right) side of the bat and the line befined by the 
rem movement of the ball. If the vector of the movement of
rem the ball intersects the line segment of the bat then
rem the ball bounces off the bat.
rem
rem The function is complicated because we want to handle
rem both left and right hand side collissions with one
rem function (why?).
rem
rem Anyway, the first part of the function deals with the
rem line segments and the second part of the function 
rem bounces the ball.
rem
rem *********************************************************
sub check_bat_collission(bat())
  local a, b, x, y, rev, bx_n, bx_o
  local ignore, y_top, y_bot, too_much

  if (bat(1) > (XSIZE / 2)) then
    x = bat(1) - (bat(3) / 2)
    rev = -1
    bx_o = ball(1) + ball(3)
    bx_n = b_newx + b_newr
    if (bx_o >= bx_n) then
      ignore = 1
    elsif ((bx_o > x) or (bx_n < x)) then
      ignore = 1
    endif
  else
    x = bat(1) + (bat(3) / 2)
    rev = 1
    bx_o = ball(1) - ball(3)
    bx_n = b_newx - b_newr
    if (bx_o <= bx_n) then
      ignore = 1
    elsif ((bx_o < x) or (bx_n > x)) then
      ignore = 1
    endif
  endif

  if (ignore = 0) then
    rem Let's give the players a bit of slack (b_newr / 2)

    y_top = bat(2) - (bat(4) / 2) - (b_newr / 2)
    y_bot = bat(2) + (bat(4) / 2) + (b_newr / 2)
  
    a = (ball(2) - b_newy) / (ball(1) - b_newx)
    b = b_newy - (a * b_newx)

    y = a * x + b 

    if (y >= y_top and y <= y_bot) then
      if (b_news > 2 * b_newr) then
        draw_the_ball(x + (rev * b_newr), y, b_newr)
      endif

      too_much = b_newx - (x + (rev * b_newr))
      b_newx = (x + (rev * b_newr)) - too_much

      b_newa = pi - b_newa
    endif
  endif
end sub

rem *********************************************************
rem
rem Draws the field and swaps drawbuffers.
rem
rem *********************************************************
sub draw_new_field()
  buffer = 1 - buffer
  setdrawbuf buffer
  setrgb 0, 64, 127, 64
  clear window
  draw_bat(left_bat())
  draw_bat(right_bat())
  draw_ball()
  draw_score()
  setdispbuf buffer
end sub

rem *********************************************************
rem 
rem Draws the ball.
rem
rem *********************************************************
sub draw_ball()
  draw_the_ball(ball(1), ball(2), ball(3))
end sub

rem *********************************************************
rem
rem Draws a ball.
rem
rem Parameters:
rem - x, y, r
rem   Geometry of the ball.
rem
rem *********************************************************
sub draw_the_ball(x, y, r)
  setrgb 1, 127, 127, 127

  fill circle x, y, r
end sub

rem *********************************************************
rem
rem Draws a bat.
rem
rem Parameters:
rem - bat()
rem   Reference to the bat structure being drawn.
rem
rem *********************************************************
sub draw_bat(bat())
  local ltx, lty, rbx, rby

  ltx = bat(1) - (bat(3) / 2)
  lty = bat(2) - (bat(4) / 2)
  rbx = bat(1) + (bat(3) / 2)
  rby = bat(2) + (bat(4) / 2)

  setrgb 1, 127, 127, 127
  fill rectangle ltx, lty, rbx, rby
end sub

rem *********************************************************
rem
rem Draws the score.
rem
rem *********************************************************
sub draw_score()
  setrgb 1, 0, 0, 0

  text 50, 20, str$(score(1)), "cc"
  text XSIZE - 50, 20, str$(score(2)), "cc"
end sub

rem *********************************************************
rem
rem Initialization function, initializes the structures and
rem the screen.
rem
rem *********************************************************
sub init()
  init_structures()
  init_screen()
end sub

rem *********************************************************
rem
rem Creates the data structures:
rem
rem score({PLAYER})
rem   Score of player 1 (left) and 2 (right). Initially both
rem   zero.
rem
rem {PLAYER}_bat
rem   Bat geometry of player 1 (left) and player 2 (right)
rem   bats. Initialliy centered vertically, BAT_OFFSET units
rem   from the side.
rem
rem ball()
rem   Geometry of the ball (x, y, r)
rem
rem *********************************************************
sub init_structures()
  rem ball: x, y, radius, angle, speed
  dim ball(5)
  init_ball()

  rem left_bat: x, y (center), width, height
  dim left_bat(4)
  left_bat(1) = BAT_OFFSET
  left_bat(2) = YSIZE / 2
  left_bat(3) = BAT_WIDTH
  left_bat(4) = BAT_HEIGHT

  rem right_bat: x, y (center), width, height
  dim right_bat(4)
  right_bat(1) = XSIZE - BAT_OFFSET
  right_bat(2) = YSIZE / 2
  right_bat(3) = BAT_WIDTH
  right_bat(4) = BAT_HEIGHT

  rem score: left, right
  dim score(2)
  score(1) = 0
  score(2) = 0
end sub

rem *********************************************************
rem
rem Initializes the ball() structure. Places the ball in the
rem middle of the screen and initializes the nagle of launch
rem to a more or less random value.
rem
rem *********************************************************
sub init_ball()
  ball(1) = XSIZE / 2
  ball(2) = YSIZE / 2
  ball(3) = BALL_RADIUS
  ball(4) = random_angle()
  ball(5) = BALL_SPEED
end sub

rem *********************************************************
rem
rem Calculates a more or less random launching value for the
rem ball. Tries to choose an angle that is not too vertical
rem in order to keep the game challenging.
rem
rem *********************************************************
sub random_angle()
  local r

  r = ran() * 2 * pi

  rem These angles keep the game interesting
  while (((r > 0.4 * pi) and (r < 0.6 * pi)) or ((r > 1.4 * pi) and (r < 1.6 * pi)))
    r = ran() * 2 * pi
  wend

  return r
end sub

rem *********************************************************
rem
rem Open and clear the screen.
rem
rem *********************************************************
sub init_screen(text$)
  open window XSIZE, YSIZE
  buffer = 0
  setdrawbuf buffer
  setrgb 0, 64, 127, 64
  clear window
end sub

rem *********************************************************
rem
rem Display a message and wait until someone presses a button
rem on some controller.
rem
rem *********************************************************
sub wait_controller(text$)
  setrgb 1, 0, 0, 0

  text XSIZE / 2, YSIZE / 2, text$, "cc"

  while (or(peek("PORT1"), peek("PORT2")) = 0)
    pause 0.02
  wend
end sub

rem *********************************************************
rem EOF
rem *********************************************************


[main page] [download] [links] [faq] [sample programs]

© 2001 P.B. IJdens, The Netherlands. All rights reserved.