Programa 20 - Líneas 3D - Lineas con scroll de texto

Sencillo programa con apenas 10 líneas de código escrito en BASIC.
Muestra en pantalla una forma 3D representada con línias.

Código BASIC

10 REM **********************************
20 REM *** Lineas con scroll de texto ***
30 REM ***       FlynnTron1982        ***
40 REM ***        16-12-2019          ***
50 REM **********************************
60 MODE 2
70 BORDER 18:INK 0,0:INK 1,18:CLS
80 DEG
90 ORIGIN 320,100
100 LOCATE 1,24
110 t=t+1:IF t>360 THEN t=1
120 MOVE 100*COS(t+360*COS(t)),100*SIN(t+360*SIN(t))
130 DRAW 100*COS(t+360*SIN(t)),100*SIN(t+360*COS(t))
140 PRINT
150 GOTO 110

Programa 019 - CANCIÓN

Programa de poco más de 50 lineas de código que hace sonar una pegadiza canción.

Código BASIC

10 REM la linea 190 da la melodia en clave de agudos
20 REM la linea 200 da la melodia en clave de graves
30 DIM escala%(12):FOR x%=1 TO 12:READ escala%(x%):NEXT
40 canal1%=1:READ canal1$:canal2%=2:READ canal2$
50 CLS
60 velocidad%=12
70 escala$=" a-b b c+c d-e e f+f g+g"
80 ENV 1,2,5,2,8,-1,10,10,0,15
90 ENV 2,2,7,2,12,-1,10,10,0,15
100 ENT -1,1,1,1,2,-1,1,1,1,1
110 DEF FNm$(s$,s)=MID$(s$,s,1)
120 canal1%=1:GOSUB 200
130 canal2%=1:GOSUB 380
140 IF canal1%+canal2%>0 THEN 140
150 END
160 DATA &777,&70c,&6a7,&647,&5ed,&598
170 DATA &547,&4fc,&4b4,&470,&431,&3f4
180 DATA 4cr4f4f1f1g1A1-B2C2f4g2g1A1-B6A2Cr1f1g1f1g1a1-b1A1-b2C2g2A2g2f1g1a2g2f6e2c2e2c2g2e2c1-B1A2g2f4e4d8c4f3f1c2d4-b2fr2-B2A2g2f6e2gr4C4-B1a1f1-b1g2c2-b4a4g4fr6A2A2-B4-B2Ar2-B2A2g2f6e2g4C4-B1A1f1-B1g2C2-B4A4g8f.
190 DATA r4f4f8f4e4c4fr8f4e2f2e4d2e2d8c8c6e2f4g4g8e4f3f1c4dr8g4cr4e4c6f2d4c4c8fr8-e4dr8g8c4e4c6f2d4c4c8f.
200 REM enviar sonido al canal A
210 p1$=FNm$(canal1$,canal1%)
220 IF p1$<>"r" THEN r1%=0:GOTO 240
230 r1%=16:canal1%=canal1%+1:p1$=FNm$(canal1$,canal1%)
240 IF p1$="." THEN canal1%=0:RETURN ELSE I1%=VAL(p1$)
250 canal1%=canal1%+1
260 n1$=FNm$(canal1$,canal1%)
270 canal1%=canal1%+1
280 IF n1$="+" OR n1$="-" THEN 350
290 n1$=" "+n1$
300 nd1%=(1+INSTR(escala$,LOWER$(n1$)))/2
310 IF ASC(RIGHT$(n1$,1))>96 THEN o1%=8 ELSE o1%=16
320 SOUND 1+r1%,escala%(nd1%)/o1%,velocidad%*I1%,0,1,1
330 ON SQ(1) GOSUB 200
340 RETURN
350 n1$=n1$+FNm$(canal1$,canal1%)
360 canal1%=canal1%+1
370 GOTO 300
380 REM enviar sonido al canal B
390 p2$=FNm$(canal2$,canal2%)
400 IF p2$<>"r" THEN r2%=0:GOTO 420
410 r2%=8:canal2%=canal2%+1:p2$=FNm$(canal2$,canal2%)
420 IF p2$="." THEN canal2%=0:RETURN ELSE l2%=VAL(p2$)
430 canal2%=canal2%+1
440 n2$=FNm$(canal2$,canal2%)
450 canal2%=canal2%+1
460 IF n2$="+" OR n2$="-" THEN 530
470 n2$=" "+n2$
480 nd2%=(1+INSTR(escala$,LOWER$(n2$)))/2
490 IF ASC(RIGHT$(n2$,1))>96 THEN o2%=4 ELSE o2%=8
500 SOUND 2+r2%,escala%(nd2%)/o2%,velocidad%*l2%,0,1,2
510 ON SQ(2) GOSUB 380
520 RETURN
530 n2$=n2$+FNm$(canal2$,canal2%)
540 canal2%=canal2%+1
550 GOTO 480

Programa 018 - REBOTES por Alexander Martín - AMSOFT 1984

Programa escrito en BASIC para AMSTRAD CPC en el año 1984.
Programador Alexader Martín para AMSOFT.

Increíble programa que ocupa menos de 70 líneas de código.

Código BASIC

