Alien-B

Juego de invasores escrito en Beta BASIC para ZX Spectrum 128.

Proyecto desarrollado entre 2010-06-01 y 2011-02-05.

Etiquetas:

Tras publicar Alien-A se me ocurrió (otra de mis originales «retro-ideas») hacer una versión en Beta BASIC, como un pequeño desafío para practicar algunas de las posibilidades gráficas del veterano lenguaje.

Las principales diferencias de Alien-B con Alien-A son:

Gráficos de 16x8 pixeles, en lugar de 8x8.
Movimiento por pixeles, en lugar de por caracteres.
Un solo tipo de nave que cambia de gráfico, rumbo y velocidad durante la bajada, en lugar de cuatro naves diferentes con comportamientos fijos.
Las naves no reaparecen irrealmente por el lado opuesto de la pantalla, sino que se mantienen dentro de sus límites.
Las naves aparecen desde arriba y desaparecen por los bordes pixel a pixel, no de golpe.
No hay escudo protector; la invasión se produce cuando no quedan más «plazas de aterrizaje» libres.
Cargas de munición.
Efecto final elaborado.
Registro de las mejores puntuaciones, que se conserva en disco.

El primer reto fue hacer mínimamente jugable un programa de este tipo en un BASIC interpretado, y para una máquina ya por sí lenta como la ZX Spectrum. Pronto me di cuenta de que era imposible lograrlo salvo aumentando la velocidad del emulador. A 1500% de la velocidad original de la ZX Spectrum el juego es utilizable; lo mejor, como el propio programa recomienda antes de empezar, es poner el emulador a la máxima velocidad posible.

Pantallazos

Las imágenes que siguen corresponden al último periodo del desarrollo (en 2010-12); el aspecto definitivo es ligeramente diferente en algunos detalles.

Menú en tres lenguas, con efecto visual de explosiones aleatorias:

Menú Menú Menú

Escenas del juego:

Nave Nave Disparo Explosión

Algunas secuencias del efecto final, la invasión:

Invasión Ataque Mutación Trípode

La última parte del efecto final es la escritura del rótulo por parte del trípode. Las coordenadas de los puntos de todos los mensajes han sido previamente calculadas y almacenadas en disco por el programa alien-b-m:

Trípode

