Programa 14 - Código para dibujar mapas con agua y montañas - AMSTRAD

Este código, escrito en BASIC para AMSTRAD, dibuja un mapa en "3D", representando el agua de color azul y las elevaciones y montañas de color rojo.

Código BASIC

10 DEFINT a-n:INK 0,0:BORDER 0:CLS
20 DIM d(64,32):zzz=TIME:RANDOMIZE zzz
30 INPUT "Nivel de recursion";le
40 MODE 1
50 ds=2:FOR n=1 TO le:ds=ds+2^(n-1):NEXT n
60 mx=ds-1:my=mx/2:rh=PI*30/180:vt=rh*1.2
70 FOR n=1 TO le:l=10000/1.8^n
80 PRINT "Trabajando en el nivel ";n
90 ib=mx/2^n:sk=ib*2
100 GOSUB 160:'Alturas a lo largo de x
110 GOSUB 230:'Alturas a lo largo de y
120 GOSUB 300:'Alturas en la diagonal
130 NEXT n
140 GOTO 650:'Dibujo
150 'Alturas en direccion x
160 FOR ye=0 TO mx-1 STEP sk
170 FOR xe=ib+ye TO mx STEP sk
180 ax=xe-ib:ay=ye:GOSUB 380:d1=d:ax=xe+ib:GOSUB 380:d2=d
190 d=(d1+d2)/2 + RND(1)*l/2-l/4:ax=xe:ay=ye:GOSUB 430
200 NEXT xe
210 NEXT ye:RETURN
220 'Alturas en el eje y
230 FOR xe=mx TO 1 STEP -sk
240 FOR ye=ib TO xe STEP sk
250 ax=xe:ay=ye+ib:GOSUB 380:d1=d:ay=ye-ib:GOSUB 380:d2=d
260 d=(d1+d2)/2+RND(1)*l/2-l/4:ax=xe:ay=ye:GOSUB 430
270 NEXT ye
280 NEXT xe:RETURN
290 'Alturas en la diagonal
300 FOR xe=0 TO mx-1 STEP sk
310 FOR ye=ib TO mx-xe STEP sk
320 ax=xe+ye-ib:ay=ye-ib:GOSUB 380:d1=d
330 ax=xe+ye+ib:ay=ye+ib:GOSUB 380:d2=d
340 ax=xe+ye:ay=ye:d=(d1+d2)/2+RND(1)*l/2-l/4:GOSUB 430
350 NEXT ye
360 NEXT xe:RETURN
370 'Obtencion de datos de la matriz
380 IF ay>my THEN 400
390 by=ay:bx=ax:GOTO 410
400 by=mx+1-ay:bx=mx-ax
410 d=d(bx,by):RETURN
420 'Escritura en la matriz
430 IF ay>my THEN 450
440 by=ay:bx=ax:GOTO 460
450 by=mx+1-ay:bx=mx-ax
460 d(bx,by)=d:RETURN
470 'Aqui se situa el nivel del mar
480 IF x0<>-999 THEN 510
490 IF zz<0 THEN GOSUB 1080:z2=zz:zz=0:GOTO 630
500 GOSUB 1100:GOTO 620
510 IF z2>0 AND zz>0 THEN 620
520 IF z2<0 AND zz<0 THEN z2=zz:zz=0:GOTO 630
530 w3=zz/(zz-z2):x3=(x2-xx)*w3+xx:y3=(y2-yy)*w3+yy:z3=0
540 zt=zz:yt=yy:xt=xx
550 IF zz>0 THEN 600
560 'Aqui va agua
570 zz=z3:yy=y3:xx=x3:GOSUB 960
580 GOSUB 1080:zz=0:yy=yt:xx=xt:z2=zt:GOTO 630
590 'Emerge del agua
600 zz=z3:yy=y3:xx=x3:GOSUB 960
610 GOSUB 1100:zz=zt:yy=yt:xx=xt
620 z2=zz
630 x2=xx:y2=yy:RETURN
640 'Presentacion en pantalla
650 GOSUB 1120:'Inicializa la pantalla
660 xs=0.05:ys=0.05:zs=0.05:'Factores de escala
670 FOR ax=0 TO mx:x0=-999:FOR ay=0 TO ax
680 GOSUB 380:zz=d:yy=ay/mx*10000:xx=ax/mx*10000-yy/2
690 GOSUB 950:NEXT ay:NEXT ax
700 FOR ay=0 TO mx:x0=-999:FOR ax=ay TO mx
710 GOSUB 380:zz=d:yy=ay/mx*10000:xx=ax/mx*10000-yy/2
720 GOSUB 950:NEXT ax:NEXT ay
730 FOR ex=0 TO mx:x0=-999:FOR ey=0 TO mx-ex
740 ax=ex+ey:ay=ey:GOSUB 380:zz=d:yy=ay/mx*10000
750 xx=ax/mx*10000-yy/2:GOSUB 950:NEXT ey:NEXT ex
760 GOTO 1140:'Acabo y sale del bucle
770 'Rotar
780 IF xx<>0 THEN 810
790 IF yy<=0 THEN ra=-PI/2:GOTO 830
800 ra=PI/2:GOTO 830
810 ra=ATN(yy/xx)
820 IF xx<0 THEN ra=ra+PI
830 r1=ra+rh:rd=SQR(xx*xx+yy*yy)
840 xx=rd*COS(r1):yy=rd*SIN(r1)
850 RETURN
860 '????
870 rd=SQR(zz*zz+xx*xx)
880 IF xx=0 THEN ra=PI/2:GOTO 910
890 ra=ATN(zz/xx)
900 IF xx<0 THEN ra=ra+PI
910 r1=ra-vt
920 xx=rd*COS(r1)+xx:zz=rd*SIN(r1)
930 RETURN
940 'Moverse a (xp,yp)
950 GOSUB 480
960 xx=xx*xs:yy=yy*ys:zz=zz*zs
970 GOSUB 780:'Rotar
980 GOSUB 870:'????
990 IF x0=-999 THEN pr$="M" ELSE pr$="D"
1000 xp=INT(yy)+cx:yp=INT(zz)
1010 GOSUB 1040
1020 RETURN
1030 'dibujar
1040 xp=xp*1.1:yp=yp+260:IF pr$="M" OR f1=1 THEN x8=xp:y8=yp
1050 PLOT x8,y8,f1:DRAW xp,yp,f1:x8=xp:y8=yp:x0=xp
1060 RETURN
1070 'Color del mar
1080 f1=14:RETURN
1090 'Color de tierra
1100 f1=3:RETURN
1110 'Inicializar pantalla o plotter
1120 CLS:RETURN
1130 'Salida
1140 a$=INKEY$:WHILE LEN(a$)=0:a$=INKEY$:WEND
1150 STOP