10 'REBOTES, por Alexander Martin
20 'copyright (c) AMSOFT 1984
30 '
40 MODE 1:BORDER 1:INK 0,1:INK 1,26:INK 2,24:INK 3,6
50 SPEED KEY 15,2
60 ENV 1,1,18,0,11,0,10
70 ENT 1,10,2,2
80 ENV 3,1,0,16,5,-3,2
90 ENV 2,5,3,3,1,-21,22,9,-3,2
100 ENT -2,10,2,2,5,-7,1,2,11,3,2,-4,8
110 '
120 '
130 MOVE 30,32:DRAWR 0,400,1:MOVE 610,32:DRAWR 0,400,1
140 PEN 3:LOCATE 3,1:PRINT STRING$(36,143)
150 PEN 2:LOCATE 3,2:PRINT STRING$(36,143)
160 PEN 1:FOR r=5 TO 6:LOCATE 3,r:PRINT STRING$(36,143):NEXT r
170 bx=9
180 pelotas=5:puntos=0
190 PEN 1:GOSUB 680
200 IF INKEY$<>CHR$(32) AND JOY(0)<16 THEN 200
210 LOCATE 3,23:PRINT SPACE$(36):LOCATE 1,24:PRINT SPACE$(40);
220 GOSUB 690:GOSUB 660:GOTO 280
230 '
240 '
250 LOCATE bx,24:PRINT"  ";STRING$(4,131);"  ":RETURN
260 '
270 '
280 xa=1:ya=1:IF INT(RND*2)=1 THEN xa=-xa
290 PEN 1:GOSUB 250
300 ORIGIN 0,400
310 x=bx+4:y=11:x1=x:y1=y
320 '
330 '
340 x1=x+xa:y1=y+ya
350 IF x1=3 OR x1=38 THEN xa=-xa
360 GOSUB 540
370 IF y1=24 AND x1>bx+1 AND x1<bx+6 THEN ya=-ya:y1=y1-2:SOUND 130,44,8,7,1,1:a=((x>bx+5) OR (x<bx+2)):IF a=-1 THEN xa=xa*a:x1=x1+xa:y1=y1+1
380 IF y=25 THEN LOCATE x,y:PRINT" ":GOTO 500
390 GOSUB 250
400 t=TEST((16*x1)-1,-(16*y1)-1)
410 IF t<>0 THEN ya=-ya:xz=x1:yz=y1:y1=y1+ya:GOSUB 590:IF t=2 THEN puntos=puntos+10:GOSUB 660
420 IF t=3 THEN puntos=puntos+20:GOSUB 660
430 IF t=1 THEN puntos=puntos+5:GOSUB 660
440 IF y1=1 THEN ya=1
450 LOCATE x,y:PRINT" ":LOCATE x1,y1:PRINT CHR$(231):x=x1:y=y1
460 IF y=1 OR x=3 OR x=38 THEN SOUND 129,78,8,7,1,1
470 GOTO 340
480 '
490 '
500 pelotas=pelotas-1:SOUND 132,19,46,12,2,2:IF pelotas=0 THEN GOTO 620
510 GOSUB 660:GOTO 280
520 '
530 '
540 IF (INKEY(8)=0 OR INKEY(74)=0) AND bx>2 THEN bx=bx-2:RETURN
550 IF (INKEY(1)=0 OR INKEY(75)=0) AND bx<32 THEN bx=bx+2:RETURN
560 RETURN
570 '
580 '
590 LOCATE xz,yz:PRINT" ":RETURN
600 '
610 '
620 IF puntos>=maximo THEN maximo=puntos
630 GOSUB 660:puntos=0:pelotas=5:GOTO 130
640 '
650 '
660 SOUND 130,0,20,13,3,0,31:LOCATE 1,25:PRINT"Maximo";maximo
670 LOCATE 15,25:PRINT "Puntos";puntos:LOCATE 30,25:PRINT"Pelotas";pelotas:RETURN
680 LOCATE 3,23:PRINT"Pulse barra espaciadora para empezar":RETURN
690 LOCATE 1,25:PRINT SPACE$(40);:RETURN

Programa 17 - GUIA DE TELEFONOS

Sencilla guía telefónica que permite guardar dos campos por registro, el nombre y el número de teléfono.
No hay ningún control. Permite escribir cualquier combinación alfa-numérica en cualquier campo.

1. Introducir datos - Para introducir los datos de nuestros contactos.
2. Listado - Muestra el listado completo de los datos introducidos.
3. Busqueda - Realiza una búsqueda entre los datos introducidos. Contiene un error, si el resultado de la búsqueda es positivo, sale del programa después de mostrar el resultado.
4. Grabar datos - Sirve para grabar los datos introducirlos y no perderlos al apagar el ordenador o salir del programa.
5. Cargar datos - Sirve para cargar los datos que previamente se han salvado con la opción anterior.

Código BASIC

10 REM guia de telefonos
20 DIM NOMBRE$(100)
30 DIM TEL$(100)
40 MODE 1
50 WINDOW #1,13,30,10,14
60 PRINT #1,"1. Introd. datos"
70 PRINT #1,"2. Listado"
80 PRINT #1,"3. Busqueda"
90 PRINT #1,"4. Grabar datos"
100 PRINT #1,"5. Cargar datos"
110 LOCATE 7,20
120 INPUT "Elija una opcion (1-5) ";el
130 CLS
140 ON el GOSUB 190,290,350,430,500
150 LOCATE 9,20
160 PRINT"Pulse una tecla para volver al menu"
170 IF INKEY$="" THEN 170
180 GOTO 40
190 FOR x=1 TO 100
200 CLS
210 IF LEN(NOMBRE$(x))>0 THEN 260
220 PRINT"Pulse [INTRO] para terminar
230 INPUT;" Nombre ";NOMBRE$(x)
240 IF NOMBRE$(x)="" THEN 270
250 INPUT;" Telefono ";TEL$(x)
260 NEXT

270 PRINT "Fin de la entrada de datos" 
280 RETURN
290 FOR X=1 TO 100
300 IF NOMBRE$(x)="" THEN 330
310 PRINT NOMBRE$(x);" ";TEL$(x)
320 NEXT
330 PRINT "Fin de la lista"
340 RETURN
350 INPUT "Buscar ";BUSCA$
360 FOR X=1 TO 100
370 IF INSTR(NOMBRE$(x),BUSCA$)=0 THEN 400
380 PRINT NOMBRE$(x);" ";TEL$(x)
390 END
400 NEXT
410 PRINT"No lo encuentro"
420 RETURN
430 OPENOUT "!datos"
440 FOR x=1 TO 100
450 WRITE #9,NOMBRE$(x),TEL$(x)
460 NEXT
470 CLOSEOUT
480 PRINT"Fin de la grabacion de los datos"
490 RETURN
500 OPENIN "!datos"
510 FOR X=1 TO 100
520 INPUT #9,NOMBRE$(x),TEL$(x)
530 NEXT
540 CLOSEIN
550 PRINT"Fin de la carga de los datos"
560 RETURN

