Programillas en BASIC

[cacharreo]

He hecho unos pequeños cambios en "Crash" (2009) de @badaman del que ha salido esta nueva versión, "M40 Kamikaze".

• Puntuación (arriba)
• Carrera de día o de noche (cada 5000 puntos)
• Cada día que pasa (con su día y su noche) aumenta la dificultad (más coches en contra)
• Al alcanzar la máxima dificultad, cada día aumenta la velocidad del juego

M40 Kamikaze demo

(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)



M40.bas

Código: Seleccionar todo

100 REMark crash_bas - 2009 - badaman
110 REMark M40_bas "M40 kamikaze" - 2024 - cacharreo
120 REMark procedimientos y funciones
130 REMark modo dia o noche
140 DEFine PROCedure nightmode(m)
150   IF m=0 THEN
160     cl1=4
170     cl2=6
180   ELSE
190     cl1=2
200     cl2=0
210   END IF
220   OPEN #ca,scr_448x220a32x16
230   PAPER #ca,cl1: CLS#ca: INK#ca,1
240   WINDOW #ca,(an+2)*16,(al+1)*20,32+(448-((an+2)*16))/2,16+(220-((al+1)*20))/2
250   PAPER #ca,cl1,cl2,3: CLS #ca
260   WINDOW #ca,an*16,(al+1)*20,32+(448-(an*16))/2,16+(220-((al+1)*20))/2
270   PAPER #ca,cl2: CLS#ca: CSIZE#ca,3,1
280   camino$(tp)=lin$
290 END DEFine
300 REMark Inicializacion del programa
310 MODE 8: CLS: CLS #0
320 REMark cambia "an" = ancho pista
330 al=10: an=11: REMark vals. 2 a 28
340 sc=0: REMark puntuacion
350 nm=0: REMark modo dia o noche
360 spd=5: REMark velocidad
370 nv=3: REMark dificultad (1 dific. a 5 facil)
380 han=INT(an/2): h=han: ch=h+1: v=al: cv=v
390 coche$=CHR$(174): otro$=CHR$(183)
400 lin$=FILL$(" ",an): tp=0: sw=0
410 DIM camino$(al,an)
420 ca=5
430 FOR i=0 TO al: camino$(i)=lin$
440 nightmode(nm)
450 REMark Ciclo principal
460 REPeat carrera
470   ov=v: oh=h
480   IF KEYROW(1)=4 AND v>1 AND cv>1
490     IF camino$(cv-1,ch)<>" " THEN sw=1: ELSE cv=cv-1: v=v-1
500   END IF
510   IF KEYROW(1)=128 AND v<al THEN cv=cv+1: v=v+1
520   IF KEYROW(1)=2  AND ch>1  THEN ch=ch-1: h=h-1
530   IF KEYROW(1)=16 AND ch<an THEN ch=ch+1: h=h+1
540   cv=cv-1: IF cv<0 THEN cv=al
550   REMark borra puntuacion
560   INK #ca,1: AT #ca,0,an-7: PRINT #ca,"       "
570   REMark enemigos
580   tp=tp-1: IF tp<0 THEN tp=al
590   camino$(tp)=lin$
600   n=RND(0 TO nv)
610   IF NOT n
620     n=RND(1 TO an)
630     AT #ca,0,n-1: PRINT #ca,otro$
640     camino$(tp,n)=otro$
650   END IF
660   REMark borrado coche
670   AT #ca,ov,oh: PRINT #ca," "
680   REMark puntuacion
690   sc=sc+10
700   IF sc>999999 THEN sc=0
710   sc$="000000"&sc
720   scl=LEN(sc$)
730   sc$=sc$(scl-5 TO scl)
740   REMark cambio de colores cada 5000 puntos
750   IF sc MOD 5000=0 THEN
760     nm=1-nm
770     nightmode(nm)
780     REMark cada dia que pase, se hace mas dificil
790     IF NOT nm THEN
800       REMark aumenta la dificultad
810       IF nv>1 THEN
820         nv=nv-1
830       ELSE
840         REMark aumenta la velocidad
850         IF spd>1 THEN spd=spd-1
860       END IF
870     END IF
880   END IF
890   SCROLL #ca,20
900   AT #ca,0,an-7:PRINT #ca,sc$
910   INK #ca,2: AT #ca,v,h: PRINT #ca,coche$
920   IF camino$(cv,ch)<>" " OR sw THEN EXIT carrera
930 PAUSE spd
940 END REPeat carrera
950 AT #ca,v,h: PRINT #ca,"*";
960 AT #ca,2,2: PRINT #ca,"Crash!"
970 CSIZE #ca,0,0: CLOSE #ca

Si te animas, puedes usar un pequeño programa llamado defcarac, creado por Zerover, que tienes en sinclairql.es:
...
Para redefinir los caracteres del juego.

Nueva versión del programa M40 Kamikaze con gráficos definidos por el usuario (UDG).

M40 Kamikaze 1.00 demo

(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)

Código: Seleccionar todo

