FRACTAL REPORT 13





Simple Speedups Paul McGilly 2

Faster and Nicer Fractal Sets Dr Jules Verschueren 3

Area Preserving Mappings Paul Gailiunas 8

Spirals: Animal, Vegetable, Mineral or Fractal? Nigel Woodhead 10

Shaded Tree Dimensional Models Howard Jones 14

Hyperbolic Patterns with Recursion Ettrick Thomson 16

Wolf's Dust Dr Daniel Wolf 18

Announcements 20

Editorial John de Rivaz 20



Fractal Report is published by Reeves Telecommunications Laboratories Ltd.,

West Towan House, Porthtowan, Truro, Cornwall TR4 8AX, United Kingdom.

Volume 3 no 13 First published December 1990. ISSN applied for.



Announcements



Archimedes Correspondents wanted



Mr J. Mourik, of 3rd Millenium, Box 11, Ammanford, Dyfed, SA18 3WB want Archimedes correspondents. He has 3.5" disks and is interested in cellular autommata, fractal dust and sparklies, and wants help in getting hard copy from images saved to disk, and someone to swap programs with.







Pograma: Paisaje.bas

Función: Generar paisajes fractales mediante latecnica de Desplazamiento de Medio Punto.

Autor: desconocido. Adaptado a Qbasic por José E. Murciano



DEFINT A-N: KEY OFF: SCREEN 9: pi = 3.141592: CLS

DIM d(130, 110)



zzz = TIMER: RANDOMIZE zzz

INPUT "Nivel de recursion ?"; le

CLS

ds = 2: FOR n = 1 TO le: ds = ds + 2 ^ (n - 1): NEXT n

mx = ds - 1: my = mx / 2: rh = pi * 30 / 180: vt = rh * 1.2

FOR n = 1 TO le: l = 10000 / 1.8 ^ n

LOCATE 2, 2: PRINT "Trabajando en el nivel "; n

ib = mx / 2 ^ n: sk = ib * 2

GOSUB 160: 'Altura a lo largo de x

GOSUB 230: 'Altura a lo largo de y

GOSUB 300: 'Altura en la diagonal

NEXT n

GOTO 650: 'Dibujo

'Altura en direccion x



160 FOR ye = 0 TO mx - 1 STEP sk

FOR xe = ib + ye TO mx STEP sk

ax = xe - ib: ay = ye: GOSUB 380: d1 = d: ax = xe + ib:

GOSUB 380: d2 = d

d = (d1 + d2) / 2 + RND(1) * l / 2 - l / 4: ax = xe:

ay= ye: GOSUB 430

NEXT xe

NEXT ye: RETURN

'Altura en el eje y

230 FOR xe = mx TO 1 STEP -sk

FOR ye = ib TO xe STEP sk

ax = xe: ay = ye + ib: GOSUB 380: d1 = d: ay = ye - ib:

GOSUB 380: d2 = d

d = (d1 + d2) / 2 + RND(1) * l / 2 - l / 4: ax = xe:

ay= ye: GOSUB 430

NEXT ye

NEXT xe: RETURN

'Altura en la diagonal

300 FOR xe = 0 TO mx - 1 STEP sk

FOR ye = ib TO mx - xe STEP sk

ax = xe + ye - ib: ay = ye - ib: GOSUB 380: d1 = d

ax = xe + ye + ib: ay = ye + ib: GOSUB 380: d2 = d

ax = xe + ye: ay = ye: d = (d1 + d2) / 2 + RND(1) * l /2 - l / 4: GOSUB 430

NEXT ye

NEXT xe: RETURN

'Obtencion de datos de la matriz

380 IF ay > my THEN 400

by = ay: bx = ax: GOTO 410

400 by = mx + 1 - ay: bx = mx - ax

410 d = d(bx, by): RETURN

'Escritura en la matriz

430 IF ay > my THEN 450

by = ay: bx = ax: GOTO 460

450 by = mx + 1 - ay: bx = mx - ax

