Fractals in SuperBasic

[ioannis]

The following code has been adapted for a standard QL. The original program appeared in an article by Michael Barnsley and Alan Sloan in Byte Magazine, back in January 1988. It can generate a number of different fractal shapes, including a fern and Sierpinski triangle. Lines 120 to 160 control the shape that will be produced. Current data will generate a fern.

10 REMark Based on Barnsley, F., and Sloan, A.D.
20 REMark A Better Way to Compress Images
30 REMark BYTE Magazine, Jan 1988, pp 215-222
40 REMark Adapted for Sinclair QL
50 REMark by Ioannis Kapageridis, March 1988
100 INPUT "ENTER NUMBER OF ITERATIONS:";NI
110 DIM A(4),B(4),C(4),D(4),E(4),F(4),P(4)
120 DATA 4
130 DATA .85,4E-2,-4E-2,.85,0,1.6,.85
140 DATA -.15,.28,.26,.24,0,.44,7E-2
150 DATA .2,-.26,.23,.22,0,1.6,7E-2
160 DATA 0,0,0,.16,0,0,1E-2
170 READ M
180 PT=0
190 FOR J=1 TO M
200 READ A(J),B(J),C(J),D(J),E(J),F(J),PK
210 PT=PT+PK
220 P(J)=PT
230 NEXT J
240 MODE 4:WINDOW 512,256,0,0:SCALE 256,0,0:PAPER 0:CLS
250 XSCALE=30
260 YSCALE=20
270 XOFFSET=184
280 YOFFSET=20
290 X=0
300 Y=0
310 FOR N=1 TO NI
320 PK=RND
330 IF PK<=P(1) THEN K=1:ELSE :IF PK<=P(2) THEN K=2:ELSE :IF PK<=P(3) THEN K=3:ELSE :K=4
340 NEWX=A(K)*X+B(K)*Y+E(K)
350 NEWY=C(K)*X+D(K)*Y+F(K)
360 X=NEWX
370 Y=NEWY
380 IF N>10 THEN POINT X*XSCALE+XOFFSET,Y*YSCALE+YOFFSET
390 NEXT N
400 PRINT"PRESS ANY KEY TO END.":PAUSE:CLEAR

An example of the produced image can be seen here:
https://1drv.ms/i/s!ArbzNSRfylKKiyjZhQpmJJub9ZMK

[ioannis]

Adjusting lines 110 to 160 as follows will produce the Sierpinski triangle:

110 DIM A(3),B(3),C(3),D(3),E(3),F(3),P(3)
120 DATA 3
130 DATA .5,0,0,.5,0,0,.33
140 DATA .5,0,0,.5,1,0,.33
150 DATA .5,0,0,.5,.5,.5,.34

an example is shown here:

https://1drv.ms/i/s!ArbzNSRfylKKiyc8DYM372kE6t49

[Derek_Stewart]

Hi,

I tried your fractal programme in SMSQmulator, work really well, I used values of:

fern: 5000
Sierpinski triangle: 1000

gave nice results.

I suppose the programme could be altered read the data from a file then compiled to run faster.

[ioannis]

I will scan the original article from BYTE and send a link. It contains the DATA lines for other shapes. I think the parameters of the code can be adjusted for a higher resolution QL compatible to produce more impressive images. The article also explains how to convert any shape to appropriate values that can be used with the program to regenerate it as a fractal.

[tcat]

Hi,

Fractals, very interesting, to me they seem like God's recipe for common patterns found in Nature, trees, leaves, flakes, etc.

I also run Oberon Station by prof. Wirth, the father of Pascal, Modula, and Oberon.
Sierpisnki and Hilbert curves are demo programs there.

https://en.wikipedia.org/wiki/Oberon_%2 ... _system%29

At that time 60's-70's there were no PCs, so whatever fit onto a desk and did not require a mainframe computer, was called a personal workstation.

Also interesting Zurich University, designed their own desktop stations, Lilith, Ceres. Influenced by Xerox ALTO.

Tom

[tcat]

Hi,

Just for interest, here is the Hilbert. I have it only as Oberon source, as it resembles Pascal to some extent, perhaps it may be recoded into SuperBASIC and run on QL too.

Code: Select all