Código fuente

  10 REM Alien-B
     Version 01-20110205
     Copyright (C) 2010,2011 Marcos Cruz (programandala.net)

  20 REM License
     programandala.net/license

  30 
     REM ## G+DOS/Beta DOS

  40 POKE @NOT PI,NOT PI
     REM no border change
  50 
     REM ## Beta BASIC

  60 LET bbOn=VAL "58419"
     RANDOMIZE USR bbOn
     LET bbOff=VAL "59904"
  70 LET bbCHPL=VAL "57391"
     REM chars/line
  80 LET xos=NOT PI,yos=NOT PI
  90 
     waitScreen SGN PI
 100 
     REM ## ZX Spectrum

 110 LET sysFont=VAL "15360"
     REM system font's address (-256)
 120 LET sysScreen=VAL "16384"
     REM address of the screen
 130 LET sysAttr=VAL "22528"
     REM address of the screen attributes
 140 LET sysCHARS=VAL "23606"
     LET sysRAMTOP=VAL "23730"
 150 lessStars
 160 
     REM ## Functions

 170 DEF FN b(i,p,b)=i+8*p+64*b
     REM screen attribute for paper p, ink i and brigth b
 180 
     REM ## Constants

 190 LET n0=NOT PI,n1=SGN PI,n2=VAL "2",n3=INT PI,n4=VAL "4",n7=VAL "7",n8=VAL "8",n16=n2*n8,n32=CODE " ",n64=CODE "@"
 200 LET black=n0,blue=n1,red=n2,purple=n3,white=n7,trans=n8
 210 LET eyeOn=FN b(white,purple,0),eyeBrigth=FN b(white,purple,1)
 220 LET skyPaper=black,skyInk=trans,aInk=white,skyBright=n1,skyAttr=FN b(aInk,skyPaper,skyBright)
 230 LET groundPaper=black,groundInk=blue,destroyInk=purple
 240 LET statusPaper=black,statusInk=white,statusBright=n0
 250 LET menuPaper=black,menuInk=blue,menuBright=n0
 260 LET gW=n8,gH=gW
     REM gun's measures
 270 LET aW=n16,aWC=aW/n8,aH=n8,aHC=aH/n8
     REM alien measures
 280 LET tripodHC=VAL "15",tripodH=tripodHC*n8,tripodWC=VAL "11",tripodW=tripodWC*n8
     REM tripod's measures
 290 lessStars
 300 LET h$="1",l$="L"
     REM menu keys
 310 lessStars
 320 LET langs=n3,es=n1,eo=n2,en=n3
     REM languages
 330 LET maxY=VAL "175",maxX=VAL "255",scrW=maxX+n1,cols=n32
     REM screen size
 340 LET groundMaxY=VAL "55",groundMinX=aW,groundMinY=n0,groundH=groundMaxY+n1,groundHC=groundH/n8,groundW=maxX-n2*aW+n1,groundWC=groundW/n8,groundMaxX=maxX-aW
 350 LET vpX=maxX/2,vpY=maxY
     REM vanishing point for the ground perspective and the final text
 360 LET aMinX=aW/n3,aMaxX=maxX-aW-(aW/n3),aMinY=groundMaxY+aH,aMaxY=maxY-aH,aLowY=aMinY+aH
     REM alien coords
 370 LET aPlaces=groundW/aW
 380 LET aParkY=aMinY+((aMaxY-aMinY)/n2)
     REM alien Y coord where search for parking starts
 390 LET aLandingY=aMinY+n2*aH
     REM alien Y coord where landing gear is mandatory
 400 LET flying=n1,searching=n2,parking=n3
     REM values for aStatus
 410 LET lY=aMinY-n3
     REM pixel line where landing space is searched by the aliens
 420 lessStars
 430 LET gMaxX=maxX-aW-gW,gMinX=aW,gMaxY=maxY-gW,gMinY=groundMaxY+aH+gH
     REM gun coords
 440 LET gII=VAL ".2"
     REM increment of the gun increment
 450 LET aliens=n4,aliensRnd=n2
 460 LET f$="font#     "
     REM RAM disc array name thaat holds the font address
 470 lessStars
 480 LET scoreDigits=4,m$=STRING$(scoreDigits,"0"),records=n8,recordNamePos=n3,recordNameLen=n3
     REM score and record format
 490 
     REM ## Variables

 500 LET lang=en,record=n0
 510 IF NOT INSTRING(n1,CAT$(),f$) THEN DIM !f$,(n1)
       REM storage for the font address
 520 lessStars
 530 
     REM ## Init

 540 gameFont
     REM Must be before initWindows and DEF KEY
 550 LET lastWin=n0
     initWindows
     DEF KEY "0"," WINDOW 0: CSIZE 0: CLS #: KEYWORDS 1: DPOKE 23606,15360"
 560 initGraphs
      getRecord
 570 
     REM ## Main

 580 waitScreen n0
     DO
       RANDOMIZE
       menu
       warning
       gameInit
       game
       invasion
       checkRecord
     LOOP
 590 
     REM ## Game

 600 DEF PROC game
       LOCAL nX,nY
       DO
         hold
         LET nX=aX+aXi,nY=aY+aYi
         IF nY<=aMinY THEN landed
         EXIT IF NOT horizont
           newAlien
           aim
         ELSE navigate
           aim
 610   LOOP
     END PROC
 620 DEF PROC gameInit
       LET score=n0,gX=CODE "P",gY=CODE "x",gI=n3,ammo=28,horizont=aPlaces
       scenery
       PLOT gX,gY;x$
       newAlien
     END PROC
 630 DEF PROC hold
       LOCAL port
       LET port=VAL "63486"
       DO UNTIL AND(n1,IN port)
         DO WHILE NOT AND(n1,IN port)
         LOOP
         DO WHILE AND(n1,IN port)
         LOOP
       LOOP UNTIL PI
     END PROC
 640 
     REM ## Scenery

 650 DEF PROC scenery
       CLS n0
       ground
       colorSky
       statusBar
       WINDOW skyWin
     END PROC
 660 DEF PROC colorSky
       POKE sysAttr,!skyAttrs$(n1)
     END PROC
 670 DEF PROC ground
       WINDOW groundWin
       PAPER black
       INK black
       CLS
       vLines n8
       hLines groundMaxY,groundMaxY-n3,groundMaxY-n8,CODE "%",VAL "22",VAL "21"
       colorGround groundInk
       WINDOW skywin
     END PROC
 680 DEF PROC vLines lines
       LOCAL a1,b1
       REM sides of the vanishing point triangle
 690   LOCAL a2,b2
       REM sides of the triangle whose third side has to be drawn
 700   LOCAL x,x2
       LET a1=vpY-groundMinY,a2=groundH
       FOR x=0 TO maxX STEP maxX/lines
         LET b1=vpX-x,b2=b1*a2/a1,x2=x+b2
         PLOT x,groundMinY
         DRAW TO x2,groundMaxY
       NEXT x
     END PROC
 710 DEF PROC hLines DATA
       LOCAL y
       DO UNTIL NOT ITEM()
         READ y
         PLOT n0,y
         DRAW maxX,n0
       LOOP
     END PROC
 720 DEF PROC colorGround color
       LOCAL c$
       LET c$=CHAR$(0)+STRING$(28,CHR$ (color))+CHAR$(0)
       POKE 23008,STRING$(7,c$)
     END PROC
 730 
     REM ## Gun

 740 DEF PROC aim
       LOCAL nX,nY
       LET nX=gX,nY=gY
       IF NOT AND(4,IN 61438) THEN LET nX=nX+gI
         IF nX>gMaxX THEN LET nX=gMaxX
 750   IF NOT AND(16,IN 63486) THEN LET nX=nX-gI
         IF nX<gMinX THEN LET nx=gMinX
 760   IF NOT AND(8,IN 61438) THEN LET nY=nY+gI
         IF nY>gMaxY THEN LET nY=gMaxY
 770   IF NOT AND(16,IN 61438) THEN LET nY=nY-gI
         IF nY<gMinY THEN LET nY=gMinY
 780   IF (gX-nX) OR (gY-nY) THEN
         gunMoved
         LET gI=gI+gII
       ELSE LET gI=1
 790   IF NOT AND(1,IN 61438) THEN fire
 800 END PROC
 810 DEF PROC gunMoved
       PLOT gX,gY;x$
       LET gX=nX,gY=nY
       PLOT gX,gY;x$
     END PROC
 820 DEF PROC fire
       IF ammo THEN shoot
         PRINT #0;AT 0,ammo+1;" "
         LET ammo=ammo-1
       ELSE noAmmo
 830 END PROC
 840 DEF PROC shoot
       LOCAL n
       FOR n=1 TO 2
         PLOT gMinX,0
         DRAW TO gX,gY-8
         PLOT aMaxX,0
         DRAW TO gX+8,gY-8
       NEXT n
       IF POINT (gX+3,gY-3) THEN shootedDown
         GO TO 880
 850   IF POINT (gX+4,gY-3) THEN shootedDown
         GO TO 880
 860   IF POINT (gX+3,gY-4) THEN shootedDown
         GO TO 880
 870   IF POINT (gX+4,gY-4) THEN shootedDown
 880 END PROC
 890 DEF PROC noAmmo
       LOCAL m$
       ON lang
         LET m$="SIN MUNICI"+CHR$ 145+"N"
         LET m$="NUL MUNICIO"
         LET m$="NO AMMO"
 900   center0 m$,,red,1
       center0 "            "
     END PROC
 910 
     REM ## Alien

 920 DEF PROC newAlien
       LET aStatus=flying,aX=72+RNDM(111),aY=maxY
       newAlienType
     END PROC
 930 DEF PROC newAlienType newType
       DEFAULT newType=RNDM(aliensRnd)+1
       LET a$=g$(newType),aYi=-RNDM(4)-1
       ON newType
         LET aXi=-(RNDM(3)+1)
         LET aXi=0
         LET aXi=RNDM(3)+1
 940   PLOT aX,aY;a$
     END PROC
 950 DEF PROC landed
       LET horizont=horizont-1
       PLOT aX,aY;a$
       PLOT OVER 2;aX,aMinY;a$
       earthQuake
     END PROC
 960 DEF PROC earthQuake
       LOCAL n,p,d
       FOR n=n2 TO n4+RNDM(n8)
         LET p=n1+RNDM(n3)
         FOR d=VAL "5" TO n8 STEP n3
           ROLL d,p;n0,groundMaxY+n8;cols,groundMaxY+n8
         NEXT d
       NEXT n
     END PROC
 970 DEF PROC shootedDown
       PLOT gX,gY;x$
       explosion aX+8,aY-4
       PLOT OVER n1; INK skyInk;aX,aY;a$
       PLOT gX,gY;x$
       colorGround groundInk
       colorSky
       LET score=score+gY
       printScore
       newAlien
     END PROC
 980 DEF PROC explosion x,y,restoreColor
       DEFAULT restoreColor=skyInk
       LOCAL n
       FOR n=8 TO 64 STEP 8
         CIRCLE INK trans;x,y,n
         CIRCLE INK red;x,y,n/8
         CIRCLE OVER n1; INK trans;x,y,n
       NEXT n
       FOR n=8 TO 1 STEP -1
         CIRCLE INK restoreColor; OVER 1;x,y,n
       NEXT n
     END PROC
 990 DEF PROC navigate
       PLOT aX,aY;a$
       LET aY=nY,aX=nX
       PLOT aX,aY;a$
       ON aStatus
         flying
         searching
         parking
