Programa 023 - SUPERMAN

Juego de SUPERMAN escrito 100% en BASIC para AMSTRAD CPC. SUPERMAN by F.E.O. 

http://fremos.cheesetea.com/download/superman-1996/

Código BASIC

10 ' SUPERMAN ,por F.E.O.
20 '
30 '
40 REM
50 REM
60 REM  ********************************
70 REM  ** DEFINICIONES, PRESENTACION ** 
80 REM  **\\\\\\\\\\\\\\\\\\\\\\\\\\\\**
90 REM  **       SOLO GRAFICOS        **
100 REM ********************************
110 REM
120 REM
130 '
140 ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
150 ' >>> DEFINICIONES, TINTAS, ETC. >>>
160 ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
170 '
180 '
190 DEFINT A-Z
195 DEFREAL t
200 SYMBOL AFTER 256: SPEED WRITE 1
210 MODE 1: BORDER 0
220 INK 0,0: INK 1,6: INK 2,2: INK 3,26
222 INK 4,3: INK 5,16: INK 6,11: INK 7,13
224 INK 8,24: INK 9,1: INK 10,1: INK 11,0
226 ENT 2,2,4,8: ENV 1,4,3,18
230 '
240 '
250 ' <<<<<<<<<<<<<<<<<<<<<<<<
260 ' << DEFINIR CARACTERES <<
270 ' <<<<<<<<<<<<<<<<<<<<<<<<
280 '
290 SYMBOL AFTER 123
300 ' 
310 ' >>>    Planeta    <<<
320 '
330 SYMBOL 124,3,7,15,17,56,126,63
340 SYMBOL 125,192,128,240,248,156,12,248,192
350 SYMBOL 126,0,0,0,0,0,0,0,192
360 SYMBOL 127,0,0,0,0,0,0,0,3
370 SYMBOL 128,7,192,120,15,23,12,7,3
380 SYMBOL 129,224,3,30,244,120,16,224,192
390 SYMBOL 130,248,63,7,0,0,0,0,0
400 SYMBOL 131,31,252,224,0,0,0,0,0
410 '
420 ' >>>   Superman 1   <<<
430 '
440 SYMBOL 132,112,60,31,255,255,159,28,0
450 SYMBOL 133,0,0,128,192,128,0,0,0
460 SYMBOL 134,0,0,48,32,0,0,0,0
470 SYMBOL 135,0,0,0,18,1,0,0,0
480 SYMBOL 136,0,0,0,12,126,0,0,0
490 '
500 ' >>>   Superman 2   <<<
510 '
520 SYMBOL 137,16,62,63,159,255,158,48,32
530 SYMBOL 138,0,0,0,32,0,0,0,0
540 '
550 ' >>>   Superman 3   <<<
560 '
570 SYMBOL 139,0,28,63,159,255,159,24,48 
580 '
590 ' >>>   Rayo de Superman   <<<
600 '
610 SYMBOL 140,0,0,0,15,0,0,0,0 
620 '
630 ' >>>   Superman muerto   <<<
640 '
650 SYMBOL 141,0,0,6,255,255,128,0,0
660 SYMBOL 142,0,0,48,254,255,0,0,0
670 '
680 ' >>>   CHOF   <<<
690 '
700 SYMBOL 144,0,0,0,120,200,239,109,55
710 SYMBOL 145,0,0,1,31,54,247,142,124
720 SYMBOL 146,32,4,144,0,52,16,18,8
730 SYMBOL 147,0,80,8,128,9,8,112,128
740 '
750 ' >>>   Meteorito   <<<
760 '
770 SYMBOL 148,32,49,123,95,250,118,60,8
780 '
790 ' >>>   Avion   <<<
800 '
810 SYMBOL 149,0,3,7,47,79,255,7,3
820 SYMBOL 150,0,0,0,16,48,0,0,0
830 '
840 ' >>>   Misil   <<<
850 '
860 SYMBOL 151,0,63,127,255,255,127,63,0
870 SYMBOL 152,0,248,248,248,248,248,248,0
880 SYMBOL 153,0,7,4,6,4,7,6,0
890 '
900 ' >>>   Fuego del misil   <<<
910 '
920 SYMBOL 154,0,6,7,4,7,4,0,0
930 '
940 ' >>>   Explosion   <<<
950 '
960 SYMBOL 155,36,119,46,225,68,118,220,20 
970 SYMBOL 156,0,0,16,30,56,8,0,0
980 '
990 ' >>>   Mar y ola   <<<
1000 '
1010 SYMBOL 157,0,0,0,0,65,237,255,255
1020 SYMBOL 158,16,56,28,15,14,2,0,0
1030 '
1040 ' >>>   Estrella   <<<
1050 '
1060 SYMBOL 159,0,32,112,32,0,0,0,0
1070 '
1071 ' >>>   Luna   <<<
1072 '
1073 SYMBOL 160,2,28,56,40,88,112,176,240 
1074 SYMBOL 161,144,240,80,88,56,40,28,6
1075 '
1076 ' >>> Icono SUPERMAN <<<
1077 '
1080 SYMBOL 162,0,66,102,0,0,0,24,60
1090 SYMBOL 163,0,0,24,60,126,126,0,0
1100 SYMBOL 164,90,24,0,0,0,0,0,0
1112 '
1113 ' **************************
1114 ' *** PROGRAMA PRINCIPAL ***
1115 ' **************************
1116 '
1120 GOSUB 9030:    ' Presentacion
1130 GOSUB 10820:   ' Menu de opciones
1135 MODE 0
1140 GOSUB 11100:   ' Imprime pantalla de juego
1150 superX=2:superY=10
1160 DIM maloX(2),maloY(2),malodir(2),malo(2)
1168 malos=0: nivel=3: t=TIME: savep=0: sv2=100
1170 GOSUB 9510:    ' Imprime Superman
1180 GOSUB 11900:    ' Activar Olas
1190 REM
1200 REM ---- Bucle principal ----
1210 REM
1400 FOR xd=1 TO 3
1410   IF xd=1 OR xd=3  THEN GOSUB 12050:    ' Movimientos de Superman
1411   IF xd=2 THEN GOSUB 13130:    ' Movimientos enemigos
1412   IF NOT(pts> savep+4000) THEN 1415 
1413    vidas=vidas+1: GOSUB 11764
1414    savep=savep+4000+sv2: sv2=sv2+nivel*150
1415   IF choque=3 THEN choque=0
1420   IF choque=0 THEN 1470
1430   IF choque=1 THEN GOSUB 20000
1440   IF choque=2 THEN superY=superY+1: retorno=1: GOSUB 20000: GOSUB 20242
1450   IF vidas=0 THEN
1460   superX=2: superY=10: GOSUB 11764: GOSUB 11900
1470   IF TIME> t+60000 THEN nivel=nivel+1: t=t+60000
1480   IF nivel=4 AND malos=0 THEN
1490   IF malos<2 AND nivel<4 THEN GOSUB 15000
1491   GOSUB 60000:   ' Desactivar varibles no activas
1500 NEXT xd
1510 GOTO 1400
7900 '
7910 ' >>>>>>>>>>>>>>>>>>>
7920 ' >>> IMPRESIONES >>>
7930 ' >>>>>>>>>>>>>>>>>>>
7940 ' 
7950 ' ---   Imprime planeta   ---
7960 '
7970 GOSUB 10050
7980 PEN 1:LOCATE planX,planY:PRINT CHR$(124)+CHR$(125);
7990 PEN 3:LOCATE planX,planY:PRINT CHR$(126)+CHR$(127);
8000 PEN 1:LOCATE planX,planY+1:PRINT CHR$(128)+CHR$(129);
8010 PEN 3:LOCATE planX,planY+1:PRINT CHR$(130)+CHR$(131);
8020 GOSUB 10100
8025 RETURN
8030 '
8040 ' ---   Imprime Superman 1   ---
8050 '
8070 PEN 1:LOCATE superX,superY:PRINT CHR$(132)+CHR$(133); 
8080 PEN 4:LOCATE superX+1,superY:PRINT CHR$(134);  
8090 PEN 5:LOCATE superX+1,superY:PRINT CHR$(135);  
8100 PEN 2:LOCATE superX+1,superY:PRINT CHR$(136); 
8110 RETURN
8120 '
8130 ' ---   Imprime Superman 2   ---
8140 '
8160 PEN 1:LOCATE superX,superY:PRINT CHR$(137)+CHR$(133); 
8170 PEN 4:LOCATE superX+1,superY:PRINT CHR$(134); 
8180 PEN 5:LOCATE superX+1,superY:PRINT CHR$(135); 
8190 PEN 2:LOCATE superX,superY:PRINT CHR$(138)+CHR$(136); 
8195 RETURN
8210 '
8220 ' ---   Imprime Superman 3   ---
8230 '
8250 PEN 1:LOCATE superX,superY:PRINT CHR$(139)+CHR$(133); 
8260 PEN 4:LOCATE superX+1,superY:PRINT CHR$(134); 
8270 PEN 5:LOCATE superX+1,superY:PRINT CHR$(135); 
8280 PEN 2:LOCATE superX,superY:PRINT CHR$(138)+CHR$(136); 
8290 RETURN
8300 '
8310 ' ---   Imprime Rayo de Superman   ---
8320 '
8325 colorayo=1
8330 GOSUB 10060
8340 PEN colorayo:LOCATE rayoX,rayoY:PRINT CHR$(140);
8350 GOSUB 10110
8355 RETURN
8360 '
8370 ' ---   Imprime Superman muerto   ---
8380 '
8400 PEN 4:LOCATE superX,superY:PRINT CHR$(141)+CHR$(142);
8415 RETURN
8420 '
8430 ' ---   Imprime CHOF   ---
8440 '
8450 GOSUB 10050
8460 PEN 2:LOCATE chofX,chofY:PRINT CHR$(144)+CHR$(145);  
8470 PEN 6:LOCATE chofX,chofY:PRINT CHR$(146)+CHR$(147);  
8480 GOSUB 10100
8485 RETURN
8490 '
8500 ' ---   Imprime meteorito   ---
8510 '
8530 PEN metcolor:LOCATE meteoX,meteoY:PRINT CHR$(148);
8545 RETURN
8550 '
8560 ' ---   Imprime Avion   ---
8570 '
8580 GOSUB 10050
8590 PEN avicolor:LOCATE avionX,avionY:PRINT CHR$(149);
8600 PEN 6:LOCATE avionX,avionY:PRINT CHR$(150); 
8610 GOSUB 10100
8615 RETURN
8620 '
8630 ' ---   Imprime misil   ---
8640 '
8650 GOSUB 10050
8660 PEN 7:LOCATE misilX,misilY:PRINT CHR$(151)+CHR$(152);
8670 PEN 1:LOCATE misilX+1,misilY:PRINT CHR$(153);
8680 fuegomis=fuegomis+1
8690 IF fuegomis=3 THEN fuegomis=1
8721 IF fuegomis=2 THEN 8735
8730 PEN 1:LOCATE misilX+1,misilY:PRINT CHR$(153);
8733 GOTO 8740
8735 PEN 1:LOCATE misilX+1,misilY:PRINT CHR$(154);
8740 GOSUB 10100
8745 RETURN
8750 '
8760 ' ---   Imprime explosion   ---
8770 '
8780 GOSUB 10050
8790 PEN 1:LOCATE expX,expY:PRINT CHR$(155); 
8800 PEN 8:LOCATE expX,expY:PRINT CHR$(156); 
8810 GOSUB 10100
8815 RETURN
8820 '
8821 ' ---   Imprime Mar   ---
8822 '
8824 GOSUB 10050
8825 color=10
8826 FOR xpo=1 TO 20
8828   PEN 9: LOCATE xpo,18: PRINT CHR$(157);
8830   color=color+1: IF color=12 THEN color=10
8835   PEN color: LOCATE xpo,18: PRINT CHR$(158);
8840 NEXT xpo  
8850 GOSUB 10100
8860 RETURN
8890 '
8900 ' ---   Imprime estrella   ---
8910 '
8930 PEN 8:LOCATE estX,estY:PRINT CHR$(159);
8945 RETURN
8950 '
8960 ' ---   Imprime Luna   ---
8970 '
8980 GOSUB 10050
8990 PEN 3:LOCATE lunaX,lunaY:PRINT CHR$(160);
9000 LOCATE lunaX,lunaY+1:PRINT CHR$(161); 
9010 GOSUB 10100
9015 RETURN
9020 '
9030 ' >>>    Presentacion    <<<
9040 '
9045 RESTORE 10200
9050 FOR c=5 TO 10
9060 FOR b=3 TO 38
9070 READ p,a
9080 PEN p:LOCATE b,c:PRINT CHR$(a);
9090 NEXT b:NEXT c
9100 LOCATE 2,13: PEN 3: PRINT"MENU DE OPCIONES"
9110 LOCATE 5,15: PEN 1: PRINT"1 JUGAR."
9120 LOCATE 5,18: PAPER 2: PRINT "2 TECLADO."
9130 LOCATE 5,21: PAPER 0: PRINT "3 JOYSTICK."
9140 planX=23: planY=15: GOSUB 7950
9150 lunaX=27: lunaY=17: GOSUB 8960
9170 planX=27: planY=21: GOSUB 7950
9180 planX=31: planY=17: GOSUB 7950
9190 planX=34: planY=22: GOSUB 7950
9200 lunaX=36: lunaY=14: GOSUB 8960
9205 metcolor=1
9210 meteoX=27: meteoY=15: GOSUB 8500
9220 meteoX=24: meteoY=19: GOSUB 8500
9230 meteoX=31: meteoY=20: GOSUB 8500
9235 metcolor=3
9240 meteoX=39: meteoY=15: GOSUB 8500
9250 meteoX=38: meteoY=21: GOSUB 8500
9255 avicolor=2
9260 avionX=32: avionY=15: GOSUB 8560
9270 avionX=35: avionY=20: GOSUB 8560
9280 RETURN
9290 '
9300 ' >>> Imprime Icono Superman <<<
9310 '
9320 GOSUB 10060
9330 LOCATE iconoX,iconoY: PEN 2: PRINT CHR$(162);
9340 LOCATE iconoX,iconoY: PEN 1: PRINT CHR$(163);
9350 LOCATE iconoX,iconoY: PEN 5: PRINT CHR$(164);
9360 GOSUB 10110
9370 RETURN
9500 '
9510 ' >>>    Imprime Superman    <<< 
9520 '
9530 superpos=superpos+1
9540 IF superpos=4 THEN superpos=1
9550 GOSUB 10060
9560 ON superpos GOSUB 8040, 8130, 8220
9570 GOSUB 10110
9580 RETURN
10000 '
10010 '
10020 ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
10030 ' >>> Subrutinas del MODO TRANSPARENTE <<<
10040 ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
10050 '
10060 ' Activar modo transparente
10070 '
10080 LOCATE 39,24:PRINT CHR$(22);CHR$(1);
10090 RETURN
10100 '
10110 ' Desactivar modo transparente
10120 '
10130 LOCATE 39,24:PRINT CHR$(22);CHR$(0);  
10140 RETURN
10150 '
10160 ' /////////////\\\\\\\\\\\\\\\
10170 ' ///   Datos "SUPERMAN"   \\\
10180 ' /////////////\\\\\\\\\\\\\\\
10190 '
10200 DATA 1,214,1,143,1,215,0,32  
10210 DATA 1,143,0,32,1,143,0,32
10220 DATA 1,143,1,143,1,215,0,32
10230 DATA 1,143,1,143,1,143,0,32
10240 DATA 1,143,1,143,1,215,0,32
10250 DATA 1,214,1,143,1,143,1,143
10260 DATA 1,215,0,32
10270 DATA 1,214,1,143,1,215,0,32
10280 DATA 1,214,1,143,1,215,0,32
10290 DATA 1,143,0,32
10300 DATA 1,143,2,214,2,143,2,215
10310 DATA 1,143,2,143,1,143,2,143
10320 DATA 1,143,2,143,1,143,2,215
10330 DATA 1,143,2,143,2,143,2,143
10340 DATA 1,143,2,143,1,143,2,215
10350 DATA 1,143,2,214,1,143,2,143
10360 DATA 1,143,2,215
10370 DATA 1,143,2,214,1,143,2,215
10380 DATA 1,143,2,214,1,143,2,215
10390 DATA 1,143,2,143
10400 DATA 1,213,1,143,1,215,0,32
10410 DATA 1,143,2,143,1,143,2,143
10420 DATA 1,143,1,143,1,212,2,143 
10430 DATA 1,143,1,143,1,143,0,32
10440 DATA 1,143,1,143,1,215,2,143
10450 DATA 1,143,2,143,1,143,2,143
10460 DATA 1,143,2,143
10470 DATA 1,143,1,143,1,143,2,143
10480 DATA 1,143,2,143,1,143,2,143
10490 DATA 1,143,2,143
10500 DATA 0,32,2,213,1,143,2,215
10510 DATA 1,143,2,143,1,143,2,143
10520 DATA 1,143,2,143,2,143,2,212
10530 DATA 1,143,2,143,2,143,2,143
10540 DATA 1,143,2,143,1,143,2,215
10550 DATA 1,143,2,143,1,143,2,143
10560 DATA 1,143,2,143
10570 DATA 1,143,2,143,1,143,2,143
10580 DATA 1,143,2,143,1,143,2,143
10590 DATA 1,143,2,143
10600 DATA 1,213,1,143,1,212,2,143
10610 DATA 1,213,1,143,1,212,2,143
10620 DATA 1,143,2,143,0,32,0,32
10630 DATA 1,143,1,143,1,143,0,32
10640 DATA 1,143,2,143,1,143,2,143
10650 DATA 1,143,2,143,1,143,2,143
10660 DATA 1,143,2,143
10670 DATA 1,143,2,143,1,143,2,143
10680 DATA 1,143,2,143,1,213,1,143
10690 DATA 1,212,2,143
10700 DATA 0,32,2,213,2,143,2,212
10710 DATA 0,32,2,213,2,143,2,212
10720 DATA 0,32,2,143,0,32,0,32
10730 DATA 0,32,2,143,2,143,2,143
10740 DATA 0,32,2,143,0,32,2,143
10750 DATA 0,32,2,143,0,32,2,143
10760 DATA 0,32,2,143
10770 DATA 0,32,2,143,0,32,2,143
10780 DATA 0,32,2,143,0,32,2,213
10790 DATA 2,143,2,212
10800 '
10810 ' )))))))))))))))))))))))))))))
10820 ' )))))  Menu De Opciones (((((
10830 ' (((((((((((((((((((((((((((((
10840 '
10850 control=1
10860 CO$=UPPER$(INKEY$)
10870   IF CO$="1" THEN 10910
10880   IF co$="2" THEN GOSUB 10930
10890   IF co$="3" THEN GOSUB 11010
10900 GOTO 10860
10910 RETURN
10920 '
10930 ' === Teclado seleccionado
10940 '
10950 IF control=1 THEN 10990
10955 PEN 1
10960 LOCATE 5,18: PAPER 2: PRINT "2 TECLADO."
10970 LOCATE 5,21: PAPER 0: PRINT "3 JOYSTICK."
10980 control=1 
10990 RETURN
11000 '
11010 ' === Joystick seleccionado
11020 '
11030 IF control=2 THEN 11070
11035 PEN 1
11040 LOCATE 5,21: PAPER 2: PRINT "3 JOYSTICK."
11050 LOCATE 5,18: PAPER 0: PRINT "2 TECLADO."
11060 control=2
11070 RETURN
11080 '
11090 ' )))))))))))))))))))))))))))))))))))
11100 ' )))  Imprime pantalla de juego  (((
11110 ' (((((((((((((((((((((((((((((((((((
11120 '
11130 '
11140 ' === Imprime decorado planetario
11150 '
11160 planX=3: planY=2: GOSUB 7950
11170 planX=13: planY=1: GOSUB 7950
11180 lunaX=8: lunaY=3: GOSUB 8960
11190 meteoX=10: meteoY=2: metcolor=4: GOSUB 8500
11200 meteoX=17: GOSUB 8500
11210 meteoX=14: meteoY=4: metcolor=1: GOSUB 8500
11220 estX=6: estY=1: GOSUB 8900
11230 estX=11: GOSUB 8900
11240 estX=17: GOSUB 8900
11250 estY=4: GOSUB 8900
11260 estX=5: GOSUB 8900
11270 estX=10: GOSUB 8900
11280 estX=19: GOSUB 8900
11290 estY=2: GOSUB 8900
11300 estX=8: GOSUB 8900
11310 estX=2: GOSUB 8900
11320 estX=15: estY=3: GOSUB 8900
11330 GOSUB 8821
11340 pts=0: GOSUB 11720
11350 vidas=3: GOSUB 11764
11360 RETURN
11700 '
11710 ' ((((((((((((((((((((((((((
11720 ' ))) IMPRIME PUNTUACION (((
11730 ' ))))))))))))))))))))))))))
11740 '
11750 LOCATE 2,20: PEN 2: PRINT "PUNTOS:";
11760 PEN 1: PRINT USING "######,";pts
11761 RETURN
11762 '
11763 ' (((((((((((((((((((((
11764 ' ))) IMPRIME VIDAS (((
11765 ' )))))))))))))))))))))
11766 '
11770 LOCATE 2,22: PEN 1: PRINT "VIDAS:"
11780 LOCATE 9,22: PRINT STRING$(11," ")
11790 IF vidas>4 THEN 11840
11795 icopos=9
11800 WHILE icopos<vidas*2+9
11810   iconoX=icopos: iconoY=22: GOSUB 9300
11815   icopos=icopos+2
11820 WEND 
11830 GOTO 11890
11840 '
11850 ' - mas de 4 vidas
11860 '
11870 iconoX=9: iconoY=22: GOSUB 9300
11880 LOCATE 11,22: PEN 2: PRINT vidas
11890 RETURN
11900 '
11910 ' ====================
11920 ' === ACTIVAR OLAS ===
11930 ' ====================
11940 '
11950 SPEED INK 6,6:INK 11,1,0:INK 10,0,1
11960 RETURN
11970 '
11980 ' ======================= 
11990 ' === DESACTIVAR OLAS ===
12000 ' =======================
12010 INK 11,0:INK 10,1 
12020 RETURN
12030 '
12040 ' (((((((((((((((((((((((((((((((
12050 ' ))) Movimientos de Superman )))
12060 ' ((((((((((((((((((((((((((((((( 
12070 '
12075 ' Teclado
12076 '
12078 IF fire=1 THEN GOSUB 12580
12080 LOCATE superX,superY: PRINT"  "
12090 IF control=2 THEN 12180 
12100 a$=UPPER$(INKEY$)
12110 IF "Q"=a$ THEN GOSUB 12270
12120 IF "A"=a$ THEN GOSUB 12350
12130 IF "O"=a$ THEN GOSUB 12420
12140 IF "P"=a$ THEN GOSUB 12490
12150 IF " "=a$ THEN GOSUB 12570
12160 GOTO 12250
12170 '
12180 ' Joystick
12190 '
12200 IF JOY(0)=1 THEN GOSUB 12270
12210 IF JOY(0)=2 THEN GOSUB 12350
12220 IF JOY(0)=4 THEN GOSUB 12420
12230 IF JOY(0)=8 THEN GOSUB 12490
12240 IF JOY(0)>=16 THEN GOSUB 12570
12250 IF choque=2 THEN 12255
12252 GOSUB 9510
12255 RETURN
12260 '
12270 ' Arriba
12280 '
12290 IF superY=6 THEN RETURN
12300 SuperY=SuperY-1
12310 GOSUB 30000
12330 RETURN
12340 '
12350 ' Abajo
12360 '
12370 IF superY=17 THEN choque=2: RETURN
12380 superY=superY+1
12390 GOSUB 30000
12400 RETURN
12410 '
12420 ' Izquierda
12430 '
12440 IF superX=1 THEN RETURN
12450 superX=superX-1
12460 GOSUB 30000
12470 RETURN
12480 '
12490 ' Derecha
12500 '
12510 IF superX=15 THEN RETURN
12520 superX=superX+1
12530 GOSUB 30000
12540 RETURN
12550 '
12560 ' Disparo
12561 '
12570 IF fire=0 THEN 12580 
12572  LOCATE rayoX,rayoY: PRINT " "
12574  GOTO 12590
12580 IF fire=1 THEN 12620
12590 fire=1
12600 rayoX=superX+1: rayoY=superY: GOSUB 8310
12605 SOUND 1,100,15,15,,2
12606 FOR un=1 TO 2
12607   IF rayoX+1=maloX(un) AND rayoY=maloY(un) THEN 12609
12608 NEXT un: GOTO 12610
12609 rayoX=rayoX+1: GOSUB 60500: fire=0: GOSUB 9510
12610 RETURN
12620 colorayo=0: GOSUB 8330
12630 rayoX=rayoX+1
12640 IF rayoX=21 THEN rayoX=0: rayoY=0: fire=0: RETURN
12650 GOSUB 30500:  ' Comprobaciones de choque
12660 IF choqrayo=0 THEN 12700
12670 ON choqrayo GOSUB 12730,12840,12980 
12673 LOCATE rayoX, rayoY
12675 IF rayoX<20 THEN PRINT"  " ELSE PRINT" "
12680 fire=0
12690 RETURN
12700 GOSUB 8310
12710 RETURN
12720 '
12730 ' Rayo choca con meteorito
12740 '
12750 expX=rayoX: expY=rayoY: GOSUB 8760
12760 SOUND 1,1950,15,15,,2,6
12770 pts=pts+150: GOSUB 11720
12780 malos=malos-1: malo(mm)=0
12820 RETURN
12830 '
12840 ' Rayo choca con avion
12850 '
12860 expX=rayoX: expY=rayoY: GOSUB 8760
12870 SOUND 1,1950,15,15,,2,6
12880 FOR espera=1 TO 200:NEXT espera
12890 LOCATE expX,expY: PRINT" "
12900 pts=pts+250: GOSUB 11720 
12910 malos=malos-1: malo(mm)=0
12950 RETURN
12960 '
12970 ' Rayo choca con misil
12980 '
12990 expX=rayoX: expY=rayoY: GOSUB 8760
13000 SOUND 1,1950,15,15,,2,6
13010 expX=expX+1: GOSUB 8760
13020 SOUND 1,1950,15,15,,2,6
13030 FOR espera=1 TO 200:NEXT espera
13040 LOCATE expX,expY: PRINT"  "
13050 pts=pts+400: GOSUB 11720
13060 malo(mm)=0: malos=malos-1
13100 RETURN 
13110 '
13120 ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
13130 ' <<< Movimientos de los enemigos >>>
13140 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
13150 '
13170 FOR tpt=1 TO 2
13180   ON malo(tpt) GOSUB 13270,13570,13760
13190 NEXT tpt
13250 RETURN
13260 '
13270 ' Mueve el meteorito
13280 '
13290 LOCATE maloX(tpt),maloY(tpt):PRINT" "
13300 IF malodir(tpt)=2 THEN 13420
13301 '
13302 ' -- En horizontal 
13304 '
13310 maloX(tpt)=maloX(tpt)-1
13320 IF maloX(tpt)=0 THEN malo(tpt)=0: malos=malos-1: RETURN 
13330 meteoX=maloX(tpt): meteoY=maloY(tpt): metcolor=4: GOSUB 8500
13340 IF maloX(tpt)=superX+1 AND maloY(tpt)=superY THEN choque=1: RETURN
13342 IF NOT( maloX(tpt)=rayoX AND maloY(tpt)=rayoY ) THEN 13350
13344   mm=tpt: GOSUB 12730: LOCATE rayoX,rayoY: PRINT" "
13346   fire=0: RETURN 
13350 GOSUB 62000: ' Choque entre 2 malos(comprobacion)
13353 IF NOT(chocan=1) THEN RETURN
13360   chX=maloX(tpt): chY=maloY(tpt): GOSUB 40000
13370   IF choque=1 THEN RETURN
13400 RETURN
13410 '
13420 ' -- En vertical
13430 '
13440 maloX(tpt)=maloX(tpt)-1: maloY(tpt)=maloY(tpt)+1
13450 IF maloX(tpt)=0 THEN malo(tpt)=0: malos=malos-1: RETURN
13460 IF maloY(tpt)=18 THEN malo(tpt)=0: GOSUB 43000: malos=malos-1: RETURN
13470 meteoX=maloX(tpt): meteoY=maloY(tpt): metcolor=4: GOSUB 8500 
13480 IF ( maloX(tpt)=superX+1 OR maloX(tpt)=superX ) AND maloY(tpt)=superY THEN choque=1: RETURN
13482 IF NOT( maloX(tpt)=rayoX AND maloY(tpt)=rayoY ) THEN 13350
13484   mm=tpt: GOSUB 12730: LOCATE rayoX,rayoY: PRINT" "
13486   fire=0: RETURN  
13490 GOSUB 62000: ' Choque entre 2 malos(Comprobacion)
13493 IF NOT(chocan=1) THEN RETURN
13500   chX=maloX(tpt): chY=maloY(tpt): GOSUB 40000
13510   IF choque=1 THEN RETURN
13520   GOTO 13550
13530 IF tpt=1 THEN trv=2 ELSE trv=1
13535 IF malo(trv)<>3 THEN 13550
13540 IF maloX(tpt)=maloX(trv)+1 AND maloY(tpt)=maloY(trv) THEN 13500 
13550 RETURN
13560 '
13570 ' Mueve el avion
13580 '
13590 LOCATE maloX(tpt),maloY(tpt):PRINT" "
13600 maloX(tpt)=maloX(tpt)-1
13610 aumento=INT(RND*6)
13620 IF aumento<4 THEN 13650
13630 IF aumento=4 AND maloY(tpt)>6 THEN maloY(tpt)=maloY(tpt)-1
13640 IF aumento=5 AND maloY(tpt)<17 THEN maloY(tpt)=maloY(tpt)+1
13650 IF maloX(tpt)=0 THEN malo(tpt)=0: malos=malos-1: RETURN
13660 avionX=maloX(tpt): avionY=maloY(tpt): avicolor=12: GOSUB 8560
13670 IF (maloX(tpt)=superX+1 OR maloX(tpt)=superX) AND maloY(tpt)=superY THEN choque=1: RETURN
13680 IF NOT( maloX(tpt)=rayoX AND maloY(tpt)=rayoY ) THEN 13710
13690   mm=tpt: GOSUB 12840: LOCATE rayoX,rayoY: PRINT" "
13700   fire=0: RETURN
13710 GOSUB 62000: ' Choque entre 2 malos(comprobacion)
13713 IF NOT(chocan=1) THEN RETURN
13720   chX=maloX(tpt): chY=maloY(tpt): GOSUB 40000
13730   IF choque=1 THEN RETURN
13740 RETURN
13750 '
13760 ' Mueve el misil
13770 '
13780 LOCATE maloX(tpt),maloY(tpt):PRINT"  "
13790 maloX(tpt)=maloX(tpt)-1
13800 aumento=INT(RND*4)
13810 IF aumento<2 THEN
13820 IF aumento=2 AND maloY(tpt)>5 THEN maloY(tpt)=maloY(tpt)-1 
13830 IF aumento=3 AND maloY(tpt)<17 THEN maloY(tpt)=maloY(tpt)+1
13840 IF maloX(tpt)=0 THEN malo(tpt)=0: malos=malos-1: RETURN
13850 misilX=maloX(tpt): misilY=maloY(tpt): GOSUB 8630
13860 IF maloY(tpt)=superY AND (maloX(tpt)=superX+1 OR maloX(tpt)=superX OR maloX(tpt)+1=superX+1 OR maloX(tpt)+1=superX) THEN choque=1: RETURN
13870 IF NOT( (maloX(tpt)=rayoX OR maloX(tpt)+1=rayoX) AND maloY(tpt)=rayoY ) THEN  13900
13880   mm=tpt: GOSUB 12980: LOCATE rayoX,rayoY: PRINT" "
13890   fire=0: RETURN
13900 GOSUB 62000: ' Choque entre 2 malos(comprobacion)
13903 IF NOT(chocan=1) THEN RETURN
13910   chX=maloX(tpt): chY=maloY(tpt): GOSUB 40000
13920   IF choque=1 THEN RETURN
13930 RETURN
15000 '
15010 ' ---------------------
15020 ' --- Activar malos ---
15030 ' ---------------------
15040 '
15050 malos=malos+1
15055 salvamal=malos
15056 FOR saber=1 TO 2
15057   IF malo(saber)=0 THEN malos=saber: GOTO 15060 
15058 NEXT saber
15060 saleel=INT(RND*nivel)+1
15070 ON saleel GOSUB 15110, 15210, 15300
15075 malos=salvamal
15080 IF malos<2 THEN 15050
15090 RETURN
15100 '
15110 ' Meteorito
15120 ' 
15130 malo(malos)=1: malodir(malos)= INT(RND*2)+1
15140 IF malodir(malos)=2 THEN 15170
15150   maloY(malos)=INT(RND*12)+6
15160   maloX(malos)=20: GOTO 15185
15170 maloY(malos)=5
15180 maloX(malos)=INT(RND*14)+6
15185 IF  ( maloX(1)=maloX(2)  OR  maloX(1)+1=maloX(2) )  AND  maloY(1)=maloY(2)  THEN  15130
15187 meteoX=maloX(malos): meteoY=maloY(malos): metcolor=4: GOSUB 8500
15190 RETURN
15200 '
15210 ' Avion
15220 '
15230 malo(malos)=2
15240 maloX(malos)=20
15250 maloY(malos)=INT(RND*12)+6
15260 IF  ( maloX(1)=maloX(2)  OR  maloX(1)+1=maloX(2) )  AND  maloY(1)=maloY(2)  THEN  15230
15270 avionX=20: avionY=maloY(malos): avicolor=12: GOSUB 8560 
15280 RETURN
15290 '
15300 ' Misil
15310 '
15320 malo(malos)=3
15330 maloX(malos)=19
15340 maloY(malos)=INT(RND*12)+6
15345 IF malos=1 THEN mell=2 ELSE mell=1
15350 IF maloX(1)=maloX(2) AND maloY(1)=maloY(2) THEN 15320 
15360 IF maloX(malos)+1=maloX(mell) AND maloY(1)=maloY(2) THEN 1320
15370 misilX=19: misilY=maloY(malos): GOSUB 8630
15380 RETURN
20000 REM
20010 REM ========================
20020 REM === muerte jugador 1 ===
20030 REM ========================
20040 REM 
20041 '
20042 ' Inicializar variables y borrar zona de juego
20043 '
20044 FOR r=1 TO malos
20045   IF malo(r)=0 THEN 20048
20046   LOCATE maloX(r),maloY(r): malo(r)=0
20047   IF maloX(r)=20 THEN PRINT" " ELSE PRINT"  "
20048   maloX(r)=0
20049 NEXT r
20050 IF fire=1 THEN LOCATE rayoX,rayoY: PRINT" ": fire=0 
20051 malos=0
20052 IF retorno=1 THEN retorno=0:RETURN
20057 '
20058 ' Explosion
20059 '
20060 GOSUB 10100
20080 FOR e=1 TO 4
20090 expX=superX-2+e
20095 IF expX=0 THEN expX=1
20100 expY=superY
20110 GOSUB 8760: SOUND 1,1950,15,15,,2,6
20120 FOR f=1 TO 300:NEXT f:NEXT e 
20125 FOR f=1 TO 400:NEXT f 
20126 '
20127 ' Chamuscado
20128 '
20130 GOSUB 10100
20140 GOSUB 8370
20150 GOSUB 10100
20160 LOCATE superX+2,superY: PRINT"  " 
20162 IF superX>1 THEN LOCATE superX-1,superY:PRINT" "
20170 '
20180 ' Caida al agua
20190 '
20195 u=200
20200 FOR r=superY TO 18
20205 superY=r
20210 GOSUB 10100  
20220 GOSUB 8370:SOUND 1,u,20,15:u=u+10:FOR f=1 TO 300:NEXT f 
20230 LOCATE superX,r: PRINT"  " 
20240 NEXT r
20242 '
20244 ' Chof
20246 '
20250 GOSUB 11990
20260 GOSUB 10100
20270 chofX=superX:chofY=superY
20280 GOSUB 8430: SOUND 1,0,90,15,1,,5
20290 FOR h=1 TO 500:NEXT h:GOSUB 10100  
20300 LOCATE chofX,chofY: PRINT "  "
20310 GOSUB 8820  
20320 vidas=vidas-1
20325 choque=0
20330 RETURN
30000 '
30010 ' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30020 ' ::: Comprobaciones de choque :::
30030 ' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30040 '
30045 choque=0
30050 FOR comp=1 TO 2
30060   IF maloX(comp)=superX AND maloY(comp)=superY THEN 30410
30070   IF maloX(comp)=superX+1 AND maloY(comp)=superY THEN 30410
30072   IF malo(comp)<>3 THEN 30080
30074     IF maloX(comp)+1=superX AND maloY(comp)=superY THEN 30410
30080 NEXT comp
30400 GOTO 30420
30410 choque=1
30420 RETURN
30500 '
30510 ' *****************************************
30520 ' +++ Comprobaciones de choque del rayo +++
30530 ' *****************************************
30540 '
30550 choqrayo=0: mm=0
30560   IF maloX(1)=rayoX AND maloY(1)=rayoY THEN choqrayo=malo(1):mm=1
30570   IF maloX(2)=rayoX AND maloY(2)=rayoY THEN choqrayo=malo(2):mm=2
30610 RETURN
40000 '
40010 ' ******************************
40020 ' *** Choque entre dos malos ***
40030 ' ******************************
40040 '
40050 ini=chX-1:fin=chX+2
40055 IF chX<2 THEN ini=ini+1
40056 contar=0
40057 IF chX>18 THEN fin=fin-1
40060 FOR dfg=ini TO fin
40070   expX=dfg: expY=chY: GOSUB 8760
40080   contar=contar+1
40090   SOUND 1,1950,15,15,,2,6
40095   IF (ini=superX OR ini=superX+1) AND chY=superY THEN choque=1
40100   FOR espera=1 TO 300: NEXT espera
40110 NEXT
40120 LOCATE ini,chY: PRINT STRING$(contar," ")
40130 malo(2)=0: maloX(1)=0
40140 malo(1)=0: maloX(2)=0
40145 malos=0
40150 RETURN
43000 '
43010 ' Chof del meteorito
43020 '
43030 chofX=maloX(tpt): chofY=maloY(tpt)
43035 IF chofX=0 THEN chofX=1
43036 GOSUB 8430
43040 SOUND 1,0,90,15,1,,5
43050 FOR espera=1 TO 500: NEXT espera
43060 LOCATE chofX,chofY: PRINT"  "
43070 GOSUB 10060
43080 LOCATE chofX,18
43090 IF chofX/2=INT(chofX/2) THEN peni=10 ELSE peni=11
43100 PEN 9: PRINT CHR$(157);
43110 LOCATE chofX,18: PEN peni: PRINT CHR$(158);
43120 LOCATE chofX+1,18: PEN 9: PRINT CHR$(157);
43130 LOCATE chofX+1,18
43140 IF peni=10 THEN PEN 11 ELSE PEN 10
43150 PRINT CHR$(158);
43155 GOSUB 10110
43160 RETURN
60000 '
60010 ' +++++++++++++++++++++++++++++++++++++++++
60020 ' +++ Desactivar variables no deseables +++
60030 ' +++++++++++++++++++++++++++++++++++++++++
60040 '
60050 IF fire=0 THEN rayoX=0:rayoY=0
60060 IF malo(1)=0 THEN maloX(1)=0: maloY(1)=0
60070 IF malo(2)=0 THEN maloX(2)=0: maloY(2)=0
60080 RETURN
60500 '
60510 ' Rayo choca nada mas ser disparado
60520 '
60530 GOSUB 30500 : 'Comprobaciones de choque
60540 ON choqrayo GOSUB 12730,12840,12980
60550 LOCATE maloX(mm),maloY(mm): PRINT"  "
60560 RETURN
62000 '
62010 ' Choque entre 2 malos (comprobacion)
62020 '
62025 chocan=0
62030 IF maloX(1)=maloX(2) AND maloY(1)=maloY(2) THEN chocan=1:RETURN
62040 FOR com=1 TO 2
62050   IF malo(com)<>3 THEN 62090
62060   IF com=1 THEN com2=2 ELSE com2=1
62070   IF NOT(maloX(com)+1=maloX(com2) AND maloY(com)=maloY(com2)) THEN 62090
62080     chocan=1: RETURN
62090 NEXT com
62100 RETURN

