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

Descargas