Tenis Plus

Descripción del contenido de la página

Juego de tenis escrito en SuperBASIC para la Sinclair QL.

Etiquetas:

Como he comentado en otras ocasiones, apenas me han atraído los juegos de computadora salvo por la curiosidad de saber cómo estarían programados o cómo podría mejorarlos o modificarlos a mi gusto.

No recuerdo de dónde copié el listado del programa Tenis que guardo entre mis antiguos ficheros de la Sinclair QL. Su autor es Agustín Gallego. Yo lo modifiqué para poder jugar contra la máquina o, mucho mejor, que la máquina jugara sola contra sí misma y así yo tuviera más tiempo para seguir programando otras cosas...

El SuperBASIC, por cierto, es un lenguaje muy agradecido para programar. Tengo muchas cosas escritas en él que iré publicando poco a poco.

Código fuente

100 REMark TENIS, Autor: Agustín Gallego
105 :
110 REMark Versión "Tenis Plus" (C) 1989 Marcos Cruz (http://programandala.net)
112 REMark Licencia/Permesilo/License: http://programandala.net/licencia
115 REMark Marzo de 1989
120 REMark Ahora permite jugar contra la máquina, o que juegue ella sola.
125 :
130 REMark Se dibuja el campo, las raquetas, se inicializa el marcador. Esto lo hace el procedimiento inicialización.
140 inicialización
150 REPeat bucle
160 REMark Explorar detecta si se ha pulsado las teclas de mover las raquetas.
170 explorar
180 REMark Si flag es 1 es que la pelota se está moviendo de izquierda a derecha y si es 0 lo hace de derecha a izquierda. ( 1→ ; 0← )
190 IF flag = 1 :izq_der : ELSE der_izq
200 END REPeat bucle
210 REMark Se pintan las rayas del campo, las raquetas, la pelota, se pone el marcador a cero, y la pelota comienza yendo hacia la derecha.
220 DEFine PROCedure inicialización
230 REMark Dibujamos la ventana sobre la que se va a jugar
240 WINDOW 448,206,32,10
250 REMark Ponemos la pista de color verde.
260 PAPER 2 : CLS
270 REMark Se dibujan las líneas del campo.
280 BORDER 3,7
290 INPUT "Escoge velocidad", velocidad
300 INPUT "Número de jugadores (0-2)",jugadores
310 jugador_der=0
320 jugador_izq=0
330 IF jugadores:jugador_der=1
340 IF jugadores>1:jugador_izq=1
350 CLS
360 BLOCK 4,198,222,0,7
370 REMark se dibuja una pelota
380 pelota_nueva
390 REMark Se inicializan los marcadores a cero
400 LET jugador_1 = 0
410 LET jugador_2 = 0
420 CSIZE #0, 3,1
430 INK #0, 6
440 PAPER #0,0 : CLS #0
450 STRIP #0,2
460 marcador
470 REMark La pelota va hacia un lado de forma aleatoria.
480 LET flag = RND(1)
490 raquetas_nuevas
500 PAUSE 50
510 END DEFine inicialización
520 REMark Se explora si se quieren mover las raquetas
530 DEFine PROCedure explorar
540 IF KEYROW(1)=8:GO TO 3380
550 IF jugador_der
560   IF KEYROW(1) = 128 : toca_raqueta_der_abajo
570   IF KEYROW(1) = 4 : toca_raqueta_der_arriba
580 ELSE
590   IF flag
600     IF (y_der+6)>y
610       toca_raqueta_der_arriba
620     ELSE
630       toca_raqueta_der_abajo
640     END IF
650   END IF
660 END IF
670 IF jugador_izq
680   IF KEYROW(0) = 1 : toca_raqueta_izq_arriba
690   IF KEYROW(0) = 32 : toca_raqueta_izq_abajo
700 ELSE
710   IF flag=0
720       IF (y_izq+6)>y
730         toca_raqueta_izq_arriba
740       ELSE
750         toca_raqueta_izq_abajo
760       END IF
770   END IF
780 END IF
790 END DEFine explorar
800 :
810 REMark Estos procedimientos pintan las raquetas. También se van a utilizar para moverlas, porque entonces lo que se hará será borrar un trozo y pintarlo por el lado contrario. Borrar consiste en pintar con el color verde.
820 :
830 DEFine PROCedure pintar_raqueta_der(alt_der,coord_v_der,color)
840   BLOCK 6,alt_der,414,coord_v_der,color
850 END DEFine pintar_raqueta_der
860 :
870 DEFine PROCedure pintar_raqueta_izq(alt_izq,coord_v_izq,color)
880   BLOCK 6,alt_izq,20,coord_v_izq,color
890 END DEFine pintar_raqueta_izq
900 :
910 REMark Estos procedimientos mueven las raquetas, y para ello se valen de los procedimientos pintar.
920 :
930 DEFine PROCedure bajar_raqueta_der
940   pintar_raqueta_der 12,y_der,2
950   LET y_der = y_der + 12
960   pintar_raqueta_der 18,y_der,7
970 END DEFine bajar_raqueta_der
980 :
990 DEFine PROCedure subir_raqueta_der
1000   LET y_der = y_der + 6
1010   pintar_raqueta_der 12,y_der,2
1020   LET y_der = y_der - 18
1030   pintar_raqueta_der 18,y_der,7
1040 END DEFine subir_raqueta_der
1050 :
1060 DEFine PROCedure bajar_raqueta_izq
1070   pintar_raqueta_izq 12,y_izq,2
1080   LET y_izq = y_izq + 12
1090   pintar_raqueta_izq 18,y_izq,7
1100 END DEFine bajar_raqueta_izq
1110 :
1120 DEFine PROCedure subir_raqueta_izq
1130   LET y_izq = y_izq + 6
1140   pintar_raqueta_izq 12,y_izq,2
1150   LET y_izq = y_izq - 18
1160   pintar_raqueta_izq 18,y_izq,7
1170 END DEFine subir_raqueta_izq
1180 :
1190 REMark Estos procedimientos lo que hacen es mover la bola. Además, llamando a otros procedimientos sabe si la bola llega a a los bordes superior o inferior, haciendola rebotar; si está en la vertical de las raquetas , etc
1200 :
1210 DEFine PROCedure der_izq
1220   toca_bola_arriba
1230   toca_bola_abajo
1240   BLOCK 4,198,222,0,7
1250   IF x <= 26 : impacto_izq : ELSE mover_pelota_der_izq
1260 END DEFine der_izq
1270 :
1280 DEFine PROCedure izq_der
1290   toca_bola_arriba
1300   toca_bola_abajo
1310   BLOCK 4,198,222,0,7
1320   IF x >= 408 : impacto_der : ELSE mover_pelota_izq_der
1330 END DEFine izq_der
1340 :
1350 DEFine PROCedure pelota
1360   BLOCK 6,6,x,y,7
1370 END DEFine
1380 :
1390 REMark Estos procedimientos detectan si cuando la pelota llega a la vertical de las raquetas ,éstas están a la misma altura para que se produzca el choque. Si se produce el choque, se manda rebotar la pelota, sino se da punto para el jugador contrari
o.
1400 :
1410 DEFine PROCedure impacto_izq
1420   LET x   = 26
1430   borrar_pelota
1440   pelota
1450   IF KEYROW(0) = 1 : toca_raqueta_izq_arriba
1460   IF KEYROW(0) = 32 : toca_raqueta_izq_abajo
1470   IF y >= (y_izq - 6) AND y <= (y_izq + 18) : rebote_izq : ELSE punto_izq
1480 END DEFine
1490 :
1500 DEFine PROCedure rebote_izq
1510   BEEP 500,5
1520   LET flag = 1
1530   IF y <= (y_izq + 2) OR y >= (y_izq +8) THEN
1540     ß = ß + 6*signo(ß)
1550   ELSE
1560     ß = ß - 4*signo(ß)
1570   END IF
1580   x1 = x
1590   y1 =y
1600   x = x + velocidad*COS(RAD(ß))
1610   y = y + velocidad*SIN(RAD(ß))
1620   toca_bola_arriba
1630   toca_bola_abajo
1640   mover_pelota_izq_der
1650 END DEFine
1660 :
1670 DEFine PROCedure punto_izq
1680   x = 10 : x1 = 26 : y1 = y
1690   y = y + velocidad*SIN(RAD(ß)) : toca_bola_arriba : toca_bola_abajo
1700   borrar_pelota
1710   pelota
1720   BEEP 1000,30
1730   LET flag = 0
1740   PAUSE 25
1750   LET jugador_2 = jugador_2 + 1
1760   CLS #0
1770   marcador
1780   CLS : BLOCK 4,198,222,0,7
1790   raquetas_nuevas
1800   PAUSE 100
1810   pelota_nueva
1820 END DEFine
1830 :
1840 DEFine PROCedure impacto_der
1850   LET x = 408
1860   borrar_pelota
1870   pelota
1880   IF KEYROW(1) = 4 : toca_raqueta_der_arriba
1890   IF KEYROW(1) = 128 : toca_raqueta_der_abajo
1900   IF y >= (y_der - 6 ) AND y <= (y_der +18)
1910     rebote_der
1920   ELSE
1930     punto_der
1940   END IF
1950 END DEFine
1960 :
1970 DEFine PROCedure rebote_der
1980   LET flag = 0
1990   BEEP 500,5
2000   IF y <= (y_der + 4 ) OR y >= (y_der + 8) THEN
2010     ß = ß + 6*signo(ß)
2020   ELSE
2030     ß = ß - 4*signo(ß)
2040   END IF
2050   y1 = y
2060   x1 = x
2070   x = x - velocidad*COS(RAD(ß))
2080   y = y + velocidad*SIN(RAD(ß))
2090   toca_bola_arriba
2100   toca_bola_abajo
2110   mover_pelota_der_izq
2120 END DEFine
2130 :
2140 DEFine PROCedure punto_der
2150   x = 424 : x1 = 408 : y1 = y
2160   y = y + velocidad*SIN(RAD(ß)) : toca_bola_arriba : toca_bola_abajo
2170   borrar_pelota
2180   pelota
2190   BEEP 1000,30
2200   LET flag = 1
2210   PAUSE 25
2220   LET jugador_1 = jugador_1 + 1
2230   CLS #0
2240   marcador
2250   CLS : BLOCK 4,198,222,0,7
2260   raquetas_nuevas
2270   PAUSE 100
2280   pelota_nueva
2290 END DEFine
2300 :
2310 REMark Estos procedimientos detectan si las raquetas están tocando las líneas cuando se las quiere mover, si esto es así, se dejan las raquetas donde están; es decir en un borde.
2320 :
2330 DEFine PROCedure toca_raqueta_der_abajo
2340   IF y_der<>180 :bajar_raqueta_der
2350 END DEFine
2360 :
2370 DEFine PROCedure toca_raqueta_der_arriba
2380   IF y_der<>0 :subir_raqueta_der
2390 END DEFine
2400 :
2410 DEFine PROCedure toca_raqueta_izq_arriba
2420   IF y_izq<>0 :subir_raqueta_izq
2430 END DEFine
2440 :
2450 DEFine PROCedure toca_raqueta_izq_abajo
2460   IF y_izq<>180:bajar_raqueta_izq
2470 END DEFine
2480 :
2490 REMark Se detecta si las bolas tocan en los límites del campo, en caso afirmativo se las hace rebotar.
2500 :
2510 DEFine PROCedure toca_bola_arriba
2520   IF y <= 0
2530     LET y = 0
2540     LET ß = -ß
2550   END IF
2560 END DEFine
2570 :
2580 DEFine PROCedure toca_bola_abajo
2590   IF y >= 192
2600     LET y = 192
2610     LET ß = - ß
2620   END IF
2630 END DEFine
2640 :
2650 REMark Estos procedimientos mueven la pelota una vez que se ha detectado que en efecto hay que moverla (por ejemplo que no ha sido punto, con lo que habría que dibujar pelota nueva,  etc)
2660 :
2670 DEFine PROCedure mover_pelota_izq_der
2680   borrar_pelota
2690   pelota
2700   LET x1 = x
2710   LET y1 = y
2720   LET x = x + velocidad*COS(RAD(ß))
2730   LET y = y + velocidad*SIN(RAD(ß))
2740 END DEFine
2750 :
2760 DEFine PROCedure mover_pelota_der_izq
2770   borrar_pelota
2780   pelota
2790   LET x1 = x
2800   LET y1 = y
2810   LET x = x - velocidad*COS(RAD(ß))
2820   LET y = y + velocidad*SIN(RAD(ß))
2830 END DEFine
2840 :
2850 DEFine PROCedure borrar_pelota
2860   BLOCK 6,6,x1,y1,2
2870 END DEFine
2880 :
2890 DEFine PROCedure pelota_nueva
2900   LET x = 224
2910   LET y = RND(50 TO 150)
2920   LET ß = RND(-30 TO 30)
2930   LET x1 = x
2940   LET y1 = y
2950 END DEFine
2960 :
2970 DEFine PROCedure rapidez
2980   IF KEYROW(1)=4 OR KEYROW(1)=128 OR KEYROW(0)=1 OR KEYROW(0)=32
2990     LET velocidad = 25
3000   ELSE
3010     LET velocidad = 17
3020   END IF
3030 END DEFine
3040 :
3050 DEFine PROCedure raquetas_nuevas
3060   LET y_izq = 96
3070   LET y_der = 96
3080   pintar_raqueta_der 18,96,7
3090   pintar_raqueta_izq 18,96,7
3100 END DEFine
3110 :
3120 DEFine PROCedure borrar_raquetas
3130   pintar_raqueta_der 18,y_der,4
3140   pintar_raqueta_izq 18,y_izq,4
3150 END DEFine
3160 :
3170 DEFine FuNction signo(ß)
3180   IF ß=0
3190     RETurn 1
3200   ELSE
3210     IF ß<-65
3220       RETurn -65
3230     ELSE
3240       IF ß>65
3250         RETurn 65
3260       ELSE
3270         LET respuesta=ß/ABS(ß)
3280         RETurn respuesta
3290       END IF
3300     END IF
3310   END IF
3320 END DEFine
3330 :
3340 DEFine PROCedure marcador
3350 PRINT #0\,jugador_1 TO (22-LEN(jugador_1)-LEN(jugador_2));jugador_2;"       "
3360 END DEFine
3370 :
3380 m=RESPR(50)
3390 POKE_W m,20032:POKE_W m+2,20080
3400 CALL m

Descargas