Programa 022 - Efecto MATRIX

Programa para AMSTRAD CPC escrito en BASIC que emula el efecto MATRIX, ese en el que van cayendo las letras verdes por la pantalla.

Código BASIC

10 REM *********************
20 REM *** Efecto Matrix ***
30 REM *** FlynnTron1982 ***
40 REM ***   15-12-2019  ***
50 REM **********************
60 REM *** Inicializacion ***
70 REM **********************
80 MODE 0
90 DIM tinta(16):pluma=1
100 INK 0,0:BORDER 18
110 SYMBOL AFTER 126:SYMBOL 126,&X11111111,&X10000001,&X10000001,&X0000001,&X0000001,&X000001,&X00011,&X011
120 SYMBOL 127,&X00001,&X0001,&X0001,&X001,&X010001,&X0100001,&X10000001,&X11111111
130 SYMBOL 128,&X000111,&X00001,&X01111111,&X01001001,&X01001001,&X01111111,&X01001001,&X01001001
140 SYMBOL 129,&X11111,&X10000111,&X01000001,&X00100001,&X0001001,&X0000111,&X000001,&X01111
150 SYMBOL 130,&X0000001,&X0010001,&X000101,&X000011,&X0000101,&X0001,&X001,&X11
160 SYMBOL 131,&X01000001,&X01000001,&X01111111,&X0100001,&X0000001,&X000001,&X00011,&X011
170 SYMBOL 132,&X01111111,&X0,&X0,&X01111111,&X0000001,&X000001,&X00011,&X011
180 SYMBOL 133,&X1111111,&X1000001,&X1000001,&X1111111,&X1000001,&X1000001,&X1111111,&X0001
190 SYMBOL 134,&X00011,&X001001,&X001001,&X00011,&X0110011,&X10000001,&X10000001,&X0111111
200 SYMBOL 135,&X10000001,&X10000001,&X10000001,&X1000001,&X1000001,&X000001,&X00011,&X111
210 REM **********************************
220 REM *** Carga la paleta de colores ***
230 REM **********************************
240 FOR t=1 TO 15
250 READ paleta
260 tinta(t)=paleta
270 INK t,tinta(t)
280 NEXT t
290 REM ****************************************
300 REM *** Prepara el texto en modo grafico ***
310 REM ****************************************
320 TAG
330 REM ***********************
340 REM *** Bucle Principal ***
350 REM ***********************
360 CALL &BD19
370 x=INT(RND*640)
380 y=INT(RND*600)
390 color=0
400 espacio=INT(RND*16)+20
410 REM *****************************
420 REM *** Columna de caracteres ***
430 REM *****************************
440 FOR linea=0 TO 10
450 color=color+1
460 letra=INT(RND*10)+125
470 MOVE x,y-(linea*espacio),color:PRINT CHR$(letra);
480 REM ************************
490 REM *** Ciclo de colores ***
500 REM ************************
510 FOR t=1 TO 9
520 pluma=pluma-1:IF pluma<1 THEN pluma=10
530 INK pluma,tinta(t)
540 NEXT t
550 NEXT linea
560 FRAME
570 GOTO 370
580 REM *************************************
590 REM *** Datos de la paleta de colores ***
600 REM *************************************
610 DATA 26,25,21,18,9,0,0,0,0,0,0,0,0,0,0

