The ModulAtor

Ublantis' 1st Independent Oberon & Modula-2 Technical Publication

Nr. 92, Oct-2015

ModulaTor logo, 7.8KB

R. Singer, G. Dotzel: Drawing Graftals in Modula-2

Found a program in the archives drawing Graftals. Maybe this describes the idea behind: courses.cs.washington.edu/courses/cse557/02wi/projects/final-project/kws/graftal.html

Uses DEC LSI-11 specific raster scan graphics display controller module RSGraphic. I haven't ported this program to another platform, so I no longer know what exactly it draws.

The COMPUTER LANGUAGE [magazine] no longer exists and I couldn't find the back issues online.

Here are the imported Uni* definition modules.

MODULE graftal;
(*
 source: COMPUTER LANGUAGE [magazine], volume 3, number 7, page 48ff.

 + for GDC-11 Graphics Display Controller (on DEC PDP-11/RT-11)
 by R. Singer, Gunter Dotzel, Aug-1986.
*)

FROM TTIO IMPORT Read,Write;
FROM UnivOutput IMPORT WriteString,Writeln, WriteInt;
FROM UnivString IMPORT ReadString,TermString;
FROM UnivInput IMPORT ReadInt;
FROM Random IMPORT Random;
FROM MMath IMPORT sin, cos;
FROM RSGraphic IMPORT draw, Px, Py, dot, clear, SetMode, PaintMode, Pattern;
FROM GDCSpecification IMPORT PhysHeight, PhysWidth;
FROM GDCCircle IMPORT Circle;

CONST Bit20 = {7}; Bit10 = {6};
TYPE ByteArray = ARRAY [0..10000] OF CHAR;
     CodeArray = ARRAY [0..7],[0..20] OF CHAR;
     RealArray = ARRAY [0..10] OF REAL;

VAR  Code: CodeArray;
     Graftal: ByteArray;
     Ang: RealArray;
     GraftalLen,Gen,NumGen,NumAng,i,j: INTEGER;

     ch: CHAR; isnum: BOOLEAN;
     height: INTEGER;

PROCEDURE Round (x: REAL): INTEGER;
BEGIN RETURN TRUNC(x+0.5);
END Round;

PROCEDURE GetCode(VAR NumVar: INTEGER; VAR Code: CodeArray;
  VAR Ang: RealArray; VAR NumAng: INTEGER);
VAR Key: ARRAY[0..20] OF CHAR;
  d,g: INTEGER;

  PROCEDURE Length (s: ARRAY OF CHAR): CARDINAL;
  VAR i: CARDINAL;
  BEGIN i:=0;
    LOOP
     IF (s[i] = CHAR(0)) OR (i=HIGH(s)) THEN RETURN i; END;
     INC (i);
   END;
  END Length;

BEGIN
  Writeln(Write);
  WriteString(Write,'Enter number of generations: ');
  ReadInt(Read,Write,NumGen,isnum,ch);Writeln(Write);
  FOR d:=0 TO 7 DO
    WriteString(Write,'Enter key for ');WriteInt(Write,d,1);
    WriteString(Write,': ');
    ReadString(Read,Write,Key,FALSE,TermString,ch);Writeln(Write);
    Code[d,0]:=CHAR(Length(Key));
    (*WriteInt(Write, Length(Key),7);WriteInt(Write, INTEGER(Code[d,0]),7);*)
    FOR g:=1 TO INTEGER(Code[d,0]) DO
      CASE Key[g-1] OF
        '0' : Code[d,g]:=0C;|
        '1' : Code[d,g]:=1C;|
        '[' : Code[d,g]:=200C;|
        ']' : Code[d,g]:=100C;
      ELSE HALT;(* error *)
      END;
    END;
    (*WriteInt(Write, INTEGER(Code[d,0]),7);*)
  END;
  WriteString(Write,'Enter number of angles: ');
  ReadInt(Read,Write,NumAng,isnum,ch);Writeln(Write);
  FOR g:=1 TO NumAng DO
    WriteString(Write,'enter angle (deg) ');WriteInt(Write,g,2);
    WriteString(Write,': ');
    ReadInt(Read,Write,i,isnum,ch);Writeln(Write);
    Ang[g-1]:=FLOAT(i)*3.1415/180.;
  END;