1000 END PROC
1010 DEF PROC flying
       IF nx<=aMinX THEN IF 0>aXi THEN LET aYi=-1,aXi=-SGN aXi
         GO TO 1030
1020   IF nX>=aMaxX THEN IF aXi>0 THEN LET aYi=1,aXi=-SGN aXi
1030   IF NOT RNDM(10-9*(aParkY>aY)) THEN
         startSearching
1040 END PROC
1050 DEF PROC startSearching
       LET aStatus=searching
       IF NOT aXi THEN
         PLOT aX,aY;a$
         newAlienType RNDM(1)*-2+3
         LET aYi=-1
1060 END PROC
1070 DEF PROC searching
       IF nx<=aMinX THEN IF 0>aXi THEN PLOT aX,aY;a$
         newAlienType 3
         LET aYi=0,aXi=1
         GO TO 1090
1080   IF nX>=aMaxX THEN IF aXi>0 THEN PLOT aX,aY;a$
         newAlienType 1
         LET aYi=0,aXi=-1
1090   IF aYi>0 AND aY>(aMaxY-aH) THEN LET aYi=-RNDM(3)
         GO TO 1120
1100   IF 0>aYi AND aLowY>=(aY+aYi) THEN LET aYi=RNDM(3)
         GO TO 1120
1110   IF NOT MOD(aX,aW) THEN IF NOT POINT (aX+7,lY) THEN startParking
1120 END PROC
1130 DEF PROC startParking
       LET aStatus=parking
       IF aXi THEN LET aXi=0
         PLOT aX,aY;a$
         newAlienType 2
1140   LET aYi=-3,nX=aX,nY=aY
     END PROC
1150 DEF PROC parking
       IF aY<=aLandingY THEN PLOT aX,aY;a$
         LET a$=g$(4)
         PLOT aX,aY;a$
1160 END PROC
1170 
     REM ## Invasion

1180 DEF PROC invasion
       glancingAliens
       destroyGround
       IF ammo THEN destroyAmmo