100 REMark crash_bas - 2009 - badaman
110 REMark M40_bas "M40 kamikaze" 1.00
120 REMark controles:
130 REMark   flechas de cursor y O P Q A
140 :
150 velocidad = 1: REMark 1 = normal 0.5 = doble 2 = mitad
160 :
170 REMark ##########################################
180 REMark funciones comunes
190 REMark ##########################################
200 :
210 DEFine PROCedure espera(ratico)
220   REMark espera un ratico
230   LOCal d
240   FOR d = 0 TO velocidad*ratico: REMark pausa
250 END DEFine espera
260 :
270 DEFine PROCedure nightmode(m)
280   REMark modo dia o noche
290   IF m = 0 THEN
300     cl1 = 4
310     cl2 = 6
320   ELSE
330     cl1 = 2
340     cl2 = 0
350   END IF
360   IF oca THEN WINDOW #ca, 448,220, 32, 16: ELSE OPEN #ca, scr_448x220a32x16: oca = 1
370   PAPER #ca, cl1: CLS#ca: INK#ca, 1: CLS
380   WINDOW #ca, (an+2)*16, (al+1)*20, 32+(448-((an+2)*16))/2, 16+(220-((al+1)*20))/2
390   PAPER #ca, cl1, cl2, 3: CLS #ca
400   WINDOW #ca, an*16, (al+1)*20, 32+(448-(an*16))/2, 16+(220-((al+1)*20))/2
410   PAPER #ca, cl2: CLS#ca: CSIZE#ca, 3, 1
420   camino$(tp) = lin$
430 END DEFine nightmode
440 :
450 REMark ##########################################
460 REMark funciones UDG
470 REMark ##########################################
480 :
490 DEFine PROCedure udgSet(ch, n)
500   REMark define UDG set (User Defined Graphics)
510   LOCal i, p, v
520   system_variables_base_address = 163840: REMark default QL ROM system variables address
530   v$ = VER$: IF v$ == "JSL1" OR v$ == "HBA" THEN system_variables_base_address = VER$(-2)
540   channel_base_address = PEEK_L(system_variables_base_address)
550   channel_header_address = PEEK_L(channel_base_address + 4*ch)
560   REMark get and save font2 base address
570   pointer_enviroment_offset = 0: REMark 0 or 48
580   font2_base_address = PEEK_L(46 + pointer_enviroment_offset + (PEEK_L(PEEK_L(system_variables_base_address + 120) + 4*ch)))
590   REMark get udg memory space & set udg address
600   udg_address = RESPR(9*(n + 2) + 2)
610   POKE_L 46 + pointer_enviroment_offset + (PEEK_L(PEEK_L(system_variables_base_address + 120) + 4*ch)), udg_address
620   p = udg_address
630   POKE p, 127: POKE p + 1, n: p = p + 2
640   FOR i = 1 TO 9: POKE p, 0: p = p + 1
650   FOR i = 1 TO 9*n: READ v: POKE p, v: p = p + 1
660   FOR i = 1 TO 9: POKE p, 0: p = p + 1
670 END DEFine udgSet
680 :
690 DEFine PROCedure udgUnset(ch)
700   REMark restore system font pointers
710   POKE_L 46 + pointer_enviroment_offset + (PEEK_L(PEEK_L(system_variables_base_address + 120) + 4*ch)), font2_base_address
720 END DEFine udgUnset
730 :
740 REMark ##########################################
750 REMark datos UDG (9x6 pixels)
760 REMark ##########################################
770 :
780 DATA 48, 252, 252, 72, 204, 252, 72, 252, 252: REMark coche 1
790 DATA 72, 252, 252, 120, 120, 72, 204, 252, 120: REMark coche 2
800 DATA 8, 80, 36, 144, 36, 16, 168, 68, 0: REMark crash
810 :
820 REMark Inicializacion del programa
830 :
840 MODE 8: CLS: CLS #0
850 REMark an = ancho pista
860 al = 10: an = 11: REMark vals. 2 a 28
870 sc = 0: REMark puntuacion
880 nm = 0: REMark modo dia o noche
890 spd = 5: REMark velocidad
900 nv = 3: REMark dificultad (1 dific. a 5 facil)
910 han = INT(an/2): h = han: ch = h+1: v = al: cv = v
920 coche$ = CHR$(128): otro$ = CHR$(129)
930 lin$ = FILL$(" ", an): tp = 0: sw = 0
940 DIM camino$(al, an)
950 FOR i = 0 TO al: camino$(i) = lin$
960 ca = 1: REMark canal de la ventana de juego
970 oca = 0: nightmode(nm)
980 :
990 REMark UDG
1000 :
1010 RESTORE 780: udgSet ca, 3: REMark define UDG
1020 :
1030 REMark Ciclo principal
1040 :
1050 REPeat carrera
1060   ov = v: oh = h
1070   IF (KEYROW(1) && 4 OR KEYROW(6) && 8) AND v > 1 AND cv > 1
1080     IF camino$(cv-1, ch) <> " " THEN sw = 1: ELSE cv = cv-1: v = v-1
1090   END IF
1100   IF (KEYROW(1) && 128 OR KEYROW(4) && 16) AND v < al THEN cv = cv+1: v = v+1
1110   IF (KEYROW(1) && 2 OR KEYROW(5) && 128)  AND ch > 1  THEN ch = ch-1: h = h-1
1120   IF (KEYROW(1) && 16 OR KEYROW(4) && 32) AND ch < an THEN ch = ch+1: h = h+1
1130   cv = cv-1: IF cv < 0 THEN cv = al
1140   REMark borra puntuacion
1150   INK #ca, 1: AT #ca, 0, an-7: PRINT #ca, "       "
1160   REMark enemigos
1170   tp = tp-1: IF tp < 0 THEN tp = al
1180   camino$(tp) = lin$
1190   n = RND(0 TO nv)
1200   IF NOT n
1210     n = RND(1 TO an)
1220     AT #ca, 0, n-1: PRINT #ca, otro$
1230     camino$(tp, n) = otro$
1240   END IF
1250   REMark borrado coche
1260   AT #ca, ov, oh: PRINT #ca, " "
1270   REMark puntuacion
1280   sc = sc+10
1290   IF sc > 999999 THEN sc = 0
1300   sc$ = "000000"&sc: scl = LEN(sc$): sc$ = sc$(scl-5 TO scl)
1310   :
1320   REMark cambio de colores cada 5000 puntos
1330   :
1340   IF NOT (sc MOD 5000) THEN
1350     nm = 1-nm
1360     nightmode(nm)
1370     REMark cada dia que pase, se hace mas dificil el juego
1380     IF NOT nm THEN
1390       REMark aumenta la dificultad
1400       IF nv > 1 THEN
1410         nv = nv-1
1420       ELSE
1430         REMark aumenta la velocidad
1440         IF spd > 1 THEN spd = spd-1
1450       END IF
1460     END IF
1470   END IF
1480   SCROLL #ca, 20
1490   AT #ca, 0, an-7:PRINT #ca, sc$
1500   INK #ca, 2: AT #ca, v, h: PRINT #ca, coche$
1510   IF camino$(cv, ch) <> " " OR sw THEN EXIT carrera
1520   espera 10000 + 2000*spd
1530 END REPeat carrera
1540 AT #ca, v, h: PRINT #ca, CHR$(130);
1550 AT #ca, 2, 3: PRINT #ca, "Crash!"
1560 REMark restaura la pantalla (modo monitor)
1570 kk$ = INKEY$(0): PAUSE
1580 CSIZE #ca, 0, 0: WINDOW #ca, 256, 202, 256, 0: BORDER #ca, 1, 255: PAPER #ca, 2: INK #ca, 7: MODE 2