Programa 16 - AMTHELLO por M. J. Gribbins - AMSOFT 1984

Juego AMTHELLO escrito por J. Gribbins en 1984 para AMSOFT.

Yo, desde luego, no sé como se juega. :( Entiendo que debes hacerte con todo el tablero de tu color, pero tampoco le he dedicado mucho tiempo para saber jugar. Dudo que sea demasiado difícil.

Código BASIC

10 ' AMTHELLO, por M. J. Gribbins
20 ' copyright (c) AMSOFT 1984
30 '
40 BORDER 14
50 CLEAR
60 MODE 1:PEN 0:PAPER 1:CLS
70 INK 0,0:INK 1,14:INK 2,18:INK 3,26
80 LOCATE 2,3:PEN 3:PRINT"A":LOCATE 3,4:PRINT"M":LOCATE 4,5:PRINT"T":LOCATE 5,6:PRINT"H"
90 LOCATE 6,7:PRINT"E":LOCATE 7,8:PRINT"L":LOCATE 8,9:PRINT"L":LOCATE 9,10:PRINT"O"
100 WINDOW #1,2,39,22,25:PAPER #1,1:PEN #1,0:CLS#1
110 PEN 0
120 LOCATE #1,5,1:PRINT#1,"LAS NEGRAS SIEMPRE EMPIEZAN"
130 LOCATE #1,4,3:PRINT#1,"ELIJA BLANCAS <B> O NEGRAS <N>"
140 b$=INKEY$:IF b$="" THEN 140
150 IF b$="B" OR b$="b" THEN q%=3:n%=0:GOTO 210
160 IF b$="N" OR b$="n" THEN q%=0:n%=3:GOTO 210
170 CLS#1:LOCATE #1,4,3
180 PRINT#1,"    SOLO BLANCAS O NEGRAS"
190 FOR t=0 TO 1000:NEXT t
200 GOTO 140
210 DIM c%(10,10),p%(9,9),c1%(8),c2%(8),cx%(9),cy%(9)
220 i1%=2:j1%=2:i2%=7:j2%=7
230 FOR i%=0 TO 9
240 c%(i%,o%)=6:c%(0,i%)=6
250 c%(9,i%)=6:c%(i%,9)=6
260 NEXT i%
270 FOR i%=1 TO 8
280 READ c1%(i%),c2%(i%)
290 FOR j%=1 TO 8
300 READ p%(i%,j%)
310 c%(i%,j%)=6
320 NEXT j%:NEXT i%
330 c%(4,4)=3:c%(4,5)=0:c%(5,4)=0:c%(5,5)=3
340 FOR k%=1 TO 58
350 READ ar%,br%,cr%,dr%
360 PLOT ar%,br%:DRAW cr%,dr%,0
370 NEXT k%
380 GOSUB 1460
390 IF q%=3 GOTO 770
400 CLS#1:INPUT #1," ELIJA FILA ";e%
410 IF e%<1 OR e%>8 GOTO 400
420 LOCATE #1,1,3:INPUT #1," ELIJA COLUMNA ";d%
430 IF d%<1 OR d%>8 GOTO 420
440 IF c%(d%,e%)=6 GOTO 480
450 CLS#1:LOCATE #1,5,2:PRINT#1,"ESE CUADRADO YA ESTA OCUPADO!"
460 FOR t=1 TO 1000:NEXT t
470 GOTO 400
480 PLOT 270+(30*d%),70+(30*e%):DRAW 290+(30*d%),89+(30*e%),q%
490 PLOT 290+(30*d%),70+(30*e%):DRAW 270+(30*d%),89+(30*e%),q%
500 GOTO 540
510 FOR m%=0 TO 19 STEP 2:PLOT 270+(30*d%),70+m%+(30*e%)
520 DRAW 290+(30*d%),70+m%+(30*e%),6:NEXT m%
530 GOTO 400
540 vrx%=0
550 FOR k%=1 TO 8
560 vr%=0:c3%=d%:c4%=e%
570 c3%=c3%+c1%(k%):c4%=c4%+c2%(k%)
580 IF c%(c3%,c4%)=n% GOTO 590 ELSE 600
590 vr%=vr%+1:GOTO 570
600 IF c%(c3%,c4%)=6 GOTO 610 ELSE 620
610 NEXT k%:GOTO 670
620 IF vr%=0 GOTO 610 ELSE 630
630 vrx%=vrx%+vr%
640 c3%=c3%-c1%(k%):c4%=c4%-c2%(k%)
650 IF c%(c3%,c4%)=6 GOTO 610 ELSE 660
660 c%(c3%,c4%)=q%:GOTO 640
670 IF vrx%=0 GOTO 680 ELSE 710
680 CLS#1:PRINT#1,"ESO NO ES POSIBLE"
690 FOR t=1 TO 1000:NEXT t
700 GOTO 510
710 e%=e%:d%=d%:vrx%=vrx%
720 CLS#1:PRINT#1,"USTED VA A LA LINEA ";e%
730 PRINT#1,"     Y A LA COLUMNA ";d%
740 LOCATE #1,2,4:PRINT#1,"CON LO QUE CONSIGUE ";vrx%;" CUADRADO(S)"
750 c%(d%,e%)=q%:GOSUB 1710
760 GOSUB 1460
770 CLS#1:LOCATE #1,10,2:PRINT#1,"AHORA ME TOCA A MI...!"
780 p%=0:vrx%=0:vry%=0
790 IF i1%*j1%=1 AND i2%*j2%=64 GOTO 860
800 FOR k%=2 TO 7
810 IF c%(2,k%)<>6 THEN i1%=1
820 IF c%(7,k%)<>6 THEN i2%=8
830 IF c%(k%,2)<>6 THEN j1%=1
840 IF c%(k%,7)<>6 THEN j2%=8
850 NEXT k%
860 FOR i%=i1% TO i2%
870 FOR j%=j1% TO j2%
880 IF c%(i%,j%)=6 GOTO 1030
890 NEXT j%:NEXT i%
900 IF p%>0 THEN 1000
910 IF pas%=1 GOTO 920 ELSE 940
920 CLS#1:PRINT#1,"BLOQUEADO! YO TAMBIEN TENGO QUE PASAR. FIN DE LA PARTIDA"
930 FOR t=1 TO 1000:NEXT t:GOTO 1550
940 CLS#1:LOCATE #1,18,2:PRINT#1,"TENGO QUE PASAR"
950 GOSUB 2720
960 IF pas%=1 GOTO 970 ELSE 990
970 CLS#1:PRINT#1,"BLOQUEADO! USTED TAMBIEN TIENE QUE PASAR. FIN DE LA PARTIDA."
975 RETURN
980 FOR t=1 TO 1000:NEXT t:GOTO 1550
990 GOTO 400
1000 IF lc%=0 THEN lc%=1:RANDOMIZE lc%:rl%=RND(lc%)
1010 cx1%=cx%(rl%):cx2%=cy%(rl%)
1020 GOTO 1220
1030 vrx%=0
1040 FOR k%=1 TO 8
1050 vr%=0:c3%=i%:c4%=j%
1060 c3%=c3%+c1%(k%):c4%=c4%+c2%(k%)
1070 IF c%(c3%,c4%)=q% GOTO 1080 ELSE 1090
1080 vr%=vr%+1:GOTO 1060
1090 IF c%(c3%,c4%)=6 GOTO 1100 ELSE 1110
1100 NEXT k%:GOTO 1130
1110 IF vr%=o% GOTO 1100 ELSE 1120
1120 vrx%=vrx%+vr%:GOTO 1100
1130 IF vrx%=0 GOTO 890
1140 IF p%(i%,j%)<p% GOTO 890
1150 IF p%(i%,j%)>p% GOTO 1160 ELSE 1170
1160 p%=p%(i%,j%):vry%=vrx%:lc%=0:cx%(0)=i%:cy%(0)=j%:GOTO 890
1170 IF vry%>vrx% GOTO 890
1180 IF vry%<vrx% GOTO 1190 ELSE 1200
1190 lc%=0:vry%=vrx%:cx%(0)=i%:cy%(0)=j%:GOTO 890
1200 lc%=lc%+1:cx%(lc%)=i%:cy%(lc%)=j%
1210 GOTO 890
1220 cx2%=cx2%:cx1%=cx1%:vry%=vry%
1230 CLS#1:PRINT#1,"YO VOY A LA FILA ";cx2%
1240 PRINT#1,"  Y A LA COLUMNA ";cx1%
1250 LOCATE #1,1,4:PRINT#1,"CON LO QUE CONSIGO ";vry%;" CUADRADO(S)"
1260 PLOT 270+(30*cx1%),70+(30*cx2%):DRAW 290+(30*cx1%),89+(30*cx2%),n%
1270 PLOT 290+(30*cx1%),70+(30*cx2%):DRAW 270+(30*cx1%),89+(30*cx2%),n%
1280 FOR t=1 TO 1000:NEXT t
1290 FOR k%=1 TO 8
1300 vr%=0:c3%=cx1%:c4%=cx2%
1310 c3%=c3%+c1%(k%):c4%=c4%+c2%(k%)
1320 IF c%(c3%,c4%)=q% GOTO 1330 ELSE 1340
1330 vr%=vr%+1:GOTO 1310
1340 IF c%(c3%,c4%)=6 GOTO 1350 ELSE 1360
1350 NEXT k%:GOTO 1400
1360 IF vr%=0 GOTO 1350
1370 c3%=c3%-c1%(k%):c4%=c4%-c2%(k%)
1380 IF c%(c3%,c4%)=6 GOTO 1350
1390 c%(c3%,c4%)=n%:GOTO 1370
1400 c%(cx1%,cx2%)=n%
1410 GOSUB 2720
1420 GOSUB 1460
1430 IF pas%=1 GOTO 1440 ELSE 1450
1440 CLS#1:PRINT#1,"    USTED TIENE QUE PASAR":FOR t=1 TO 1000:NEXT t:GOTO 770
1450 GOTO 400
1460 FOR i%=1 TO 8
1470 FOR j%=1 TO 8
1480 FOR m%=1 TO 19 STEP 2
1490 z%=270+(30*i%):h%=70+(30*j%):w%=h%+m%
1500 PLOT z%,w%:DRAW z%+20,w%,c%(i%,j%)
1510 NEXT m%:NEXT j%:NEXT i%
1520 x%=x%+1
1530 IF x%=61 GOTO 1550
1540 RETURN
1550 cq%=0:cn%=0
1560 FOR i%=1 TO 8
1570 FOR j%=1 TO 8
1580 IF c%(i%,j%)=q% THEN cq%=cq%+1
1590 IF c%(i%,j%)=n% THEN cn%=cn%+1
1600 NEXT j%:NEXT i%
1610 IF cq%>cn% GOTO 1680
1620 IF cq%=cn% GOTO 1630 ELSE 1650
1630 CLS#1:LOCATE #1,25,2:PRINT#1,"BLOQUEADO"
1640 END
1650 CLS#1:LOCATE #1,5,1:PRINT#1,"USTED TIENE ";cq%;" CUADRADOS. YO TENGO ";cn%
1660 LOCATE #1,11,3:PRINT#1,"YO HE GANADO ... !!!"
1670 END
1680 CLS#1:LOCATE #1,5,1:PRINT#1,"USTED TIENE ";cq%;" CUADRADOS. YO TENGO ";cn%
1690 LOCATE #1,5,3:PRINT#1,"MUY BIEN. USTED HA GANADO ... !!!"
1700 END
1710 IF c%(2,2)=q% AND (c%(3,1)=n% OR c%(1,3)=n%) GOTO 1720 ELSE 1730
1720 p%(3,1)=1:p%(1,3)=1
1730 IF c%(7,7)=q% AND (c%(8,6)=n% OR c%(6,8)=n%) GOTO 1740 ELSE 1750
1740 p%(8,6)=1:p%(6,8)=1
1750 IF c%(2,7)=q% AND (c%(1,6)=n% OR c%(3,8)=n%) GOTO 1760 ELSE 1770
1760 p%(1,6)=1:p%(3,8)=1
1770 IF c%(7,2)=q% AND (c%(6,1)=n% OR c%(8,3)=n%) GOTO 1780 ELSE 1790
1780 p%(6,1)=1:p%(8,3)=1
1790 IF d%=1 OR d%=8 OR e%=1 OR e%=8 GOTO 1820
1800 IF cx1%=1 OR cx1%=8 OR cx2%=1 OR cx2%=8 GOTO 1820
1810 RETURN
1820 FOR j%=1 TO 8 STEP 7
1830 FOR i%=2 TO 7
1840 IF c%(i%,j%)=n% GOTO 1850 ELSE 1860
1850 p%(i%+1,j%)=21:p%(i%-1,j%)=21
1860 IF c%(j%,i%)=n% GOTO 1870 ELSE 1880
1870 p%(j%,i%+1)=21:p%(j%,i%-1)=21
1880 NEXT i%
1890 FOR i%=2 TO 7
1900 IF c%(i%,j%)=q% GOTO 1910 ELSE 1920
1910 p%(i%+1,j%)=2:p%(i%-1,j%)=2
1920 IF c%(j%,i%)=q% GOTO 1930 ELSE 1940
1930 p%(j%,i%+1)=2:p%(j%,i%-1)=2
1940 NEXT i%:NEXT j%
1950 p%(1,2)=1:p%(1,7)=1:p%(2,1)=1:p%(7,1)=1
1960 p%(2,8)=1:p%(7,8)=1:p%(8,2)=1:p%(8,7)=1
1970 FOR i%=2 TO 7
1980 IF c%(1,i%-1)=q% AND c%(1,i%+1)=q% THEN p%(1,i%)=25
1990 IF c%(8,i%-1)=q% AND c%(8,i%+1)=q% THEN p%(8,i%)=25
2000 IF c%(i%-1,1)=q% AND c%(i%+1,1)=q% THEN p%(i%,1)=25
2010 IF c%(i%-1,8)=q% AND c%(i%+1,8)=q% THEN p%(i%,8)=25
2020 NEXT i%
2030 FOR j%=1 TO 8 STEP 7
2040 FOR i%=4 TO 8
2050 IF c%(j%,i%)<>n% GOTO 2140
2060 ic%=i%-1:IF c%(j%,ic%)=6 GOTO 2140
2070 IF c%(j%,ic%)=q% GOTO 2080 ELSE 2090
2080 ic%=ic%-1:GOTO 2070
2090 IF c%(j%,ic%)=6 GOTO 2110
2100 GOTO 2140
2110 IF ic%=0 GOTO 2140
2120 IF c%(j%,i%+1)=q% AND c%(j%,ic%-1)=6 GOTO 2140
2130 p%(j%,ic%)=26
2140 IF c%(i%,j%)<>n% GOTO 2230
2150 ic%=i%-1:IF c%(ic%,j%)=6 GOTO 2230
2160 IF c%(ic%,j%)=q% GOTO 2170 ELSE 2180
2170 ic%=ic%-1:GOTO 2160
2180 IF c%(ic%,j%)=6 GOTO 2200
2190 GOTO 2230
2200 IF ic%=0 GOTO 2230
2210 IF c%(i%+1,j%)=q% AND c%(ic%-1,j%)=6 GOTO 2230
2220 p%(ic%,j%)=26
2230 NEXT i%
2240 FOR i%=1 TO 5
2250 IF c%(j%,i%)<>n% GOTO 2340
2260 ic%=i%+1:IF c%(j%,ic%)=6 GOTO 2340
2270 IF c%(j%,ic%)=q% GOTO 2280 ELSE 2290
2280 ic%=ic%+1:GOTO 2270
2290 IF c%(j%,ic%)=6 GOTO 2310
2300 GOTO 2340
2310 IF ic%=9 GOTO 2340
2320 IF c%(j%,i%-1)=q% AND c%(j%,ic%+1)=6 GOTO 2340
2330 p%(j%,ic%)=26
2340 IF c%(i%,j%)<>n% GOTO 2430
2350 ic%=i%+1:IF c%(ic%,j%)=6 GOTO 2430
2360 IF c%(ic%,j%)=q% GOTO 2370 ELSE 2380
2370 ic%=ic%+1:GOTO 2360
2380 IF c%(ic%,j%)=6 GOTO 2400
2390 GOTO 2430
2400 IF ic%=9 GOTO 2430
2410 IF c%(i%-1,j%)=q% AND c%(ic%+1,j%)=6 GOTO 2430
2420 p%(ic%,j%)=26
2430 NEXT i%:NEXT j%
2440 IF c%(1,1)=n% GOTO 2450 ELSE 2460
2450 FOR i%=2 TO 6:p%(1,i%)=20:p%(i%,1)=20:NEXT i%
2460 IF c%(1,8)=n% GOTO 2470 ELSE 2480
2470 FOR i%=2 TO 6:p%(i%,8)=20:p%(1,9-i%)=20:NEXT i%
2480 IF c%(8,1)=n% GOTO 2490 ELSE 2500
2490 FOR i%=2 TO 6:p%(9-i%,1)=20:p%(8,i%)=20:NEXT i%
2500 IF c%(8,8)=n% GOTO 2510 ELSE 2520
2510 FOR i%=3 TO 7:p%(i%,8)=20:p%(8,i%)=20:NEXT i%
2520 IF c%(1,1)<>6 THEN p%(2,2)=5
2530 IF c%(1,8)<>6 THEN p%(2,7)=5
2540 IF c%(8,1)<>6 THEN p%(7,2)=5
2550 IF c%(8,8)<>6 THEN p%(7,7)=5
2560 p%(1,1)=30:p%(1,8)=30:p%(8,1)=30:p%(8,8)=30
2570 FOR i%=3 TO 6
2580 IF c%(1,i%)=n% THEN p%(2,i%)=4
2590 IF c%(8,i%)=n% THEN p%(7,i%)=4
2600 IF c%(i%,1)=n% THEN p%(i%,2)=4
2610 IF c%(i%,8)=n% THEN p%(i%,7)=4
2620 NEXT i%
2630 IF c%(7,1)=q% AND c%(4,1)=n% AND c%(6,1)=6 AND c%(5,1)=6 THEN p%(6,1)=26
2640 IF c%(1,7)=q% AND c%(1,4)=n% AND c%(1,6)=6 AND c%(1,5)=6 THEN p%(1,6)=26
2650 IF c%(2,1)=q% AND c%(5,1)=n% AND c%(3,1)=6 AND c%(4,1)=6 THEN p%(3,1)=26
2660 IF c%(1,2)=q% AND c%(1,5)=n% AND c%(1,3)=6 AND c%(1,4)=6 THEN p%(1,3)=26
2670 IF c%(8,2)=q% AND c%(8,5)=n% AND c%(8,3)=6 AND c%(8,4)=6 THEN p%(8,3)=26
2680 IF c%(2,8)=q% AND c%(5,8)=n% AND c%(3,8)=6 AND c%(4,8)=6 THEN p%(3,8)=26
2690 IF c%(8,7)=q% AND c%(8,4)=n% AND c%(8,5)=6 AND c%(8,6)=6 THEN p%(8,6)=26
2700 IF c%(7,8)=q% AND c%(4,8)=n% AND c%(5,8)=6 AND c%(6,8)=6 THEN p%(6,8)=26
2710 RETURN
2720 pas%=0
2730 FOR i%=1 TO 8
2740 FOR j%=1 TO 8
2750 IF c%(i%,j%)=q% GOTO 2780
2760 NEXT j%:NEXT i%
2770 pas%=1:RETURN
2780 FOR k%=1 TO 8
2790 vr%=0:c3%=i%:c4%=j%
2800 c3%=c3%+c1%(k%):c4%=c4%+c2%(k%)
2810 IF c3%<1 OR c3%>8 GOTO 2820 ELSE 2830
2820 NEXT k%:GOTO 2760
2830 IF c4%<1 OR c4%>8 GOTO 2820 ELSE 2840
2840 IF c%(c3%,c4%)=n% GOTO 2850 ELSE 2860
2850 vr%=vr%+1:GOTO 2800
2860 IF c%(c3%,c4%)=q% GOTO 2820 ELSE 2870
2870 IF vr%>0 THEN RETURN
2880 GOTO 2820
2890 DATA 1,0,30,1,20,10,10,20,1,30,1,1,1,1,3
2900 DATA 3,3,3,1,1,0,1,20,3,5,5,5,5,3,20,-1,1,10,3,5
2910 DATA 0,0,5,3,10,-1,0,10,3,5,0,0,5,3,10,-1
2920 DATA -1,20,3,5,5,5,5,3,20,0,-1,1,1,3,3,3,3,1,1,1,-1,30,1,20,10,10,20,1,30
2930 DATA 263,100,263,120,270,130,255,130,255,130,255,140,255,140,270,140
2940 DATA 270,140,270,150,270,150,255,150,255,160,270,160,270,160,270,180
2950 DATA 270,180,255,180,270,170,255,170,270,190,270,210,270,200,255,200
2960 DATA 255,200,255,210,255,220,270,220,270,220,270,230,270,230,255,230
2970 DATA 255,230,255,240,255,240,270,240,255,250,270,250,270,250,270,260
2980 DATA 270,260,255,260,255,250,255,270,270,280,270,300,270,300,255,300
2990 DATA 255,310,255,330,255,330,270,330,270,330,270,310,270,310,255,310
3000 DATA 255,320,270,320
3010 DATA 310,355,310,375,350,355,335,355,335,355,335,365,335,365,350,365
3020 DATA 350,365,350,375,350,375,335,375,365,355,380,355,380,355,380,375
3030 DATA 380,375,365,375,380,365,365,365,410,355,410,375,410,365,395,365
3040 DATA 395,365,395,375,425,355,440,355,440,355,440,365,440,365,425,365
3050 DATA 425,365,425,375,425,375,440,375,455,375,455,355,455,355,470,355
3060 DATA 470,355,470,365,470,365,455,365,485,375,500,375,500,375,500,355
3070 DATA 515,375,515,355,515,355,530,355,530,355,530,375,530,375,515,375
3080 DATA 515,365,530,365

Programa 15 - Bombardero por Dave Town - AMSOFT 1984

Código fuente en BASIC del juego Bombardero de Dave Town para AMSOFT de 1984. Un juego muy sencillo y muy adictivo.

Código BASIC

10 'BOMBARDERO, por Dave Town
20 'copyright (c) AMSOFT 1984
30 '
40 MODE 1:CLS:INK 0,0:BORDER 0:INK 1,18:INK 2,6:INK 3,4:INK 5,15:INK 6,2:INK 7,24:INK 8,8:INK 9,26:INK 10,10:INK 11,20:INK 12,12
50 SYMBOL AFTER 240:SYMBOL 241,&40,&60,&70,&7F,&7F,&EF,&7,&0:SYMBOL 242,&0,&32,&7A,&FE,&FA,&F2,&E0,&0
60 puntos=0:maximo=0:avi$=CHR$(241)+CHR$(242):x=2:y=2:cae=0:a=2:b=2
70 GOSUB 480
80 CLS
90 PEN 2:LOCATE 1,15:INPUT "Elija nivel: 0 (AS) a 5 (PRINCIPIANTE) ",nivel
100 IF nivel<0 OR nivel>5 THEN GOTO 90
110 nivel=nivel+10
120 LOCATE 1,15:PRINT CHR$(18);:LOCATE 1,15:INPUT"Elija velocidad: 0 (MAX) a 100 (MIN) ",vel
130 IF vel>100 OR vel<0 GOTO 120
140 '
150 'Edificios
160 '
170 MODE 0:FOR base=5 TO 15:FOR altura=21 TO INT(RND(1)*8+nivel) STEP-1:LOCATE base,altura:PEN base-2:PRINT CHR$(143)+CHR$(8)+CHR$(11)+CHR$(244);:NEXT:NEXT
180 PLOT 0,20,4:DRAW 640,20,4
190 LOCATE 1,25:PEN 2:PRINT "PUNTOS";puntos;:LOCATE 12,25: PRINT "MAX";maximo;
200 '
210 'Juego
220 '
230 LOCATE x-1,y:PRINT"   ";
240 PEN 1:LOCATE x,y:PRINT avi$;:PEN 2
250 IF y=21 AND x=15 THEN GOTO 290:ELSE GOTO 340
260 '
270 'Aterriza
280 '
290 FOR c=0 TO 1000:NEXT
300 puntos=puntos+100-(nivel*2):nivel=nivel-1:x=2:y=2:a=2:b=2:cae=0
310 IF nivel<10 THEN nivel=10:vel=vel-20
320 IF vel<0 THEN vel=0
330 GOTO 150
340 FOR c=0 TO vel:NEXT
350 x=x+1
360 IF x=18 THEN LOCATE x-1,y:PRINT CHR$(18);:x=2:y=y+1:LOCATE x,y:PEN 1:PRINT avi$;:PEN 2
370 a$=INKEY$:IF a$=" " AND cae=0 THEN cae=1:b=y+2:a=x
380 IF y=21 THEN cae=0
390 IF cae=1 THEN LOCATE a,b:PRINT CHR$(252);: LOCATE a,b-1:PRINT " ";:b=b+1:IF b>21 THEN LOCATE a,b:PRINT" ";:LOCATE a,b-1:PRINT " ";:a=0:b=0:cae=0:SOUND 3,4000,10,12,0,0,10
400 ga=(a-0.5)*32:gb=400-(b*16):bomba=TEST(ga,gb)
410 IF bomba>0 THEN GOTO 670
420 gx=((x+1.5)*32):gy=408-(y*16):choque=TEST(gx,gy)
430 IF choque>0 THEN GOTO 570
440 GOTO 230
450 '
460 'Instrucciones
470 '
480 LOCATE 1,2:PEN 1:PRINT"Usted esta pilotando un avion sobre una ciudad desierta y tiene que pasar sobre los edificios para aterrizar y repos-   tar. Su avion se mueve de izquierda a derecha.";:PRINT
490 PRINT:PRINT"Al llegar a la derecha, el avion vuelve a salir por la izquierda, pero MAS BAJO.Dispone de un numero limitado de bombas y puede hacerlas caer sobre los edificios pulsando la BARRA ESPACIADORA.";:PRINT
500 PRINT: PRINT"Cada vez que aterriza, sube la altura de los edificios y la velocidad.";:PRINT:PRINT:PRINT"UNA VEZ DISPARADA UNA BOMBA, YA NO PUEDE DISPARAR OTRA MIENTRAS NO HAYA EXPLOSIONADO LA PRIMERA!!!!";
510 PEN 2:LOCATE 1,24:PRINT:PRINT"Pulse una tecla para empezar.";
520 a$=INKEY$:IF a$="" GOTO 520
530 RETURN
540 '
550 ' Colision
560 '
570 LOCATE x-1,y:PRINT CHR$(32)+CHR$(32)+CHR$(32)+CHR$(253)+CHR$(8)+CHR$(238)+CHR$(8);
580 FOR t=1 TO 10:SOUND 7,4000,5,15,0,0,5:PEN t:PRINT CHR$(253)+CHR$(8)+CHR$(238)+CHR$(8)+CHR$(32)+CHR$(8);:FOR tm=0 TO 50:NEXT:NEXT:PEN 2
590 CLS:LOCATE 1,5:PRINT "Ha conseguido";puntos;"puntos."
600 IF puntos>maximo THEN maximo=puntos:LOCATE 1,8:PRINT"BATIO EL RECORD!!";
610 puntos=0:LOCATE 1,12:PRINT "Pulse V para volver a empezar";
620 a$=INKEY$:IF a$="v" OR a$="V" GOTO 630 ELSE GOTO 620
630 PEN 1: MODE 1: x=2: y=2: a=2: b=2: GOTO 90
640 '
650 ' Edificio bombardeado
660 '
670 LOCATE a,b-1:PRINT" "+CHR$(8);: PEN 4:FOR tr=1 TO INT(RND(1)*3)+1:puntos=puntos+5:SOUND 3,4000,10,12,0,0,10:LOCATE a,b:FOR t=0 TO 4:PRINT CHR$(253)+CHR$(8)+CHR$(32)+CHR$(8);:NEXT:b=b+1
680 IF b=24 THEN b=b-1
690 NEXT
700 LOCATE 7,25:PRINT puntos;:cae=0:a=x:b=y:GOTO 230

Programa 14 - Código para dibujar mapas con agua y montañas - AMSTRAD

Este código, escrito en BASIC para AMSTRAD, dibuja un mapa en "3D", representando el agua de color azul y las elevaciones y montañas de color rojo.

Código BASIC

10 DEFINT a-n:INK 0,0:BORDER 0:CLS
20 DIM d(64,32):zzz=TIME:RANDOMIZE zzz
30 INPUT "Nivel de recursion";le
40 MODE 1
50 ds=2:FOR n=1 TO le:ds=ds+2^(n-1):NEXT n
60 mx=ds-1:my=mx/2:rh=PI*30/180:vt=rh*1.2
70 FOR n=1 TO le:l=10000/1.8^n
80 PRINT "Trabajando en el nivel ";n
90 ib=mx/2^n:sk=ib*2
100 GOSUB 160:'Alturas a lo largo de x
110 GOSUB 230:'Alturas a lo largo de y
120 GOSUB 300:'Alturas en la diagonal
130 NEXT n
140 GOTO 650:'Dibujo
150 'Alturas en direccion x
160 FOR ye=0 TO mx-1 STEP sk
170 FOR xe=ib+ye TO mx STEP sk
180 ax=xe-ib:ay=ye:GOSUB 380:d1=d:ax=xe+ib:GOSUB 380:d2=d
190 d=(d1+d2)/2 + RND(1)*l/2-l/4:ax=xe:ay=ye:GOSUB 430
200 NEXT xe
210 NEXT ye:RETURN
220 'Alturas en el eje y
230 FOR xe=mx TO 1 STEP -sk
240 FOR ye=ib TO xe STEP sk
250 ax=xe:ay=ye+ib:GOSUB 380:d1=d:ay=ye-ib:GOSUB 380:d2=d
260 d=(d1+d2)/2+RND(1)*l/2-l/4:ax=xe:ay=ye:GOSUB 430
270 NEXT ye
280 NEXT xe:RETURN
290 'Alturas en la diagonal
300 FOR xe=0 TO mx-1 STEP sk
310 FOR ye=ib TO mx-xe STEP sk
320 ax=xe+ye-ib:ay=ye-ib:GOSUB 380:d1=d
330 ax=xe+ye+ib:ay=ye+ib:GOSUB 380:d2=d
340 ax=xe+ye:ay=ye:d=(d1+d2)/2+RND(1)*l/2-l/4:GOSUB 430
350 NEXT ye
360 NEXT xe:RETURN
370 'Obtencion de datos de la matriz
380 IF ay>my THEN 400
390 by=ay:bx=ax:GOTO 410
400 by=mx+1-ay:bx=mx-ax
410 d=d(bx,by):RETURN
420 'Escritura en la matriz
430 IF ay>my THEN 450
440 by=ay:bx=ax:GOTO 460
450 by=mx+1-ay:bx=mx-ax
460 d(bx,by)=d:RETURN
470 'Aqui se situa el nivel del mar
480 IF x0<>-999 THEN 510
490 IF zz<0 THEN GOSUB 1080:z2=zz:zz=0:GOTO 630
500 GOSUB 1100:GOTO 620
510 IF z2>0 AND zz>0 THEN 620
520 IF z2<0 AND zz<0 THEN z2=zz:zz=0:GOTO 630
530 w3=zz/(zz-z2):x3=(x2-xx)*w3+xx:y3=(y2-yy)*w3+yy:z3=0
540 zt=zz:yt=yy:xt=xx
550 IF zz>0 THEN 600
560 'Aqui va agua
570 zz=z3:yy=y3:xx=x3:GOSUB 960
580 GOSUB 1080:zz=0:yy=yt:xx=xt:z2=zt:GOTO 630
590 'Emerge del agua
600 zz=z3:yy=y3:xx=x3:GOSUB 960
610 GOSUB 1100:zz=zt:yy=yt:xx=xt
620 z2=zz
630 x2=xx:y2=yy:RETURN
640 'Presentacion en pantalla
650 GOSUB 1120:'Inicializa la pantalla
660 xs=0.05:ys=0.05:zs=0.05:'Factores de escala
670 FOR ax=0 TO mx:x0=-999:FOR ay=0 TO ax
680 GOSUB 380:zz=d:yy=ay/mx*10000:xx=ax/mx*10000-yy/2
690 GOSUB 950:NEXT ay:NEXT ax
700 FOR ay=0 TO mx:x0=-999:FOR ax=ay TO mx
710 GOSUB 380:zz=d:yy=ay/mx*10000:xx=ax/mx*10000-yy/2
720 GOSUB 950:NEXT ax:NEXT ay
730 FOR ex=0 TO mx:x0=-999:FOR ey=0 TO mx-ex
740 ax=ex+ey:ay=ey:GOSUB 380:zz=d:yy=ay/mx*10000
750 xx=ax/mx*10000-yy/2:GOSUB 950:NEXT ey:NEXT ex
760 GOTO 1140:'Acabo y sale del bucle
770 'Rotar
780 IF xx<>0 THEN 810
790 IF yy<=0 THEN ra=-PI/2:GOTO 830
800 ra=PI/2:GOTO 830
810 ra=ATN(yy/xx)
820 IF xx<0 THEN ra=ra+PI
830 r1=ra+rh:rd=SQR(xx*xx+yy*yy)
840 xx=rd*COS(r1):yy=rd*SIN(r1)
850 RETURN
860 '????
870 rd=SQR(zz*zz+xx*xx)
880 IF xx=0 THEN ra=PI/2:GOTO 910
890 ra=ATN(zz/xx)
900 IF xx<0 THEN ra=ra+PI
910 r1=ra-vt
920 xx=rd*COS(r1)+xx:zz=rd*SIN(r1)
930 RETURN
940 'Moverse a (xp,yp)
950 GOSUB 480
960 xx=xx*xs:yy=yy*ys:zz=zz*zs
970 GOSUB 780:'Rotar
980 GOSUB 870:'????
990 IF x0=-999 THEN pr$="M" ELSE pr$="D"
1000 xp=INT(yy)+cx:yp=INT(zz)
1010 GOSUB 1040
1020 RETURN
1030 'dibujar
1040 xp=xp*1.1:yp=yp+260:IF pr$="M" OR f1=1 THEN x8=xp:y8=yp
1050 PLOT x8,y8,f1:DRAW xp,yp,f1:x8=xp:y8=yp:x0=xp
1060 RETURN
1070 'Color del mar
1080 f1=14:RETURN
1090 'Color de tierra
1100 f1=3:RETURN
1110 'Inicializar pantalla o plotter
1120 CLS:RETURN
1130 'Salida
1140 a$=INKEY$:WHILE LEN(a$)=0:a$=INKEY$:WEND
1150 STOP