1190   RANDOMIZE
       LET tripodCol=aWC+RNDM(cols-n2*aWC-tripodWC-n1),tripodX=tripodCol*n8,tripodEye=sysAttr+cols+tripodCol+n4
       PLOT gX,gY;x$
       seatAliens
       mutateAliens
       joinAliens
       raiseTripod
       LET eyeOff=PEEK tripodEye
       tripodWrite
       lightTripod
       fade
     END PROC
1200 DEF PROC glancingAliens
       LOCAL a,n,x,y,w,m$,e
       DIM e(VAL "5")
       LET x=aW,y=aMinY-n2,m$=STRING$(n8+RNDM(n4),"345432123"),e(n1)=BIN 0111001111111110,e(n2)=BIN 0111100111111110,e(n3)=BIN 0111111001111110,e(n4)=BIN 0111111110011110,e(VAL "5")=BIN 0111111111001110
       pixelAddr x,y,a
       FOR n=n1 TO LEN m$
         POKE a,STRING$(aPlaces,CHAR$(e(VAL m$(n))))
       NEXT n
       POKE a,STRING$(aPlaces,CHAR$(BIN 0111111111111110))
     END PROC
1210 DEF PROC destroyGround
       LOCAL n,alien,x0,y0,x1,y1,dir,addr
       LET y0=groundMaxY
       FOR n=n1 TO n64+RNDM(n64)
         LET alien=RNDM(aPlaces-n1),x0=aW+alien*aW+n7,x1=aW+RNDM(groundW),y1=RNDM(groundH/n2)+n1,dir=SGN (x1-x0),addr=VAL "19138"+alien*aWC
         ON dir+n2
           DPOKE addr,BIN 1111111001111001
           DPOKE addr,BIN 01111111001111110
           DPOKE addr,BIN 1001111001111111
1220     PLOT OVER n0, INK destroyInk;x0,y0
         DRAW TO OVER n0, INK destroyInk;x1,y1
         PLOT OVER n1, INK destroyInk;x0,y0
         DRAW TO OVER n1, INK destroyInk;x1,y1
         PLOT OVER n1, INK destroyInk;x1,y1
         DPOKE addr,BIN 1111111001111111
1230   NEXT n
       colorGround destroyInk
     END PROC
1240 DEF PROC destroyAmmo
       LOCAL bitmapBase,attrBase,attrEnd,scan,bullet,addr,d$
       LET bitmapBase=VAL "20674",attrBase=VAL "23234",attrEnd=attrBase+ammo-1,d$=STRING$(ammo,CHR$ destroyInk)
       DO
         LET scan=RNDM(VAL "6"),bullet=RNDM(ammo-n1),addr=bitmapBase+bullet+VAL "256"*scan
         POKE addr,AND(PEEK addr,RNDM(VAL "255"))
         POKE attrBase+bullet,destroyInk
       LOOP UNTIL MEMORY$()(attrBase TO attrEnd)=d$
       LET ammo=n0
     END PROC
1250 DEF PROC seatAliens
       LOCAL n
       FOR n=n0 TO n3
         SCROLL VAL "6",n1;aw,groundMaxY+aH;groundWC,aH
         earthQuake
       NEXT n
       PLOT OVER n0; INK skyInk;aW,groundMaxY+n2
       DRAW OVER n0; INK skyInk;aPlaces*aW-n1,n0
     END PROC
1260 DEF PROC joinAliens
       LOCAL growStep,scan,leftCols,leftPixels,n,pixelsLeft,rightCols,rightPixels
       LET scan=n1,leftCols=tripodCol-aWC,leftPixels=leftCols*n8,rightCols=cols-aWC-tripodCol-tripodWC,rightPixels=rightCols*n8,pixelsLeft=(leftPixels*(l
       eftPixels>rightPixels)+rightPixels*(rightPixels>leftPixels)),growStep=INT (pixelsLeft/aH)
       DO
1270     IF leftPixels THEN SCROLL n8,n1;aW,groundMaxY+aH;leftCols,aH
           LET leftPixels=leftPixels-n1
1280     IF rightPixels THEN SCROLL VAL "5",n1;tripodX+tripodW,groundMaxY+aH;rightCols,aH
           LET rightPixels=rightPixels-n1
1290     IF NOT MOD(pixelsLeft,growStep) THEN FOR n=n1 TO tripodW
           PLOT INK skyInk; OVER n1; BRIGHT n0;tripodX+(tripodWC/n8)*scan+RNDM(tripodW-2*(scan*tripodWC/n8)),groundMaxY+aH+scan
         NEXT n
         LET scan=scan+n1
1300   LET pixelsLeft=pixelsLeft-n1
     LOOP WHILE pixelsLeft
     END PROC
1310 DEF PROC mutateAliens
       LOCAL l,n
       FOR l=n3 TO aH
         FOR n=n1 TO l*n32
           PLOT INK skyInk; OVER n1; BRIGHT n0;aW+RNDM(groundW-n1),groundMaxY+l
         NEXT n
       NEXT l
     END PROC
1320 DEF PROC raiseTripod
       LOCAL a,n,l$
       tripodRow n0,groundMaxY+n16
       FOR n=n0 TO tripodHC-n2
         LOAD d*"tripodC"+USING$("00",n) DATA l$()
         IF n THEN SCROLL VAL "11",n8;tripodX,maxY;tripodWC,tripodH-n8