Programa 21 - TÚNEL

Código fuente escrito en BASIC para AMSTRAD CPC que dibuja una especie de túnel 3D en menos de 20 lineas.

Código BASIC

10 REM ***********************************
20 REM *** Poligonos ciclo de colores  ***
30 REM ***        FlynnTron1982        ***
40 REM ***         16-12-2019          ***
50 REM ***********************************
60 MODE 1
70 BORDER 0:INK 0,0:INK 1,1:INK 2,6:INK 3,1:CLS
80 DEG
90 ORIGIN 320,200
100 radio=640
110 lados=3
120 FOR t=0 TO 360 STEP 5
130 col=col+1:IF col>3 THEN col=1
140 FOR ang=0 TO 359 STEP 360/lados
150 IF ang=0 THEN MOVE radio*COS(ang+t),radio*SIN(ang+t) ELSE DRAW radio*COS(ang+t),radio*SIN(ang+t),col
160 NEXT ang
170 DRAW radio*COS(t),radio*SIN(t),col
180 MOVE 0,0:FILL col
190 radio=radio-10:IF radio<10 THEN GOTO 210
200 NEXT t
210 INK 1,1:INK 2,6:INK 3,1:FOR t=1 TO 50:NEXT
220 INK 1,6:INK 2,1:INK 3,1:FOR t=1 TO 50:NEXT
230 INK 1,1:INK 2,1:INK 3,6:FOR t=1 TO 50:NEXT
240 GOTO 210

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