MODULE Hilbert;  (*NW 8.1.2013  for RISC*)
  IMPORT Display, Viewers, Texts, Oberon, MenuViewers, TextFrames;

  CONST Menu = "System.Close  System.Copy  System.Grow";

  VAR x, y, d: INTEGER;
    A, B, C, D: PROCEDURE (i: INTEGER);

  PROCEDURE E;
  BEGIN Display.ReplConst(Display.white, x, y, d, 1, Display.paint); INC(x, d)
  END E;

  PROCEDURE N;
  BEGIN Display.ReplConst(Display.white, x, y, 1, d, Display.paint); INC(y, d)
  END N;

  PROCEDURE W;
  BEGIN DEC(x, d); Display.ReplConst(Display.white, x, y, d, 1, Display.paint)
  END W;

  PROCEDURE S;
  BEGIN DEC(y, d); Display.ReplConst(Display.white, x, y, 1, d, Display.paint)
  END S;

  PROCEDURE HA(i: INTEGER);
  BEGIN
    IF i > 0 THEN D(i-1); W; A(i-1); S; A(i-1); E; B(i-1) END
  END HA;

  PROCEDURE HB(i: INTEGER);
  BEGIN
    IF i > 0 THEN C(i-1); N; B(i-1); E; B(i-1); S; A(i-1) END
  END HB;

  PROCEDURE HC(i: INTEGER);
  BEGIN
    IF i > 0 THEN B(i-1); E; C(i-1); N; C(i-1); W; D(i-1) END
  END HC;

  PROCEDURE HD(i: INTEGER);
  BEGIN
    IF i > 0 THEN A(i-1); S; D(i-1); W; D(i-1); N; C(i-1) END
  END HD;

  PROCEDURE DrawHilbert(F: Display.Frame);
    VAR k, n, w, x0, y0: INTEGER;
  BEGIN k := 0; d := 8;
    IF F.W < F.H THEN w := F.W ELSE w := F.H END ;
    WHILE d*2 < w DO d := d*2; INC(k) END ;
    Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace);
    x0 := F.W DIV 2; y0 := F.H DIV 2; n := 0;
    WHILE n < k DO
      d := d DIV 2; INC(x0, d DIV 2); INC(y0, d DIV 2);
      x := F.X + x0; y := F.Y + y0; INC(n); HA(n)
    END
  END DrawHilbert;

  PROCEDURE Handler(F: Display.Frame; VAR M: Display.FrameMsg);
    VAR F0: Display.Frame;
  BEGIN
    IF M IS Oberon.InputMsg THEN
      IF M(Oberon.InputMsg).id = Oberon.track THEN
        Oberon.DrawMouseArrow(M(Oberon.InputMsg).X, M(Oberon.InputMsg).Y)
      END
    ELSIF M IS MenuViewers.ModifyMsg THEN
      F.Y := M(MenuViewers.ModifyMsg).Y; F.H := M(MenuViewers.ModifyMsg).H; DrawHilbert(F)
    ELSIF M IS Oberon.ControlMsg THEN
      IF M(Oberon.ControlMsg).id = Oberon.neutralize THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H) END
    ELSIF M IS Oberon.CopyMsg THEN
      NEW(F0); F0^ := F^; M(Oberon.CopyMsg).F := F0
    END
  END Handler;

  PROCEDURE New(): Display.Frame;
    VAR F: Display.Frame;
  BEGIN NEW(F); F.handle := Handler; RETURN F
  END New;

  PROCEDURE Draw*;
    VAR V: Viewers.Viewer; X, Y: INTEGER;
  BEGIN Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y);
    V := MenuViewers.New(TextFrames.NewMenu("Hilbert", Menu), New(), TextFrames.menuH, X, Y)
  END Draw;
  
BEGIN A := HA; B := HB; C := HC; D := HD
END Hilbert.

It would be interesting to see the article from BYTE Magazine.

Tomas

[tcat]

Hi Ioannis,

Any chance to share the article from BYTE magazine, I hope I did not put you off by my posts?

Many thanks
Tomas

[Derek_Stewart]

Hi,

Alot of Byte Magazine have been scanned on Archive.org, using this link:
https://archive.org/details/byte-magazine

I could not find Volume 13 Number 1: January 1988., but after a web search. The article can be seen at:
http://www.vasulka.org/archive/Writings ... ession.pdf

[ioannis]

Hello and apologies for taking this long to post the article:

https://1drv.ms/b/s!ArbzNSRfylKKi3bWHYSUm29R8hUH

Ioannis

[ioannis]

Hi Ioannis,

Any chance to share the article from BYTE magazine, I hope I did not put you off by my posts?

Many thanks
Tomas

Certainly not Tomas - I just saw the messages.