1330     PLOT OVER n0;tripodX,groundMaxY+aH+n8;l$
       NEXT n
       tripodRow tripodHC-n1,groundMaxY+n8
     END PROC
1340 DEF PROC tripodRow row,y
       LOCAL n,r$
       LET r$=USING$("00",row)
       FOR n=n0 TO n7
         pixelAddr tripodX,y-n,a
         LOAD d*"tripodB"+r$+STR$ nCODE a

       NEXT n
       LOAD d*"tripodC"+r$ DATA l$()
       PLOT OVER n0;tripodX,y;l$
     END PROC
1350 DEF PROC lightTripod
       POKE tripodEye,eyeOn
       DO
         IF NOT RNDM(n16) THEN POKE tripodEye,eyeBrigth*(PEEK tripodEye=eyeOn)+eyeOn*(PEEK tripodEye=eyeBrigth)
1360   LOOP UNTIL LEN INKEY$
       POKE tripodEye,eyeOff
     END PROC
1370 
     REM ## End

1380 DEF PROC tripodWrite txtId
       LOCAL eX,eY,p,p$,x,y
       LET eX=tripodX+CODE "#",eY=maxY-VAL "12"
       RANDOMIZE
       DEFAULT txtId=RNDM(VAL "10")
       LOAD d*"message"+STR$ lang+HEX$(txtId) DATA p$()
       RANDOMIZE
       ON RNDM(n1)+n1
         SORT p$()(RNDM(n3)+n1 TO )
         SORT INVERSE p$()(RNDM(n3)+n1 TO )
1390   FOR p=n1 TO LENGTH(n1,"p$()")
         LET x=CODE p$(p,2),y=CODE p$(p,3)
         POKE tripodEye,eyeBrigth
         PLOT eX,eY
         DRAW TO x,y
         CIRCLE x,y,CODE p$(p,4)
         POKE tripodEye,eyeOn
         PLOT eX,eY
         DRAW TO x,y
         POKE tripodEye,eyeOff
       NEXT p
     END PROC
1400 DEF PROC fade
       LOCAL count
       LET count=maxY
       DO WHILE LEN INKEY$
       LOOP
       DO WHILE count
         SCROLL VAL "10",n1;n0,maxY;cols,maxY+n1
         LET count=count-n1
       LOOP UNTIL LEN INKEY$
     END PROC
1410 
     REM ## Memory

1420 DEF PROC superclear bytes
       LOCAL sign,n
       LET sign=SGN (bytes),bytes=ABS (bytes)
       FOR n=1 TO INT (bytes/767)
         CLEAR 767*sign
       NEXT n
       CLEAR MOD(bytes,767)*sign
     END PROC
1430 DEF PROC allocate bytes, REF address
       LOCAL oldRamtop
       LET oldRamtop=DPEEK(sysRAMTOP),bytes=ABS (bytes)
       superclear bytes
       LET address=oldRamtop-bytes+2
     END PROC
1440 DEF PROC deallocate bytes
       superclear -ABS (bytes)
     END PROC
1450 
     REM ## Font

1460 DEF PROC gameFont
       LOCAL address
       LET address=!f$,(n1)
       IF NOT address THEN allocateVAL "768",address
         LOAD d*"font"CODE address
         LET address=address-VAL "256"
         LET !f$,(n1)=address
1470   DPOKE sysCHARS,address
     END PROC
1480 DEF PROC normalFont
       DPOKE sysCHARS,sysFont
     END PROC
1490 DEF PROC eraseFont
       superclearVAL "-768"
       normalFont
     END PROC
1500 
     REM ## Graphics

1510 DEF PROC initGraphs
       LOCAL a$,l
       LOAD d*"udg"CODE USR "a"
       LOAD d*"alien" DATA g$()
       LOAD d*"aim" DATA x$()
1520   DIM !skyAttrs$(n1,skyHC*cols)
       LET !skyAttrs$(n1)=STRING$(cols,CHR$ n0),a$=CHAR$(n0)+STRING$(groundWC,CHR$ skyAttr)+CHAR$(n0)
       FOR l=n1 TO VAL "14"
         LET !skyAttrs$(n1,cols*l+n1 TO )=a$
       NEXT l
     END PROC
1530 DEF PROC pixelAddr x,y, REF a
       LOCAL a$
       LET a$=CHR$ 1+CHR$ x+CHR$ y+" STEP SCREEN$ ""DM<>",a=USR LENGTH(0,"a$")
     END PROC
     REM BB Newsletter#4,p.11
1540 DEF PROC fixCoords REF x, REF y
       LET x=INT x
       DO
       EXIT IF NOT MOD(x,n8)
         LET x=x-n1
       LOOP
       LET y=INT y
       DO
       EXIT IF NOT MOD(y+1,n8)
         LET y=y-n1
       LOOP
     END PROC
1550 
     REM ## Wait screen

1560 DEF PROC waitScreen s
       LOCAL i
       IF s THEN PAPER NOT PI
         INK NOT PI
         BORDER NOT PI
         CLS NOT PI
         FOR i=SGN PI TO CODE "@"+RNDM(CODE " ")
           PLOT RNDM(VAL "255"),RNDM(VAL "175")
         NEXT i
         ALTER INK NOT PI TO INK VAL "7"
       ELSE
         FOR i=n1 TO n32
           lessStars
         NEXT i
         ALTER INK white TO INK black
