Programillas en BASIC
Publicado: 17 Feb 2024, 14:38
He hecho unos pequeños cambios en "Crash" (2009) de @badaman del que ha salido esta nueva versión, "M40 Kamikaze".
(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)
M40.bas
M40 Kamikaze 1.00 demo
(click para ampliar) (es necesario subir el volumen del reproductor para escuchar la banda sonora)
- 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
(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
Nueva versión del programa M40 Kamikaze con gráficos definidos por el usuario (UDG).badaman escribió: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.
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