Tenis Plus

Priskribo de la ĉi-paĝa enhavo

Teniso-ludo verkita en SuperBASIC por Sinclair QL.

Etikedoj:

Mi plurfoje skribis, ke komputilaj ludoj apene interesis min, krom scivole por ekscii, kiel ili estas programitaj aŭ kiel mi povus plibonigi aŭ modifi ilin miaplaĉe.

Mi ne rememoras, el kie mi kopiis la programon Tenis kiun mi konservis kun miaj dosieroj de QL. Ĝia aŭtoro estas Agustín Gallego. Mi modifis ĝin por ebligi ludi kontraŭ la maŝino aŭ, pli bone, ke la maŝino ludu sola kontraŭ si mem kaj do mi havu plian tempon plu programadi aliajn projektojn...

Cetere, SuperBASIC, estas tre plaĉa programlingvo. Mi verkis multajn programojn per ĝi, kaj mi iom post iom publikigos ilin.

La fontkodajn nomoj kaj notoj estas en la hispana.

Fontkodo

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

Deŝutoj