1570 END PROC
1580 DEF PROC lessStars
       CIRCLE INK NOT PI;RNDM(VAL "255"),RNDM(VAL "175"),CODE " "
     END PROC
1590 
     REM ## Windows

1600 DEF PROC initWindows
       LOCAL menuX,menuY,menuH,skyX,skyY,skyH,recordsHCsize,recordsVCsize,recordsW,recordsH,recordsX,recordsY
1610   KEYWORDS n0
       WINDOW ERASE
       CSIZE n8
       INVERSE n0
       FLASH n0
       OVER n1
       PAPER black
       BORDER black
       BRIGHT skyBright
       INK skyInk
1620   newWin titleWin
       WINDOW titleWin,n0,VAL "175",VAL "256",n16
       WINDOW titleWin
       PAPER menuPaper
       INK menuInk
       BRIGHT menuBright
1630   LET menuX=VAL "56",menuY=VAL "135",menuH=VAL "117"
1640   newWin menuKeysWin
       WINDOW menuKeysWin,menuX,menuY,n8,menuH
       WINDOW menuKeysWin
       PAPER menuPaper
       INK menuInk
       BRIGHT menuBright
1650   newWin menuTextsWin
       LET menuTextsX=VAL "80",menuTextsY=menuY,menuTextsW=maxX-menuTextsX,menuTextsH=menuH
       WINDOW menuTextsWin,menuTextsX,menuTextsY,menuTextsW,menuTextsH
       WINDOW menuTextsWin
       OVER n0
       PAPER menuPaper
       INK menuInk
       BRIGHT menuBright
1660   newWin skyWin
       LET skyX=n0,skyY=maxY,skyW=VAL "256",skyH=VAL "176"-groundMaxY-n1,skyHC=skyH/n8
       WINDOW skyWin,skyX,skyY,skyW,skyH
       WINDOW skyWin
       CSIZE n8
       OVER n1
       PAPER skyPaper
       INK trans
       BRIGHT skyBright
1670   newWin groundWin
       WINDOW groundWin,n0,groundMaxY,VAL "256",groundMaxY+n1
       WINDOW groundWin
       OVER n0
       PAPER groundPaper
       INK groundInk
       BRIGHT n0
1680   newWin recordsWin
       LET recordsHCsize=n16,recordsVCsize=n16,recordsW=recordsHCsize*(scoreDigits+n1+recordNameLen),recordsH=recordsVCsize*records,recordsX=(maxX-recordsW)/2,recordsY=recordsH
       fixCoords recordsX,recordsY
       WINDOW recordsWin,recordsX,recordsY,recordsW,recordsH
       WINDOW recordsWin
       CSIZE recordsHCsize,recordsVCsize
       OVER n0
       PAPER menuPaper
       INK menuInk
       BRIGHT n0
1690   WINDOW n0
     END PROC
1700 DEF PROC newWin REF win
       LET lastWin=lastWin+n1,win=lastWin
       lessStars
     END PROC
1710 
     REM ## Menu

1720 DEF PROC menu
       LOCAL k$,color
       WINDOW n0
       INK menuInk
       CLS n0
       title
       menuKeys
       CLS menuTextsWin
       menuTexts
       credits
       menuActiveKeys n1
1730   DO
         DO
           IF NOT RNDM(n32) THEN menuActiveKeys n0
             OVER n1
             explosion RNDM(maxX),RNDM(maxY),menuInk
             OVER n0
             menuActiveKeys n1
1740       LET k$=SHIFT$(n1,INKEY$)
         LOOP UNTIL INSTRING(n1,h$+l$,k$)
1750     IF k$=l$ THEN LET lang=lang+(langs>lang)-((lang-n1)*(lang=langs))
           eraseMenu
           menuTexts
1760   LOOP UNTIL k$=h$
       DO WHILE INKEY$=h$
       LOOP
     END PROC
1770 DEF PROC title
       LOCAL t$,l,s
       CLS titleWin
       untitle
       LET t$="A L I E N    ",l=LEN t$
       FOR s=n1 TO n16
         PLOT CSIZE s,n16; INK menuInk; OVER n0;(maxX-s*l)/n2,maxY;t$
         PLOT CSIZE s,n16; INK menuInk; OVER n0;VAL "184",VAL "175";"- B"
       NEXT s
     END PROC
1780 DEF PROC untitle
       LOCAL t$,l,s
       LET l=VAL "13",t$=STRING$(l,"|")
       FOR s=n1 TO n16
         PLOT CSIZE s,n16; INK menuInk; OVER n1;(maxX-s*l)/n2,maxY;t$
       NEXT s
     END PROC
1790 DEF PROC credits
       LOCAL attrBase
       LET attrBase=VAL "23232"
       POKE attrBase,STRING$(n64,CHR$ n0)
        center0 "Copyright (C) 2011 Marcos Cruz"
       center0 "programandala.net",n1
       FOR n=n0 TO VAL "127"
         POKE attrBase+RNDM(VAL "63"),menuInk
       NEXT n
       POKE attrBase,STRING$(n64,CHR$ menuInk)
     END PROC
1800 DEF PROC center0 t$,l,color,inv
       DEFAULT l=n0,color=menuPaper,inv=n0
        PRINT #n0;AT l,(cols-LEN t$)/n2; INK color; INVERSE inv;t$
     END PROC
