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
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.
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.
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