[IgnacioMonge]

¿Y además de todos tus proyectos, tienes tiempo para programar en BASIC?
Empiezo a pensar que eres una inteligencia superior que nos domina y nos supervisa, llevándonos a la supremacía de la tecnología retro para después destruirnos sin piedad

[Mikes]

Ahora dirá: "Nah, eso son dos minutos de relax entre proyecto y proyecto" JEJEJE

[cacharreo]

Todo esto viene de aquí: Taller de QL básico

Estuve en este taller que organizó @badaman y como tropecientos años atrás programé en BASIC, una vez superado el escollo de poder tener una plataforma de desarrollo para QL usando el emulador sQLux y manejarse con imágenes de disco y microdrives, programar algo corto en el SUPERBASIC de QL que es bastante similar al Sinclair BASIC de los ZX no cuesta tanto.

Esto del BASIC del QL lo hice en la mañana ayer, como dice @Mikes estoy entre proyectos, esperando componentes y placas por el enorme retraso debido a las celebraciones del año nuevo lunar chino que comenzaron a finales de Enero y aún siguen, como mínimo hasta mañana. Es el sino de cada año, por esta época se pillan casi un mes de vacaciones y mientras hay que dedicarse a otras cosas.

[cacharreo]

Nueva versión disponible
Basado en un borrador de un código que no funcionaba de @djcaye.

misil0 demo

(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)

Código: Seleccionar todo

100 REMark misilismos
110 REMark controles: OPQA Space
120 sw=150:sh=101:REMark tamano de pantalla
130 sc=0:REMark puntuacion
140 MODE 8:CLS:ch=5:OPEN #ch,scr_448x220a32x16
150 PAPER #ch,0:INK #ch,7:CLS #ch:BORDER #ch,1,4
160 hp=sw/2:vp=sh/2:REMark Variables posicion de nave (hp,vp) y de meteoritos (x,y)
170 x=RND(1 TO sw-1):y=sh:REMark coordenadas iniciales meteorito
180 dx=2*RND(0 TO 1)-1:REMark direccion de caida
190 REMark Ciclo principal
200 REMark Caida meteorito 1
210 ox=x:oy=y
220 x=x+dx:y=y-1
230 INK #ch,4:LINE #ch,ox,oy TO x,y
240 REMark Movimientos y disparo + mecanismo de fin de meteorito + salto al segundo meteorito
250 ohp=hp:ovp=vp
260 REMark borra nave
270 INK #ch,0:CIRCLE #ch,hp,vp,1
280 IF KEYROW(5)=128 THEN hp=hp-1:IF hp<3 THEN hp=sw-3
290 IF KEYROW(6)=8 AND vp<sh-3 THEN vp=vp+1
300 IF KEYROW(4) && 16 AND vp>2 THEN vp=vp-1
310 IF KEYROW(4) && 32 THEN hp=hp+1:IF hp>sw-3 THEN hp=1
320 REMark muestra nave
330 INK #ch,2:CIRCLE #ch,hp,vp,1
340 REMark abandonar el juego con ESC
350 IF KEYROW(1)=8 THEN STOP
360 REMark - mecanismo de eliminacion de enemigo
370 IF KEYROW(1)=64 THEN
380   IF ABS(hp-x)<2 AND ABS(vp-y)<2 THEN
390     sc=sc+50
400     IF sc>999999 THEN sc=0
410     INK #ch,7
420     FOR r=1 TO 12
430       CIRCLE #ch,hp,vp,r
440       FOR d=0 TO 1000:REMark pausa
450     NEXT r
460     GO TO 140
470   END IF
480 END IF
490 REMark mecanismos de fin de juego al llegar meteorito 1 al suelo y evitar que meteorito 1 salga por extremo derecho
500 IF y<1 THEN GO TO 640
510 IF x<1 THEN
520   x=sw
530 ELSE
540   IF x>=sw THEN x=1
550 END IF
560 REMark muestra puntuacion
570 sc$="000000"&sc
580 scl=LEN(sc$)
590 sc$=sc$(scl-5 TO scl)
600 INK #ch,7:AT #ch,0,0:PRINT #ch,sc$
610 FOR d=0 TO 25000:REMark pausa
620 REMark fin del ciclo principal
630 GO TO 190
640 REMark fin del juego
650 INK #ch,7:BORDER #ch,1,4
660 AT #ch,9,14:PRINT #ch,"GAME OVER"
670 PAUSE:REMark espera una tecla
680 GO TO 100

[Onlyfordj]

Flipante

[cacharreo]

Nueva versión disponible
Otra versión con una ciudad de fondo.

misil1 demo

(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)

Código: Seleccionar todo