1810 DEF PROC menuKeys flag
       DEFAULT flag=n0
       menuActiveKeys flag
       PRINT WINDOW menuKeysWin; INK menuInk;"5"''"6"''"7"''"8"''"0"
     END PROC
1820 DEF PROC menuActiveKeys flag
       PRINT WINDOW menuKeysWin;AT n0,n0; INK menuInk; FLASH flag; OVER n0;l$''h$''
     END PROC
1830 DEF PROC menuTexts
       LOCAL n$,s$,l$,u$,d$,r$,f$
       ON lang
         LET l$="Izquierda",d$="Abajo",u$="Arriba",r$="Derecha",f$="Disparo",s$="Jugar/Parar/Continuar",n$="No en castellano"
         LET l$="Maldekstren",d$="Malsupren",u$="Supren",r$="Dekstren",f$="Pafi",s$="Ludi/Haltigi/Plui",n$="Ne en Esperanto"
         LET l$="Left",d$="Down",u$="Up",r$="Right",f$="Fire",s$="Play/Halt/Continue",n$="Not in English"
1840   PRINT WINDOW menuTextsWin;AT n0,n0;n$''s$''l$''d$''u$''r$''f$
     END PROC
1850 DEF PROC eraseMenu
       SCROLL n8,menuTextsW+n1;menuTextsX,menuTextsY;menuTextsW/n8,menuTextsH
     END PROC
1860 DEF PROC warning
       LOCAL a$,b$
       ON lang
         LET a$="Pon tu emulador a toda velocidad",b$="y pulsa una tecla."
         LET a$="Plejrapidigu vian emulilon",b$="kaj premu klavon."
         LET a$="Set your emulator to its maximum",b$="speed, then press any key."
1870   CLS n0
       PRINT CSIZE n8,n16; INK menuInk;AT n3,(PEEK bbCHPL-LEN a$)/n2;a$;AT n4,(PEEK bbCHPL-LEN b$)/n2;b$
       PAUSE n0
     END PROC
1880 
     REM ## Status bar

1890 DEF PROC statusBar
       LOCAL s$,col,r$
       POKE VAL "23232",STRING$(n64,CHR$ FN b(statusInk,statusPaper,statusBright))
       ON lang
         LET s$="Puntos",col=VAL "19",r$="Marca"
         LET s$="Poentoj",col=VAL "17",r$="Rekordo"
         LET s$="Score",col=VAL "18",r$="Record"
1900   PRINT #n0;AT n1,n2;s$;AT n1,col;r$
       printAmmo
       printScore
       printRecord
     END PROC
1910 DEF PROC printAmmo
       PRINT #n0;AT n0,n2; PAPER statusPaper; INK red; BRIGHT statusBright;STRING$(ammo,CHR$ VAL "146")
     END PROC
1920 DEF PROC printScore
       LOCAL col
       ON lang
         LET col=VAL "9"
         LET col=VAL "10"
         LET col=n8
1930   PRINT #n0;AT n1,col; INK statusInk; PAPER statusPaper; BRIGHT statusBright;USING$(m$,score)
     END PROC
1940 DEF PROC printRecord
       PRINT #n0;AT n1,VAL "25"; PAPER statusPaper; INK statusInk; BRIGHT statusBright;USING$(m$,record)
     END PROC
1950 
     REM ## Records

1960 DEF PROC loadRecords
       LOAD d*"records" DATA r$()
       SORT INVERSE r$()
     END PROC
1970 DEF PROC getRecord
       loadRecords
       LET record=NUMBER(r$(n1, TO n2))
       DELETE r$
     END PROC
1980 DEF PROC saveRecords
       RANDOMIZE USR bbOff
       SAVE OVER d*"records" DATA r$()
       RANDOMIZE USR bbOn
     END PROC
1990 DEF PROC checkRecord
       LOCAL n$,recordIndex
       loadRecords
       IF score>NUMBER(r$(records, TO n2)) THEN
         recordsScreen
         LET r$(records)=CHAR$(score)+"   "
         SORT INVERSE r$
         recordsTable
         LET recordIndex=INARRAY(r$(1,recordNamePos TO ),"   ")
         inputName n$,recordIndex-n1
         LET r$(recordIndex,recordNamePos TO )=n$
         saveRecords
         IF recordIndex=1 THEN LET record=score
2000 END PROC
2010 DEF PROC inputName REF n$,lin
       LOCAL c,c$,col,firstCol,k$,lastCol
       LET c$=CHR$ 8+CHR$ 9+CHR$ 12+CHR$ 13,firstCol=scoreDigits+n1,lastCol=firstCol+recordNameLen-n1,col=firstCol,n$="   "
       WINDOW recordsWin
       normalFont
2020   DO
         LET col=col*(col>=firstCol AND col<=lastCol)+firstCol*(col>lastCol)+lastCol*(firstCol>col)
         PRINT AT lin,firstCol;n$;AT lin,col; FLASH n1;n$(col-firstCol+n1)
         GET k$
         LET c=INSTRING(n1,c$,k$)
       EXIT IF c=n4 AND n$<>"   " AND n$(n1)<>" "
         ON c+n1
           normalKey
           leftKey
           rightKey
           deleteKey
