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