END GetCode;

PROCEDURE FindNext(p: INTEGER; VAR Orig: ByteArray; VAR OrigLen: INTEGER)
  : INTEGER;
VAR Found: BOOLEAN;
  Depth: INTEGER;
BEGIN
  Depth:=0;Found:=FALSE;
  WHILE (p < OrigLen) AND NOT Found DO
    p:=p+1;
    IF (Depth=0) AND (Orig[p] < 2C) THEN
      RETURN INTEGER(Orig[p]);
      Found:=TRUE;
    ELSIF (Depth = 0) AND (Bit10 <= BITSET(Orig[p])) THEN
      RETURN 1;
      Found:=TRUE;
    ELSIF Bit20 <= BITSET(Orig[p]) THEN
      Depth:=Depth+1;
    ELSIF Bit10 <= BITSET(Orig[p]) THEN
      Depth:=Depth-1;
    END;
  END;
  IF NOT Found THEN
    RETURN 1;
  END;
END FindNext;

PROCEDURE AddNew(b2,b1,b0: INTEGER;VAR Dest: ByteArray;
  VAR Code: CodeArray;VAR DestLen: INTEGER; NumAng: INTEGER);
VAR d,i: INTEGER;
BEGIN
  d:=b2*4+b1*2+b0;
  (*WriteInt(Write, INTEGER(Code[d,0]),7);*)
  FOR i:=1 TO INTEGER(Code[d,0]) DO
    DestLen:=DestLen+1;
    CASE Code[d,i] OF
      0C,1C : Dest[DestLen]:=Code[d,i];|
      100C : Dest[DestLen]:=CHAR(100B);|
      200C: Dest[DestLen]:=CHAR(200B+
      TRUNC (Random(r1,r2)*(FLOAT(NumAng)(*+1.*))));
        (*Writeln(Write);WriteString(Write,'Winkel');
        WriteInt(Write,TRUNC (Random(r1,r2)*(FLOAT(NumAng)+1.)));*)
    ELSE HALT;(*error*)
    END;
  END;
END AddNew;


VAR r1,r2: INTEGER;

PROCEDURE Generation(VAR Orig: ByteArray; VAR OrigLen: INTEGER;
  VAR Code: CodeArray);
VAR Depth,DestLen,g,a: INTEGER;
  b0,b1,b2: CHAR;
  Stack: ARRAY[0..200] OF INTEGER;
  Dest: ByteArray;
BEGIN
  Depth:=0;DestLen:=0;
  b2:=1C;b1:=1C;
  FOR g:=1 TO OrigLen DO
    IF (Orig[g] < 2C) THEN b2:=b1;b1:=Orig[g];b0:=CHAR(FindNext(g,Orig,OrigLen));
    AddNew(INTEGER(b2),INTEGER(b1),INTEGER(b0),Dest,Code,DestLen,NumAng);
    ELSIF Bit20 <= BITSET(Orig[g]) THEN
      DestLen:=DestLen+1;
      Dest[DestLen]:=Orig[g];
      Depth:=Depth+1;
      Stack[Depth]:=INTEGER(b1);
    ELSIF Bit10 <= BITSET(Orig[g]) THEN
      DestLen:=DestLen+1;
      Dest[DestLen]:=Orig[g];
      b1:=CHAR(Stack[Depth]);
      Depth:=Depth-1;
    END;
  END;
  FOR a:=1 TO DestLen DO
    Orig[a]:=Dest[a];
  END;
  OrigLen:=DestLen;
END Generation;

PROCEDURE PrintGeneration(VAR Graftal: ByteArray; GraftalLen: INTEGER);
VAR p: INTEGER;
BEGIN
  Writeln(Write);
  FOR p:=1 TO GraftalLen DO
    IF (Graftal[p] < 2C) THEN WriteInt(Write,CARDINAL(Graftal[p]),1);END;
    IF Bit20 <= BITSET(Graftal[p]) THEN Write('[');END;
    IF Bit10 <= BITSET(Graftal[p]) THEN Write(']');END;
  END;
  Writeln(Write);
