Juego de barcos para QL
Descripción del contenido de la página
Juego de barcos escrito en SuperBASIC para la Sinclair QL; permite jugar a dos computadoras QL unidas mediante red local.
Etiquetas:
Este programa de 1991 es una modificación de otro Juego de barcos entre QL y ZX Spectrum. En esta versión posterior compiten dos QL entre sí, unidas por su red local.
Código fuente
1000 REMark Juego de barcos
1010 REMark entre QL y QL
1020 REMark mediante red local
1030 :
1040 REMark Copyright (C) 1991 Marcos Cruz (http://programandala.net)
1042 REMark Licencia/Permesilo/License: http://programandala.net/licencia
1043 REMark 1991-05-04
1045 :
1050 REMark Basado en otro para QL/Spectrum mediante RS232:
1060 REMark 1987-04
1070 REMark 1988-01-22 Ajustado
1080 :
1090 MODE 8
1100 BUFRO=RESPR(10)
1110 :
1120 REMark Preparacion:
1130 :
1140 nb=8
1150 RESTORE
1160 DIM p(10,10)
1170 DIM b(nb)
1180 DIM b$(nb,12)
1190 FOR i=1 TO nb
1200 READ b(i),b$(i)
1210 NEXT i
1220 DATA 1,"LANCHA"
1230 DATA 1,"LANCHA"
1240 DATA 2,"CRUCERO"
1250 DATA 2,"CRUCERO"
1260 DATA 3,"ACORAZADO"
1270 DATA 3,"ACORAZADO"
1280 DATA 4,"DESTRUCTOR"
1290 DATA 5,"PORTAAVIONES"
1300 :
1310 REMark Decidir quién es quién:
1320 :
1330 j$=""
1340 REPeat elige_jugador
1350 CLS#0
1360 INPUT#0,"Qué jugador eres? (1/2) ";j$
1370 IF j$="1" OR j$="2":EXIT elige_jugador
1380 END REPeat elige_jugador
1390 NET j$
1400 IF j$="1":oj$="2"
1410 IF j$="2":oj$="1"
1420 :
1430 REMark Preparar pantalla:
1440 :
1450 CLS#0:CLS#1
1460 col=0
1470 IF j$="2":col=7
1480 PAPER 7
1490 INK 0
1500 CLS
1510 PRINT "BATALLA DE BARCOS"
1520 PRINT
1530 PRINT "JUGADOR ";j$
1540 PRINT
1550 PRINT "BARCOS TUYOS ";
1560 PRINT "BARCOS ENEMIGOS"
1570 PRINT
1580 PRINT " 0123456789 ";
1590 PRINT "0123456789"
1600 FOR i=1 TO 10
1610 PRINT CHR$(i+64);".......... ";
1620 PRINT CHR$(i+64);".........."
1630 END FOR i
1640 :
1650 REMark Colocar barcos:
1660 :
1670 nb=2
1680 FOR i=1 TO nb
1690 mensaje i&". "&b$(i)&" "&b(i)&" CUADROS"
1700 coordenadas
1710 IF p(le,nu) THEN GO TO 1700
1720 IF b(i)=1 THEN ili=0:ico=0:GO TO 1820
1730 INPUT#0;"A, B, D o I ? ";a$
1740 IF a$>="a" THEN a$=CHR$(CODE(a$)-32)
1750 IF a$<>"A" AND a$<>"B" AND a$<>"D" AND a$<>"I" THEN GO TO 1730
1760 IF a$="A" THEN ili=-1:ico=0
1770 IF a$="B" THEN ili=1:ico=0
1780 IF a$="D" THEN ili=0:ico=1
1790 IF a$="I" THEN ili=0:ico=-1
1800 IF le+ili*b(i)<1 OR le+ili*b(i)>10 THEN GO TO 1730
1810 IF nu+ico*b(i)<1 OR nu+ico*b(i)>10 THEN GO TO 1730
1820 le2=le:nu2=nu
1830 FOR j=1 TO b(i)
1840 IF p(le2,nu2) THEN GO TO 1700
1850 le2=le2+ili:nu2=nu2+ico
1860 END FOR j
1870 INK b(i)
1880 FOR j=1 TO b(i)
1890 AT li,co:PRINT "χ"
1900 li=li+ili
1910 co=co+ico
1920 p(le,nu)=b(i)
1930 le=le+ili
1940 nu=nu+ico
1950 END FOR j
1960 INK 0
1970 END FOR i
1980 mensaje "LISTOS PARA ENTRAR EN COMBATE"
1990 :
2000 REMark Selección:
2010 :
2020 IF j$="2" THEN GO TO 2200
2030 :
2040 REMark Disparar:
2050 :
2060 mensaje "DISPARA:"
2070 coordenadas
2080 AT li,co+18:PRINT "*"
2090 enviar a$:REMark disparo
2100 mensaje "ESPERANDO RESULTADOS"
2110 a$=recibir$(2)
2120 a=a$(1)
2130 x=a$(2)
2140 IF a=1 THEN AT li,co+18:PRINT "O":m$="¡AGUA!"
2150 IF a>1 THEN AT li,co+18:PRINT "X":m$="¡BARCO TOCADO!"
2160 IF a>2 THEN m$="¡"&b$(x)&" ENEMIGO HUNDIDO!"
2170 mensaje m$
2180 IF a=4:mensaje "¡HAS GANADO LA PARTIDA!":GO TO 2870
2190 :
2200 REMark Esperar disparo:
2210 :
2220 mensaje "ESPERANDO DISPARO"
2230 a$=recibir$(2)
2240 descifrar_coordenadas
2250 mensaje "EL ENEMIGO DISPARA A "&a$
2260 x=p(le,nu)
2270 p(le,nu)=0
2280 IF x=0 THEN a=1:GO TO 2330
2290 a=2
2300 b(x)=b(x)-1
2310 IF b(x)=0 THEN a=3:nb=nb-1
2320 IF nb=0 THEN a=4
2330 a$=a&x
2340 enviar a$
2350 IF a=1 THEN AT li,co:PRINT "O":m$="¡AGUA!"
2360 IF a>1 THEN AT li,co:PRINT "X":m$=b$(x)&" TOCADO"
2370 IF a>2 THEN m$="¡"&m$&" Y HUNDIDO!"
2380 mensaje m$
2390 IF a=4:mensaje "HAS PERDIDO LA PARTIDA...":GO TO 2870
2400 GO TO 2040
2410 :
2420 DEFine PROCedure mensaje(m$)
2430 CLS#0
2440 AT 18,0:PRINT " "
2450 AT 18,0:PRINT m$
2460 PAUSE 75
2470 END DEFine mensaje
2480 :
2490 DEFine PROCedure coordenadas
2500 REPeat pide_coordenadas
2510 CLS#0
2520 INPUT#0;"¿Coordenadas? ";a$
2530 IF LEN(a$)<>2:NEXT pide_coordenadas
2540 c=CODE(a$)
2550 IF c>=97 THEN a$(1)=CHR$(c-32)
2560 IF a$(1)<"A" OR a$(1)>"J":NEXT pide_coordenadas
2570 IF a$(2)<"0" OR a$(2)>"9":NEXT pide_coordenadas
2580 EXIT pide_coordenadas
2590 END REPeat pide_coordenadas
2600 descifrar_coordenadas
2610 END DEFine coordenadas
2620 :
2630 DEFine PROCedure descifrar_coordenadas
2640 le=CODE(a$)-64
2650 nu=a$(2)+1
2660 li=le+6
2670 co=nu
2680 END DEFine descifrar_coordenadas
2690 :
2700 DEFine FuNction recibir$(n)
2710 LOCal carácter
2720 LBYTES "neti_"&oj$,BUFRO
2730 a$=""
2740 FOR carácter=1 TO n
2750 a$=a$&CHR$(PEEK(carácter))
2760 END FOR carácter
2770 RETurn a$
2780 END DEFine recibir$
2790 :
2800 DEFine PROCedure enviar(a$)
2810 LOCal carácter
2820 FOR carácter=1 TO LEN(a$)
2830 POKE BUFRO+carácter,CODE(a$(carácter))
2840 END FOR carácter
2850 SBYTES "neto_"&oj$,BUFRO,LEN(a$)
2860 END DEFine enviar
2870 REMark Final de la partida:
2880 :
2890 STOP