100 REMark misilismos
110 REMark controles: OPQA Space
120 scw=36:sw=157:sh=101:REMark tamano de pantalla
130 sc=0:REMark puntuacion
140 skyline=RND(0 TO 255):REMark semilla aleatoria para los edificios de la ciudad
150 MODE 8:CLS:ch=5:OPEN #ch,scr_448x212a32x16
160 PAPER #ch,0:INK #ch,7:CLS #ch:BORDER #ch,1,4
170 REMark muestra la ciudad
180 RANDOMISE skyline
190 PAPER #ch,2:INK #ch,1:FOR x=0 TO scw:FOR y=0 TO RND(0 TO 2):AT #ch,20-y,x:PRINT #ch,CHR$(254):NEXT y:NEXT x:PAPER #ch,0
200 RANDOMISE
210 REMark inicializacion
220 hp=sw/2:vp=sh/2:REMark Variables posicion de nave (hp,vp) y de meteoritos (x,y)
230 x=RND(1 TO sw-1):y=sh:REMark coordenadas iniciales meteorito
240 dx=2*RND(0 TO 1)-1:REMark direccion de caida
250 REMark Ciclo principal
260 REMark Caida meteorito 1
270 ox=x:oy=y
280 x=x+dx:y=y-1
290 INK #ch,4:LINE #ch,ox,oy TO x,y
300 REMark Movimientos y disparo + mecanismo de fin de meteorito + salto al segundo meteorito
310 ohp=hp:ovp=vp
320 REMark borra nave
330 INK #ch,0:CIRCLE #ch,hp,vp,1
340 IF KEYROW(5)=128 THEN hp=hp-1:IF hp<3 THEN hp=sw-3
350 IF KEYROW(6)=8 AND vp<sh-3 THEN vp=vp+1
360 IF KEYROW(4) && 16 AND vp>16 THEN vp=vp-1
370 IF KEYROW(4) && 32 THEN hp=hp+1:IF hp>sw-3 THEN hp=1
380 REMark muestra nave
390 INK #ch,2:CIRCLE #ch,hp,vp,1
400 REMark abandonar el juego con ESC
410 IF KEYROW(1)=8 THEN STOP
420 REMark - mecanismo de eliminacion de enemigo
430 IF KEYROW(1)=64 THEN
440   IF ABS(hp-x)<2 AND ABS(vp-y)<2 THEN
450     sc=sc+50
460     IF sc>999999 THEN sc=0
470     INK #ch,7
480     FOR r=1 TO 12
490       CIRCLE #ch,hp,vp,r
500       FOR d=0 TO 1000:REMark pausa
510     NEXT r
520     GO TO 150
530   END IF
540 END IF
550 REMark mecanismos de fin de juego al llegar meteorito 1 al suelo y evitar que meteorito 1 salga por extremo derecho
560 IF y<1 THEN GO TO 700
570 IF x<1 THEN
580   x=sw
590 ELSE
600   IF x>=sw THEN x=1
610 END IF
620 REMark muestra puntuacion
630 sc$="000000"&sc
640 scl=LEN(sc$)
650 sc$=sc$(scl-5 TO scl)
660 INK #ch,7:AT #ch,0,0:PRINT #ch,sc$
670 FOR d=0 TO 25000:REMark pausa
680 REMark fin del ciclo principal
690 GO TO 250
700 REMark fin del juego
710 INK #ch,7:BORDER #ch,1,4
720 AT #ch,9,14:PRINT #ch,"GAME OVER"
730 PAUSE:REMark espera una tecla
740 GO TO 100

[cacharreo]

Nueva versión disponible
Una nueva versión (hasta 5 bombas a la vez).

misil2 demo

Código: Seleccionar todo

100 REMark misilismos
110 REMark controles: OPQA Space ESC
120 DEFine PROCedure delay
130   FOR d=0 TO 25000:REMark pausa
140 END DEFine
150 REMark constantes
160 ch=5:REMark canal para la pantalla
170 scw=36:sw=157:sh=101:REMark tamano de pantalla
180 nbmax=5:REMark maximo numero de bombas
190 REMark variables
200 RANDOMISE
210 DIM b(nbmax-1,5):REMark datos de las bombas 0=x 1=y 2=dx 3=dy 4=ox 5=oy
220 REMark Comienzo e inicializacion
230 sc=0:REMark puntuacion
240 nb=RND(1 TO nbmax)-1:REMark numero de bombas lanzadas-1
250 nbc=nb:REMark numero de bombas en curso-1
260 firesignal=0:REMark evita que se deje pulsado el disparo
270 hp=sw/2:vp=sh/2:REMark posicion de nave (hp,vp)
280 REMark inicializacion bombas
290 x=0:dx=sw/(nb+1)
300 FOR i=0 TO nb
310   b(i,0)=x+RND(dx/2):b(i,1)=sh:REMark coordenadas iniciales bomba
320   b(i,3)=RND(3 TO 5)/10:b(i,2)=(2*RND(0 TO 1)-1)*b(i,3):REMark velocidad de caida
330   x=x+dx
340 NEXT i
350 REMark muestra la ciudad
360 MODE 8:CLS:OPEN #ch,scr_448x212a32x16
370 PAPER #ch,0:INK #ch,7:CLS #ch:BORDER #ch,1,4
380 PAPER #ch,2:INK #ch,1:FOR x=0 TO scw:FOR y=0 TO RND(0 TO 2):AT #ch,20-y,x:PRINT #ch,CHR$(254):NEXT y:NEXT x:PAPER #ch,0
390 REMark Ciclo principal
400 REMark disparo
410 fire=0
420 IF firesignal THEN
430   IF KEYROW(1)=0 THEN firesignal=0
440 ELSE
450   IF KEYROW(1)=64 THEN fire=1:firesignal=1
460 END IF
470 REMark bomba
480 INK #ch,4
490 gameover=0
500 FOR i=0 TO nb
510   b(i,4)=b(i,0):b(i,5)=b(i,1):REMark guarda antiguas coordenadas
520   b(i,0)=b(i,0)+b(i,2):b(i,1)=b(i,1)-b(i,3):REMark caida bomba
530   LINE #ch,b(i,4),b(i,5) TO b(i,0),b(i,1)
540   IF b(i,1)<1 THEN gameover=1:REMark fin del juego
550   REMark control de los bordes de la pantalla
560   IF b(i,0)<1 THEN
570     b(i,0)=sw
580   ELSE
590     IF b(i,0)>=sw THEN b(i,0)=1
600   END IF
610   IF fire AND ABS(hp-b(i,0))<2 AND ABS(vp-b(i,1))<2 THEN
620     b(i,2)=0:b(i,3)=0:REMark detener bomba
630     sc=sc+50
640     IF sc>999999 THEN sc=0
650     INK #ch,7
655     FOR r1=0 TO 1
660       FOR r2=1 TO 12
670         CIRCLE #ch,hp,vp,ABS(r2-13*r1)
680         FOR d=0 TO 1000:REMark pausa
690       NEXT r2
695       INK #ch,0
697     NEXT r1
700     INK #ch,4
710     REMark Nuevo juego cuando no quedan bombas
720     nbc=nbc-1
730     IF nbc<0 THEN GO TO 240
740   END IF
750 NEXT i
760 fire=0
770 REMark muestra puntuacion
780 sc$="000000"&sc
790 scl=LEN(sc$)
800 sc$=sc$(scl-5 TO scl)
810 INK #ch,7:AT #ch,0,0:PRINT #ch,sc$
820 REMark fin del juego
830 IF gameover THEN
840   INK #ch,7:BORDER #ch,1,4
850   AT #ch,9,14:PRINT #ch,"GAME OVER"
860   REMark Espera hasta que no haya ninguna tecla pulsada
870   k=0
880   FOR i=0 TO 7
890     IF KEYROW(i)<>0 THEN k=1
900   NEXT i
910   IF k THEN GO TO 870
920   PAUSE:REMark espera una tecla
930   GO TO 220
940 END IF
950 REMark nave
960 ohp=hp:ovp=vp
970 REMark borra nave
980 INK #ch,0:CIRCLE #ch,hp,vp,1
990 IF KEYROW(5)=128 THEN hp=hp-1:IF hp<3 THEN hp=sw-3
1000 IF KEYROW(6)=8 AND vp<sh-3 THEN vp=vp+1
1010 IF KEYROW(4) && 16 AND vp>28 THEN vp=vp-1
1020 IF KEYROW(4) && 32 THEN hp=hp+1:IF hp>sw-3 THEN hp=1
1030 REMark muestra nave
1040 INK #ch,2:CIRCLE #ch,hp,vp,1
1050 REMark abandonar el juego con ESC
1060 IF KEYROW(1)=8 THEN STOP
1070 delay
1080 REMark fin del ciclo principal
1090 GO TO 390