END PrintGeneration;

PROCEDURE DrawGeneration(VAR Graftal: ByteArray; GraftalLen: INTEGER;
  VAR Ang: RealArray;VAR Gen: INTEGER);
CONST ll=22.; fx=10.;
VAR ara,axp,ayp: ARRAY[0..50] OF REAL;
  ra,dx,dy,xp,yp: REAL;
  g,Depth: INTEGER;
BEGIN
  Depth:=0;
  (*GraphColorMode;*)
  xp:=320.; yp:=0.; dx:=0.; dy:=-ll;
  Writeln(Write); WriteString(Write,'Gen');WriteInt(Write,Gen,0);
  FOR g:=1 TO GraftalLen DO
    IF (Graftal[g] < 2C) THEN
      (*(*drop shadow*)
        Draw (Round(xp)-1,Round(yp)-1,
        Round(xp+dx)-1,Round(yp+dy)-1,0);
        plot 0 and 1 as green and yellow*)
      (*Draw (Round(xp),Round(yp),Round(xp+dx),Round(yp+dy),Graftal[g]*2+1);*)
      Px:=Round(xp);Py:=height-Round(yp);
      xp:=xp+dx; yp:=yp+dy;
      IF Graftal[g]=0C THEN Pattern (177777B); (* black *)
      ELSE Pattern(123232B); (* gray *)
      END;
      draw (Round(xp),height-Round(yp)); (* color: Graftal[g]*2+1);*)
    END;
    (*start of branch*)
    IF Bit20 <= BITSET(Graftal[g]) THEN Depth:=Depth+1;
      ara[Depth]:=ra;
      axp[Depth]:=xp;
      ayp[Depth]:=yp;
      ra:=ra+Ang[CARDINAL(BITSET(Graftal[g])*{0..6})];
      dx:=sin(ra)*fx;
      dy:=-cos(ra)*ll;
    END;
    (*end of branch*)
    IF Bit10 <= BITSET(Graftal[g]) THEN
      (*include next line to show red =2 leaves *)
      Circle (Round(xp),height-Round(yp),3);
      ra:=ara[Depth];
      xp:=axp[Depth];
      yp:=ayp[Depth];
      Depth:=Depth-1;
      dx:=sin(ra)*fx;
      dy:=-cos(ra)*ll;
    END;
  END;
END DrawGeneration;

BEGIN
  SetMode(add); clear;
  SetMode(erase); height := PhysHeight;
  GetCode(NumGen,Code,Ang,NumAng);
  GraftalLen:=1;
  Graftal[GraftalLen]:=1C;
  FOR Gen:=1 TO NumGen DO
    Generation(Graftal,GraftalLen,Code);
    DrawGeneration(Graftal,GraftalLen,Ang,Gen);
    PrintGeneration(Graftal,GraftalLen);
  END;
END graftal.


These are a few sets of sample input data:
 
grafta
10
0
1
0
1
0
10[11]
0
0
4
-30
20
-20
10
grafta
20
0
1[1]
1
1
0
11
1
0
6
-30
30
-15
15
-5
5
grafta
25
0
1[1]
1
1
0
11
1
0
4
-30
30
-20
20
grafta
25
0
1[01]
1
1
0
00[01]
1
0
4
-45
45
-30
20
grafta
20
0
1
0
1[01]
0
00[01]
0
0
4
-40
40
-30
30
(Last revised 27-Oct-2015)
IMPRESSUM: The ModulAtor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements; all source code is experimental — use at your own risk. Articles are published at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. You're welcome to submit articles for publication by writing to the Editor

ModulaWare.com website navigator

[ Home | Site_index | Contact | Legal | OpenVMS_compiler | Alpha_Oberon_System | ModulAtor | Bibliography | Oberon[-2]_links | Modula-2_links | modulAware.com's Alpha Oberon System home page (Alignment Trap) | General book recommendations ]

Copyright © (2002-2016) by modulAware.com