2030   LOOP
       gameFont
     END PROC
2040 DEF PROC normalKey
       LET k$=SHIFT$(1,k$)
       IF k$>=" " AND k$<="Z" THEN LET n$(col-firstCol+n1)=k$
         rightKey
2050 END PROC
2060 DEF PROC leftKey
       LET col=col-n1
     END PROC
2070 DEF PROC rightKey
       LET col=col+n1
     END PROC
2080 DEF PROC deleteKey
       IF col>firstCol THEN LET n$=n$(2 TO )+" "
         leftKey
2090 END PROC
2100 DEF PROC recordsScreen
       CLS n0
       title
       recordsTitle
       CLS recordsWin
       recordsTable
     END PROC
2110 DEF PROC recordsTitle
       LOCAL t$,l,s,y
       LET y=maxY-VAL "20"
       ON lang
         LET t$="Mejores perdedores"
         LET t$="Plej bonaj malvenkintoj"
         LET t$="Best losers"
2120   LET l=LEN t$
       FOR s=n1 TO n8
         PLOT CSIZE s,n16; INK menuInk; OVER n0;(maxX-s*l)/n2,y;t$
       NEXT s
     END PROC
2130 DEF PROC recordsTable
       LOCAL r
       WINDOW recordsWin
       FOR r=n1 TO records
         gameFont
         PRINT AT r-n1,n0; USING m$;NUMBER(r$(r, TO n2))
         normalFont
         PRINT AT r-n1,scoreDigits+n1;r$(r,n3 TO )
       NEXT r
     END PROC
2140 
     REM ## Meta

2150 DEF PROC s clearing
       DEFAULT clearing=SGN PI
2160   ERASE d*"alien-b~"
       ERASE d*"alien-b" TO "alien-b~"
2170   DELETE 2200 TO
2180   IF clearing THEN CLEAR
         SAVE d*"alien-b" LINE SGN PI
         STOP
       ELSE
         SAVE d*"alien-b" LINE SGN PI
2190 END PROC

Descargas

Las imágenes de disquete de Plus D contienen, además del programa Alien-B y todos sus programas herramienta:

Beta DOS 1.3 (1990), corregido con los programas Betafix publicados en las publicaciones Format (número 9/9, de 1996-05) y Outlet (número 132, de 1998).
Beta BASIC 4.0+D (1987), para ZX Spectrum 128 con interfaz Plus D.

Imágenes comprimidas de disquete de Plus D:

alien-b.mgt.gz (293.56 KiB) Imagen de disquete de Plus D, comprimida con gzip.
alien-b.mgt.zip (293.09 KiB) Imagen de disquete de Plus D, comprimida con zip.

El disquete tiene el fichero habitual Autoload, que carga Beta BASIC y el juego tras el arranque del sistema operativo de disco.

Cómo arrancar el programa

Se necesita un emulador de ZX Spectrum 128 que emule también la interfaz Plus D (como por ejemplo Fuse; hay emuladores de ZX Spectrum para muchos sistemas operativos) y seguir estos pasos:

Elegir en el emulador la combinación de ZX Spectrum 128 con interfaz Plus D.
Elegir «BASIC 123» del menú inicial de ZX Spectrum 128.
«Meter el disquete»... o sea asociar el fichero de la imagen de disquete MGT (descomprimido) a la disquetera 1. La manera de hacer esto depende del emulador.
Teclear el comando RUN de BASIC. Eso cargará el sistema operativo de disco y después el fichero Autoload, que hace el resto.

Páginas relacionadas

Futuros invasores alienígenas más calmaditos; Beta BASIC y la relatividad de la velocidad: Apuntes dispersos de un (retro)programador. 31 de mayo de 2010.
El huevo de Forth; los alienígenas en su punto; y un dado que no se mueva: Apuntes dispersos de un (retro)programador. 1 de junio de 2010.
Por una conjunción copulativa; viajando en el tiempo: Apuntes dispersos de un (retro)programador. 18 de julio de 2010.
Una borrachera marciana, un virus mágico y una bandera; 767 octetos más uno; las máquinas sin tiempo: Apuntes dispersos de un (retro)programador. 29 de setiembre de 2010.
Juego de caracteres en Beta BASIC; problemas con causa: Apuntes dispersos de un (retro)programador. 17 de octubre de 2010.
Alien-A: Juego de invasores escrito en Z80 para la Sinclair ZX Spectrum.
Historial de desarrollo de Alien-B: Historial de desarrollo del programa Alien-B, con las principales tareas realizadas en cada día de trabajo.
alien-b-u: Programa herramienta escrito en Beta BASIC para crear los GDU del juego Alien-B.
alien-b-m: Programa herramienta escrito en Beta BASIC para crear los datos de los mensajes del juego Alien-B.
alien-b-r: Programa herramienta escrito en Beta BASIC para crear la tabla de mejores puntuaciones del juego Alien-B.
alien-b-s: Programa herramienta escrito en Beta BASIC para crear las cadenas gráficas del juego Alien-B.
alien-b-t: Programa herramienta escrito en Beta BASIC para crear gráficos necesarios para el juego Alien-B.
Apuntes sobre Beta BASIC 4.0+D: Relación de características destacadas, limitaciones, fallos y trucos de Beta BASIC 4.0+D (para ZX Spectrum 128 con interfaz +D).