[cacharreo]

Otra versión muy mejorada de este juego en SUPERBASIC.

misil4 demo

(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)

Código: Seleccionar todo

100 REMark ###################
110 REMark # Missile Defense #
120 REMark ###################
130 REMark #############################
140 REMark # controles: OPQA Space ESC #
150 REMark #############################
160 REMark ###########################
170 REMark # parametros de oleadas   #
180 REMark # color ciudad            #
190 REMark # numero maximo de bombas #
200 REMark # velocidad minima caida  #
210 REMark # velocidad maxima caida  #
220 REMark ###########################
230 DATA 7,1,3,5
240 DATA 6,3,3,5
250 DATA 3,5,3,5
260 DATA 2,5,2,5
270 DATA 2,5,1,5
280 REMark ###############################
290 REMark # retardo del ciclo principal #
300 REMark ###############################
310 DEFine PROCedure wait(count)
320   FOR d=0 TO count:REMark pausa
330 END DEFine
340 REMark ###############################################
350 REMark # justificar valor con ceros por la izquierda #
360 REMark ###############################################
370 DEFine FuNction leading_zeros$(v,n)
380   r$="000000"&v
390   rl=LEN(r$)
400   RETurn r$(rl-n+1 TO rl)
410 END DEFine
420 REMark #########################
430 REMark # parametros por oleada #
440 REMark #########################
450 DEFine PROCedure wave_settings(stage%)
460   wave%=INT(stage%/3):REMark 3 es el numero de fases por oleada
470   delay%=25000-2500*wave%
480   IF delay%<1000 THEN delay%=1000
490   wpar%=wave%:IF wpar%>4 THEN wpar%=4
500   RESTORE 230+10*wpar%
510   READ city_color,nbmax,fall_min,fall_max
520 END DEFine
530 REMark ########
540 REMark # mira #
550 REMark ########
560 DEFine PROCedure bullseye
570   INK #ch,2:OVER #ch,-1:CIRCLE #ch,hp,vp,1:OVER #ch,0
580 END DEFine
590 REMark ##############
600 REMark # constantes #
610 REMark ##############
620 ch=5:REMark canal para la pantalla
630 scw=36:sw=157:sh=101:REMark tamano de pantalla
640 REMark #############
650 REMark # variables #
660 REMark #############
670 RANDOMISE
680 DIM b(4,5):REMark datos de las bombas 0=x 1=y 2=dx 3=dy 4=ox 5=oy
690 REMark ###############
700 REMark # nuevo juego #
710 REMark ###############
720 sc=0:REMark puntuacion
730 stage%=-1:REMark fase
740 gameover=0
750 REMark ##############
760 REMark # nueva fase #
770 REMark ##############
780 stage%=stage%+1
790 wave_settings(stage%)
800 nb=RND(1 TO nbmax)-1:REMark numero de bombas lanzadas-1
810 nbc=nb:REMark numero de bombas en curso-1
820 firesignal=0:REMark impide que el jugador mantenga pulsado el disparo
830 hp=sw/2:vp=sh/2:REMark posicion de mira (hp,vp)
840 bev=0:REMark mira visible
850 REMark #########################
860 REMark # inicializacion bombas #
870 REMark #########################
880 x=0:dx=sw/(nb+1)
890 FOR i=0 TO nb
900   b(i,0)=x+RND(dx/2):b(i,1)=sh:REMark coordenadas iniciales bomba
910   b(i,3)=RND(fall_min TO fall_max)/10:b(i,2)=(2*RND(0 TO 1)-1)*b(i,3):REMark velocidad de caida
920   x=x+dx
930 NEXT i
940 REMark ##########
950 REMark # ciudad #
960 REMark ##########
970 CLOSE #ch:CLS:MODE 8:OPEN #ch,scr_448x212a32x16
980 PAPER #ch,0:INK #ch,7:CLS #ch:BORDER #ch,1,4
990 PAPER #ch,city_color:INK #ch,1:FOR x=0 TO scw:FOR y=0 TO RND(0 TO 2):AT #ch,20-y,x:PRINT #ch,CHR$(254):NEXT y:NEXT x:PAPER #ch,0
1000 REMark #####################
1010 REMark # anuncio de oleada #
1020 REMark #####################
1030 IF NOT (stage% MOD 3) THEN
1040   OVER #ch,-1
1050   FOR i=9 TO 0 STEP -1
1060     INK #ch,6:AT #ch,8,11:PRINT #ch,"MISSILE DEFENSE"
1070     INK #ch,7:AT #ch,10,15:PRINT #ch,"WAVE ";leading_zeros$(wave%+1,3)
1080     INK #ch,2:AT #ch,12,16:PRINT #ch,"READY!"
1090     wait(100000)
1100   NEXT i
1110   OVER #ch,0
1120 END IF
1130 REMark ###################
1140 REMark # Ciclo principal #
1150 REMark ###################
1160 REMark ###########
1170 REMark # disparo #
1180 REMark ###########
1190 fire=0
1200 IF NOT(gameover) THEN
1210   IF firesignal THEN
1220     IF KEYROW(1)=0 THEN firesignal=0
1230   ELSE
1240     IF KEYROW(1)=64 THEN fire=1:firesignal=1
1250   END IF
1260 END IF
1270 REMark #########
1280 REMark # bomba #
1290 REMark #########
1300 INK #ch,4
1310 FOR i=0 TO nb
1320   b(i,4)=b(i,0):b(i,5)=b(i,1):REMark guarda antiguas coordenadas
1330   b(i,0)=b(i,0)+b(i,2):b(i,1)=b(i,1)-b(i,3):REMark caida bomba
1340   IF b(i,1)>14 THEN
1350     LINE #ch,b(i,4),b(i,5) TO b(i,0),b(i,1)
1360   ELSE
1370     IF b(i,3)<>0 THEN
1380       FOR r1=0 TO 15-b(i,1):INK #ch,4*(r1&&1)+2:CIRCLE #ch,b(i,0)-r1*ABS(b(i,2))/b(i,2),b(i,1),r1:NEXT r1:INK #ch,4
1390       IF b(i,1)<1 THEN b(i,3)=0:nbc=nbc-1:gameover=1:REMark fin del juego
1400     END IF
1410   END IF
1420   REMark control de los bordes de la pantalla
1430   IF b(i,0)<1 THEN
1440     b(i,0)=sw
1450   ELSE
1460     IF b(i,0)>=sw THEN b(i,0)=1
1470   END IF
1480   REMark comprobacion del disparo
1490   IF fire AND ABS(hp-b(i,0))<2 AND ABS(vp-b(i,1))<2 THEN
1500     b(i,2)=0:b(i,3)=0:REMark detener bomba
1510     sc=sc+50
1520     IF sc>999999 THEN sc=0
1530     INK #ch,7
1540     OVER #ch,-1
1550     FOR r1=0 TO 1
1560       RECOL #ch,7,1,2,3,4,5,6,0
1570       FOR r2=0 TO 24
1580         CIRCLE #ch,hp,vp,ABS(r2/2-12*r1)+1
1590         FOR d=0 TO 660:REMark pausa
1600       NEXT r2
1610       RECOL #ch,0,1,2,3,4,5,6,7
1620     NEXT r1
1630     OVER #ch,0
1640     INK #ch,4
1650     REMark Nueva fase cuando no quedan bombas
1660     nbc=nbc-1
1670     IF nbc<0 THEN GO TO 750
1680   END IF
1690 NEXT i
1700 fire=0
1710 REMark ##############
1720 REMark # puntuacion #
1730 REMark ##############
1740 INK #ch,7:AT #ch,0,0:PRINT #ch,leading_zeros$(sc,6)
1750 REMark abandonar el juego con ESC
1760 IF KEYROW(1)=8 THEN gameover=1:nbc=-1
1770 REMark #################
1780 REMark # fin del juego #
1790 REMark #################
1800 IF gameover AND nbc<0 THEN
1810   INK #ch,7:BORDER #ch,1,4
1820   AT #ch,9,14:PRINT #ch,"GAME OVER"
1830   REMark Espera hasta que no haya ninguna tecla pulsada
1840   k=0
1850   FOR i=0 TO 7
1860     IF KEYROW(i)<>0 THEN k=1
1870   NEXT i
1880   IF k THEN GO TO 1840
1890   PAUSE:REMark espera una tecla
1900   IF KEYROW(1)=8 THEN STOP
1910   GO TO 690
1920 END IF
1930 REMark ###################
1940 REMark # borrado de mira #
1950 REMark ###################
1960 ohp=hp:ovp=vp
1970 IF bev THEN bullseye
1980 REMark #############
1990 REMark # controles #
2000 REMark #############
2010 IF KEYROW(5)=128 THEN hp=hp-1:IF hp<3 THEN hp=sw-3
2020 IF KEYROW(6)=8 AND vp<sh-3 THEN vp=vp+1
2030 IF KEYROW(4) && 16 AND vp>16 THEN vp=vp-1
2040 IF KEYROW(4) && 32 THEN hp=hp+1:IF hp>sw-3 THEN hp=1
2050 REMark ########
2060 REMark # mira #
2070 REMark ########
2080 bullseye:bev=1
2090 REMark ###########
2100 REMark # retardo #
2110 REMark ###########
2120 wait(delay%)
2130 REMark ###########################
2140 REMark # fin del ciclo principal #
2150 REMark ###########################
2160 GO TO 1130

