The ModulAtor

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.

```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 UnivOutput IMPORT WriteString,Writeln, WriteInt;
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: ');
FOR d:=0 TO 7 DO
WriteString(Write,'Enter key for ');WriteInt(Write,d,1);
WriteString(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: ');
FOR g:=1 TO NumAng DO
WriteString(Write,'enter angle (deg) ');WriteInt(Write,g,2);
WriteString(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;
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;
RETURN 1;
END;
END FindNext;

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;

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));
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
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(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 ]