alien-b-m
Descripción del contenido de la página
Programa herramienta escrito en Beta BASIC para crear los datos de los mensajes del juego Alien-B.
Etiquetas:
Este programa herramienta, escrito en Beta BASIC, crea los ficheros de datos con las coordenadas gráficas de cada punto de de los mensajes finales del juego Alien-B. De este modo la impresión de los mensajes es mucho más rápida.
Pantallazos
Código fuente
10 REM alien-b-m
20 REM This tool program creates graphic data needed by the program Alien-B and stores it in disk files. The data will be used to write messages at the end of the game.
30 REM Copyright (C) 2010 Marcos Cruz (programandala.net)
40 REM Licencia/Permesilo/License
programandala.net/license
50
REM ######################
Changelog
60 REM 2010-12-07 First draft.
70 REM 2010-12-09 Rewritten.
80 REM 2011-01-29 New draft of proc coords, from scratch. New proc charFrame.
90 REM 2011-02-01 Test procs. Little changes.
100 REM 2011-02-04 Status info on the bottom. Char grid can be turned on and of. Simplified data lines. UDG chars can be included in the texts. Config fags.
110 REM 2011-02-05 The needed UDG are not created here any more; the main UDG file is loaded instead. No DATA lines any more; the prog msg is called directly.
120
REM ######################
G+DOS/Beta DOS
130 POKE @0,7
REM border change
140
REM ######################
Beta BASIC
150 LET bbOn=58419
LET bbOff=59904
160 RANDOMIZE USR bbOn
170 LET xol=0,yos=0
180 DEF KEY "m","msg :"
190 WINDOW 0
200
REM ######################
ZX Spectrum
210 LET sysFont=15360
REM system font address (from char 0)
220 LET sysUdgFont=USR "a"-8*144
REM UDG pseudo font address(from char 0)
230
REM ######################
Alien-B's values, needed here too
240 LET langs=3,es=1,eo=2,en=3
REM languages
250 LET maxY=175,maxX=255
REM screen size
260 LET aW=8,groundMaxY=55,groundMinX=aW,groundMinY=0,groundH=groundMaxY+1
270
REM ######################
Constants
280 LET black=0,blue=1,red=2,cyan=5,white=7
290 LET vpX=maxX/2,vpY=maxY
REM vanishing point
300 LET lastId=11
REM last text id in every language (the first is 0)
310 LET datumLen=4,sortField=1,xField=2,yField=3,sizeField=4
REM datum lengths and offsets of the final data array (hard coded in the proc tripodWrite of the main program)
320
REM ######################
Global variables
330 LET x0=0,y0=0
REM coords of the upper left pixel of the text zone
340
REM ######################
Config flags
350 LET charGrid=0
REM show the character grid?
360 LET messageFrame=1
REM show the message frame?
370 LET charFrame=0
REM show a frame for every character?
380 LET show=2
REM What must be drawn at the calculated coordinates? (1=point; 2=circle; other value=nothing)
390
REM ######################
Functions
400 DEF FN z(r)=INT ((r+2)/3+.5)
REM point size of a row
410
REM ######################
UDG
420 LOAD d*"udg"CODE USR "A"
LET iExcl=147
430
REM ######################
Main
440 LET maxDataLen=0,b$=""
REM size and filename of tebiggest data array
450 LET nextId=0
REM id of the next text
460
LET language=es
REM Spanish messages
470 msg CHR$ iExcl+"FIN!",4,4
480 msg "FIN",4,4
490 msg "F I N",4,4
500 msg "F I N A L",3,4
510 msg "HE VENCIDO",3,4
520 msg CHR$ iExcl+"HE VENCIDO!",2.1,4
530 msg "HAS PERDIDO",2.7,4
540 msg CHR$ iExcl+"HAS PERDIDO!",2.4,4
550 msg "PERDISTE",3.5,4
560 msg CHR$ iExcl+"PERDISTE!",3.1,4
570 msg "LA CAGASTE",3,4
580 msg CHR$ iExcl+"LA CAGASTE!",2.2,4
590
LET language=en
REM English messages
600 msg "I WIN",4,5
610 msg "I WIN!",4,5
620 msg "THE END",3,4
630 msg "GAME OVER",3,4
640 msg "GAME OVER!",3,4
650 msg "YOU LOSE",2.7,4
660 msg "YOU LOSE!",2.7,4
670 msg "IT'S DONE",2.7,4
680 msg "IT'S DONE!",2.6,4
690 msg "IT'S OVER",2.7,4
700 msg "IT'S OVER!",2.6,4
710 msg "DONE!",5,4
720
LET language=eo
REM Esperanto messages
730 msg "FINITE",4,4
740 msg "FINITE!",3,4
750 msg "FI AL VI",2.9,4
760 msg "EKS PRI VI",2.9,4
770 msg "EKS PRI VI!",2.7,4
780 msg "F I N O",4,4
790 msg "FIN'",5,4
800 msg "MI VENKIS",3,4
810 msg "MI VENKIS!",2.8,4
820 msg "VI MALVENKIS",2.5,4
830 msg "VI MALVENKIS!",2.3,4
840 msg "FARITE!",2.5,4
850
REM End
860 PRINT '"The biggest array ("; INK 1;maxDataLen;" bytes"; INK 0;")"';"has been saved into file"' INK 1;b$; INK 0;"."
870
REM ######################
Make
880 DEF PROC msg t$,scaleX,scaleY,lang,id
890 DEFAULT t$="NO MESSAGE!",scaleX=3,scaleY=3,lang=language,id=nextId
900 LOCAL a,b,bit,c,char,d$,dataLen,f$,gridCol,gridLine,n,p,p$,pixels,r,row
910 IF id>lastId THEN PRINT '"Text ID too big"
STOP
920 CLS #
ground
KEYWORDS 0
PRINT AT 0,0; INVERSE 1;"alien-b-m"'' INVERSE 0;"Language:";lang;" Text id:";HEX$(id)'"Text:"; INK 1;t$
KEYWORDS 1
930 DIM p$(1,datumLen)
REM final data
940 DIM d$(1,datumLen)
REM temporary datum
950 LET gridLine=5,gridCol=12
960 LET tWC=LEN t$
970 LET tW=8*tWC
REM text width in pixels
980 LET x0=INT ((maxX-tW*scaleX)/2)
990 LET y0=INT (groundH/2+4*scaleY)
1000 IF messageFrame THEN charFrame 0,tWC,white
1010 status "Getting the ink pixels..."
1020 FOR c=0 TO tWC-1
REM char position
1030 LET char=CODE (t$(c+1))
IF char=32 THEN GO TO 1140
1040 IF charFrame THEN charFrame c
1050 LET a=sysFont*(144>char)+sysUdgFont*(char>143)+8*char
REM char pattern address
1060 FOR r=0 TO 7
REM rows per char
1070 LET row=PEEK (a+r)
IF NOT row THEN GO TO 1120
1080 IF charGrid THEN PRINT AT gridLine+r-1,gridCol;BIN$(row)
1090 INK red
FOR b=0 TO 7
REM bits per row
1100 IF AND(PEEK (a+r),2^b) THEN coords c,r,b,d$(1)
COPY d$ TO p$
IF charGrid THEN PRINT AT gridLine+r-1,gridCol+7-b; PAPER 1;" "
1110 NEXT b
INK black
1120 NEXT r
1130 IF charGrid THEN FOR r=0 TO 7
PRINT AT gridLine+r,gridCol;STRING$(8," ")
NEXT r
1140 NEXT c
1150 DELETE p$(1)
LET pixels=LENGTH(1,"p$()"),dataLen=datumLen*pixels
1160 status "Saving th6e data array"+CHR$ 13+"("+STR$ pixels+" pixels, "+STR$ dataLen+" bytes)..."
1170 LET f$="message"+STR$ lang+HEX$(id)
1180 RANDOMIZE USR bbOff
SAVE OVER d*;f$ DATA p$()
RANDOMIZE USR bbOn
1190 status "Done!"
1200 IF dataLen>maxDataLen THEN LET maxDataLen=dataLen,b$=f$
REM keep the filename whose size is bigger so far
1210 LET nextId=(id+(lastId>id))*(id<>lastId)
1220 END PROC
1230 DEF PROC ground
1240 LOCAL m$,n
1250 LET m$=CHR$ 143+CHR$ 143
REM margin to detect text pixels out of the ground
1260 KEYWORDS 0
FOR n=13 TO 20
PRINT AT n,0; PAPER cyan; INK white;m$;STRING$(28," ");m$
NEXT n
KEYWORDS 1
1270 END PROC
1280 DEF PROC charFrame charPos,chars,color
1290 DEFAULT charPos=0,chars=1,color=black
1300 LOCAL frameX,frameY,frameW,frameH
1310 LET frameX=x0+charPos*8*scaleX,frameY=y0,frameW=chars*8*scaleX,frameH=8*scaleY
1320 PLOT INK color;frameX,frameY
DRAW INK color;frameW,0
DRAW INK color;0,-frameH
DRAW INK color;-frameW,0
DRAW INK color;0,frameH
1330 END PROC
1340 DEF PROC coords char,row,bit, REF d$
1350 LOCAL size,x,y
REM pixel size and coords
1360 LOCAL x2,y2
REM left bottom coords of the character's theorical space
1370 LOCAL charH
REM character height in pixels
1380 LOCAL a,b
REM sides of the vanishing point triangle
1390 LOCAL a2,b2
REM sides of the pixel triangle
1400 LET charH=8*scaleY
1410 LET x=x0+char*8*scaleX+8*scaleX-bit*scaleX,y=y0-row*scaleY
1420 LET x2=x0+char*8*scaleX,y2=y0-charH
1430 LET a=vpX-x,b=y2-y0,b2=y2-y,a2=a*b2/b,x=x+a2/6
1440 LET size=FN z(row)
1450 ON show
PLOT x,y
CIRCLE x,y,size
1460 LET d$(1,sortField)=CHR$ (RNDM(255)),d$(1,xField)=CHR$ x,d$(1,yField)=CHR$ y,d$(1,sizeField)=CHR$ size
REM returned data
1470 END PROC
1480
REM ######################
Info
1490 DEF PROC status m$
INPUT ""
PRINT #0;AT 0,0;m$
END PROC
1500 DEF PROC showPixels m$,n
PRINT #0;AT 0,0;m$;": "; INVERSE 1;USING$("###",n)
END PROC
1510
REM ######################
Tools
1520 DEF PROC writeAll
1530 LOCAL l,i
1540 FOR l=1 TO langs
FOR t=0 TO lastText
write l,t
PAUSE 50
NEXT t
NEXT l
1550 END PROC
1560 DEF PROC write lang,id
1570 LOCAL p,p$,size,x,y
1580 DEFAULT lang=RNDM(langs-1)+1,id=RNDM(lastText)
1590 CLS #
ground
1600 LOAD d*"message"+STR$ lang+HEX$(id) DATA p$()
ON RNDM(1)+1
SORT p$()(RNDM(datumLen-1)+1)
SORT INVERSE p$()(RNDM(datumLen-1)+1)
1610 FOR p=SGN PI TO LENGTH(1,"p$()")
LET x=CODE p$(p,xField),y=CODE p$(p,yField),size=CODE p$(p,sizeField)
1620 CIRCLE x,y,size
IF size THEN FILL x,y
1630 NEXT p
1640 END PROC
1650 DEF PROC dump lang,id
1660 LOCAL pixels,p,p$,size,x,y
1670 DEFAULT lang=RNDM(langs-1)+1,id=RNDM(lastText)
1680 LOAD d*"message"+STR$ lang+HEX$(id) DATA p$()
1690 LET pixels=LENGTH(1,"p$()")
1700 FOR p=SGN PI TO pixels
LET x=CODE p$(p,xField),y=CODE p$(p,yField),size=CODE p$(p,sizeField)
PRINT USING$("000",p);"/";USING$("000",pixels);": "; INVERSE 1;USING$("000",x);USING$(" 000",y);USING$(" 000",size)
NEXT p
1710 END PROC
1720 DEF PROC sizes
LOCAL r,size,y
1730 FOR r=0 TO 7
REM text rows
1740 LET size=FN z(r)
1750 PRINT AT r,0;r;AT r,3; USING "00.00";size;AT r,16;CODE CHR$ size
1760 LET y=175-(r*8)
CIRCLE 80,y,size
CIRCLE 152,y,CODE CHR$ size
REM demo circles, with and without decimals
1770 NEXT r
1780 END PROC
1790
REM ######################
Meta
1800 DEF PROC s
1810 ERASE d*"alien-b-m~"
1820 ERASE d*"alien-b-m" TO "alien-b-m~"
1830 CLEAR
SAVE d*"alien-b-m"
STOP
1840 END PROC
Descargas
Este programa está en el disco de Alien-B.