[cacharreo]

Nueva versión bastante más jugable.

worms5 demo

(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)

Código: Seleccionar todo

100 REMark // WORMS
110 :
120 REMark // espera
130 :
140 DEFine PROCedure wait(count)
150   FOR d=0 TO 1*count:REMark pausa con factor de velocidad (ajustar 1.0 a la velocidad deseada)
160 END DEFine wait
170 :
180 REMark // deteccion de colisiones por coordenada
190 :
200 DEFine FuNction collide(c,wc)
210   cc=ABS(c-wc)
220   IF cc>0 AND cc<4 THEN cc=1:ELSE cc=0
230   RETurn cc
240 END DEFine collide
250 :
260 REMark // normalizacion de coordenadas
270 :
280 DEFine PROCedure normbnd(x,y,cx,cy,s)
290   ax=0:IF x>cx THEN x=1:ax=1:ELSE IF x<1 THEN x=cx-1:ax=1
300   ay=0:IF y>cy THEN y=1:ay=1:ELSE IF y<1 THEN y=cy-1:ay=1
310   IF ax THEN y=y-3-wspd
320   IF ay THEN x=x+s*(3+wspd)
330 END DEFine normbnd
340 :
350 REMark // justificar valor con ceros por la izquierda
360 :
370 DEFine FuNction leading_zeros$(v,n)
380   r$="000000000"&v
390   rl=LEN(r$)
400   RETurn r$(rl-n+1 TO rl)
410 END DEFine leading_zeros
420 :
430 REMark // devuelve un color aleatorio para el planeta
440 :
450 DEFine FuNction pcolor
460   lcl=LEN(lcolor$)
470   IF NOT lcl THEN
480     lcolor$="14567"
490     FOR i%=2 TO pcol
500       p%=RND(2 TO pcol)
510       c$=lcolor$(1)
520       lcolor$(1)=lcolor$(p%)
530       lcolor$(p%)=c$
540     NEXT i%
550     lcl=pcol
560   END IF
570   cc=lcolor$(1)
580   lcolor$=lcolor$(2 TO lcl)
590   RETurn cc
600 END DEFine pcolor
610 :
620 REMark // devuelve el color de un pixel en la ventana de juego
630 :
640 DEFine FuNction getPixelColor%(x%,y%)
650   rx%=sx%+x%*448/sw%+.1
660   ry%=sy%+(dh-y%)*212/sh%+.1
670   scraddr=scrbs+ry%*scrln%+2*(rx% DIV 8)
680   pix%=7-(rx%&&6)
690   tmp=PEEK(scraddr+1)
700   r%=2*((tmp&&pow2%(pix%))<>0)
710   g%=4*((PEEK(scraddr)&&pow2%(pix%))<>0)
720   b%=(tmp&&pow2%(pix%-1))<>0
730   RETurn r%+g%+b%
740 END DEFine getPixelColor
750 :
760 REMark // refresca marcadores
770 :
780 DEFine FuNction getPlanetName$
790   oldsil%=-1:pname$="":FOR i%=1 TO RND(2 TO 4)
800     nxtsil%=RND(nsil%)
810     IF nxtsil%=oldsil% THEN GO TO 800
820     pname$=pname$&sil$(nxtsil%)
830   NEXT i%
840   pname$(1)=CHR$(CODE(pname$(1))-32)
850   RETurn pname$
860 END DEFine getPlanetName$
870 :
880 REMark // borra la pantalla
890 :
900 DEFine PROCedure clearScreen
910   PAPER #ch,0:CLS #ch:BORDER #ch,1,4:INK #ch,4:LINE #ch,dw+8,1 TO dw+8,dh+1
920 END DEFine clearScreen
930 :
940 REMark // refresca marcadores
950 :
960 DEFine PROCedure refreshData
970   INK #ch,7:AT #ch,1,27:PRINT #ch,leading_zeros$(sc,9)
980   AT #ch,4,27:PRINT #ch,leading_zeros$(pw%,3);"%"
990   AT #ch,7,27:PRINT #ch,leading_zeros$(time%,3)
1000   AT #ch,10,27:PRINT #ch,leading_zeros$(st%,7)
1010 END DEFine refreshData
1020 :
1030 REMark // constantes
1040 :
1050 REMark // tabla precalculada de potencias de 2
1060 :
1070 DIM pow2%(7):RESTORE 1080:READ pow2%
1080 DATA 1,2,4,8,16,32,64,128
1090 :
1100 REMark // tabla precalculada de senos
1110 :
1120 DIM sns(7):RESTORE 1130:READ sns
1130 DATA 0,.71,1,.71,0,-.71,-1,-.71
1140 :
1150 nsil%=21:DIM sil$(nsil%,4):RESTORE 1160:READ sil$
1160 DATA "al","an","ba","can","cas","cor","cyg","de","eri","ga","gru","hy","lyn","per","ran","sa","sag","ser","tau","um","ur","ve"
1170 :
1180 REMark // ventana y ventana de juego
1190 :
1200 scrbs=131072:REMark comienzo de la memoria de pantalla
1210 scrln%=128:REMark bytes por linea de pantalla
1220 sx%=34:sy%=17:REMark origen de la ventana
1230 sw%=157:sh%=101:REMark anchura y altura de la ventana
1240 dh=100:dw=dh:hw=dw/2:hh=dh/2:REMark anchuras y alturas de la ventana de juego
1250 pcol=5:lcolor$="":REMark colores aleatorios para planetas
1260 :
1270 REMark // pantalla de presentacion
1280 :
1290 ch=5:CLOSE #ch:MODE 8:OPEN #ch,scr_448x212a32x16
1300 PAPER #ch,0:INK #ch,7:CLS #ch:BORDER #ch,1,4
1310 AT #ch,10,10:PRINT#ch,"WORMS"
1320 AT #ch,14,10:PRINT#ch,"Controls: Q,A,O,P"
1330 AT #ch,16,10:PRINT#ch,"READY!"
1340 :
1350 REMark // variables iniciales de puntuacion, pantalla (fases), gusanos, numero maximo, velocidad y
1360 :
1370 sc=0:st%=-1
1380 wnmax=9:wn=-1:DIM w(wnmax,2):wspd=1/2:REMark gusanos (0=x 1=y 2=dy)
1390 :
1400 REMark // espera una tecla para empezar
1410 :
1420 PAUSE 144:clearScreen
1430 :
1440 REMark // inicializacion de potencia, cambio de pantalla, numero de gusanos e incremento de velocidad del worm
1450 :
1460 pw%=100:st%=st%+1:wspd=wspd+1/5:time%=240
1470 IF (st% MOD 3)=0 THEN IF wn<wnmax THEN wn=wn+1
1480 :
1490 REMark // anuncio planeta
1500 :
1510 planet$="planet "&getPlanetName$:r=(25-LEN(planet$)) DIV 2
1520 INK #ch,6:OVER #ch,0
1530 AT #ch,8,4:PRINT #ch,"Teleportation to"
1540 AT #ch,10,r:PRINT #ch,planet$
1550 FOR i%=31 TO 0 STEP -1
1560   RECOL #ch,(i%-7)&&7,(i%-6)&&7,(i%-5)&&7,(i%-4)&&7,(i%-3)&&7,(i%-2)&&7,(i%-1)&&7,(i%)&&7
1570   wait 15000
1580 NEXT i%
1590 OVER #ch,0:RECOL #ch,0,1,2,3,4,5,6,7
1600 REMark // pantalla del juego
1610 clearScreen
1620 :
1630 REMark // marcadores
1640 :
1650 AT #ch,0,27:PRINT #ch,"SCORE"
1660 AT #ch,3,27:PRINT #ch,"POWER"
1670 AT #ch,6,27:PRINT #ch,"TIME"
1680 AT #ch,9,27:PRINT #ch,"PLANETS"
1690 :
1700 REMark // -- estrellas de fondo
1710 :
1720 INK #ch,7:FOR i%=1 TO 25:POINT #ch,RND(1 TO dw),RND(1 TO dh):NEXT i%
1730 :
1740 REMark // variables iniciales nave
1750 :
1760 shpx=dw/2:shpy=dh/2
1770 INK #ch,2:OVER #ch,-1:CIRCLE #ch,shpx,shpy,1:OVER #ch,0
1780 :
1790 REMark // variables iniciales gusanos
1800 :
1810 wstp%=0:wox=0:woy=0
1820 FOR i%=0 TO wn
1830   wx=RND(1 TO hw DIV 2)+wox:wy=dh-RND(1 TO hh DIV 2)-woy:w(i%,0)=wx:w(i%,1)=wy:REMark coordenadas iniciales del gusano i%
1840   w(i%,2)=2*(i%&&1)-1:REMark dy=sentido en la direccion vertical
1850   INK #ch,3:CIRCLE #ch,wx,wy,2
1860   wox=(wox+3*dw/4) MOD dw:woy=(woy+3*dh/4) MOD dh
1870 NEXT i%
1880 :
1890 REMark // variables iniciales de coordenadas, color y radio del planeta
1900 :
1910 px=RND(5 TO dw-5):py=RND(5 TO dh-5):pr=RND(1 TO 14)+4
1920 IF ABS(px-shpx)<25 OR ABS(py-shpy)<25 THEN GO TO 1910
1930 :
1940 REMark // planeta
1950 :
1960 INK #ch,pcolor:FOR r=1 TO pr:CIRCLE #ch,px,py,r/2:NEXT r
1970 :
1980 REMark // inicio ciclo juego
1990 :
2000 REMark // puntuacion, potencia, tiempo y fase (planetas)
2010 :
2020 REPeat loop
2030   time%=time%-1
2040   refreshData
2050   REMark // abandonar el juego con ESC
2060   :
2070   IF KEYROW(1)=8 THEN STOP
2080   :
2090   REMark // movimiento nave
2100   :
2110   oshpx=shpx:oshpy=shpy
2120   INK #ch,2:OVER #ch,-1:CIRCLE #ch,shpx,shpy,1
2130   IF KEYROW(5)=128 THEN shpx=shpx-1:IF shpx<3 THEN shpx=dw-3
2140   IF KEYROW(6)=8 THEN shpy=shpy+1:IF shpy>dh-3 THEN shpy=3
2150   IF KEYROW(4) && 16 THEN shpy=shpy-1:IF shpy<3 THEN shpy=dh-3
2160   IF KEYROW(4) && 32 THEN shpx=shpx+1:IF shpx>dw-3 THEN shpx=1
2170   IF getPixelColor%(shpx,shpy)=3 THEN pw%=pw%-5:IF pw%<0 THEN EXIT loop
2180   CIRCLE #ch,shpx,shpy,1:OVER #ch,0
2190   IF oshpx<>shpx AND oshpy<>shpy THEN sc=sc+1
2200   :
2210   REMark // entrada al planeta para cambiar de fase
2220   :
2230   IF ABS(shpx-px)<3 AND ABS(shpy-py)<3 THEN sc=sc+100:GO TO 1430
2240   :
2250   REMark // movimiento gusanos y colisiones
2260   :
2270   INK #ch,3:FOR i%=0 TO wn
2280     dy=w(i%,2):wx=w(i%,0)+wspd*sns(wstp%)+wspd:wy=w(i%,1)+wspd*dy:normbnd wx,wy,dw,dh,dy
2290     w(i%,0)=wx:w(i%,1)=wy
2300     CIRCLE #ch,wx,wy,2
2310     IF collide(shpx,wx) AND collide(shpy,wy) THEN EXIT loop
2320   NEXT i%
2330   wstp%=(wstp%+1)&&7
2340   :
2350   REMark // fin ciclo juego
2360   :
2370   IF time%<1 THEN EXIT loop
2380   wait 25000
2390 END REPeat loop
2400 :
2410 REMark // fin del juego
2420 :
2430 INK #ch,7:BORDER #ch,1,4
2440 OVER #ch,-1:AT #ch,9,9:PRINT #ch,"GAME OVER":OVER #ch,0
2450 :
2460 REMark // espera hasta que no haya ninguna tecla pulsada
2470 :
2480 k=0:FOR i%=0 TO 7:IF KEYROW(i%) THEN k=1
2490 IF k THEN GO TO 2450
2500 PAUSE:REMark espera una tecla
2510 IF KEYROW(1)=8 THEN STOP
2520 GO TO 1270