460 d(bx, by) = d: RETURN

'Aqui se situa el nivel del mar

480 IF x0 <> -999 THEN 510

IF zz < 0 THEN GOSUB 1080: z2 = zz: zz = 0: GOTO 630

GOSUB 1100: GOTO 620

510 IF z2 > 0 AND zz > 0 THEN 620

IF z2 < 0 AND zz < 0 THEN z2 = zz: zz = 0: GOTO 630

w3 = zz / (zz - z2): x3 = (x2 - xx) * w3 + xx: y3 = (y2 - yy) * w3 + yy: z3 = 0

zt = zz: yt = yy: xt = xx

IF zz > 0 THEN 600

'Aqui va agua

zz = z3: yy = y3: xx = x3: GOSUB 960

GOSUB 1080: zz = 0: yy = yt: xx = xt: z2 = zt: GOTO 630

'Emerge del agua

600 zz = z3: yy = y3: xx = x3: GOSUB 960

GOSUB 1100: zz = zt: yy = yt: xx = xt

620 z2 = zz

630 x2 = xx: y2 = yy: RETURN

'Presentacion en pantalla



650 GOSUB 1120: 'Inicializa la pantalla

xs = .05: ys = .05: zs = .05: 'Factores de escala

FOR ax = 0 TO mx: x0 = -999: FOR ay = 0 TO ax

GOSUB 380: zz = d: yy = ay / mx * 10000: xx = ax / mx * 10000 -yy / 2

GOSUB 950: NEXT ay: NEXT ax

FOR ay = 0 TO mx: x0 = -999: FOR ax = ay TO mx

GOSUB 380: zz = d: yy = ay / mx * 10000: xx = ax / mx * 10000 - yy / 2

GOSUB 950: NEXT ax: NEXT ay

FOR ex = 0 TO mx: x0 = -999: FOR ey = 0 TO mx - ex

ax = ex + ey: ay = ey: GOSUB 380: zz = d: yy = ay / mx * 10000

xx = ax / mx * 10000 - yy / 2: GOSUB 950: NEXT ey: NEXT ex

GOTO 1140: 'Acaba y sale del bucle

'Rotar

780 IF xx <> 0 THEN 810

IF yy <= 0 THEN ra = -pi / 2: GOTO 830

ra = pi / 2: GOTO 830

810 ra = ATN(yy / xx)

IF xx < 0 THEN ra = ra + pi

830 r1 = ra + rh: rd = SQR(xx * xx + yy * yy)

xx = rd * COS(r1): yy = rd * SIN(r1)

RETURN



870 rd = SQR(zz * zz + xx * xx)

IF xx = 0 THEN ra = pi / 2: GOTO 910

ra = ATN(zz / xx)

IF xx < 0 THEN ra = ra + pi

910 r1 = ra - vt

xx = rd * COS(r1) + xx: zz = rd * SIN(r1)

RETURN

'Moverse a (xp,yp)



950 GOSUB 480

960 xx = xx * xs: yy = yy * ys: zz = zz * zs

GOSUB 780: 'Rotar

GOSUB 870

IF x0 = -999 THEN pr$ = "M" ELSE pr$ = "D"

xp = INT(yy) + cx: yp = INT(zz)

GOSUB 1040

RETURN

'Dibujar



1040 xp = xp * 1.1: yp = yp + 260: IF pr$ = "M" OR f1 = 1 THEN x8 = xp: y8 = yp

PSET (x8, 350 - y8), f1: LINE -(xp, 350 - yp), f1: x8 = xp: y8 = yp: x0 = xp

RETURN

'Color



1080 f1 = 9: RETURN

'Color de la tierra



1100 f1 = 6: RETURN

'Iinicializa pantalla o plotter



1120 CLS : RETURN

'Salida



1140 a$ = INKEY$: WHILE LEN(a$) = 0: a$ = INKEY$: WEND

STOP


This page hosted by Get your own Free Home Page