programming of pattern

The basic idea of how to generate all possible permutations of the 4 elements (compare Assignment 1) was the parallel use of an array list of all possible positions for the next entry. A pointer and an infill of zeros was introduced to avoid a dynamic array. The generation of a new permutation is then carried out in the procedure Generate and the function Reorder. With the function NewPattern the generated permuation is compared to the list of already exiting permutations, added to it if the pattern is new and printed out by procedure PrintOut . After generating all 24 different permutations the programm terminats.

PROCEDURE pattern;

VAR
   i,j : INTEGER;
   element : ARRAY[1..4] OF INTEGER;    (* basic and generated one*)
   pattern : ARRAY[1..24,1..4] OF INTEGER; (* possible pattern *)
   
   (* --- function for reordering of the list of available positions --- *)
   
   FUNCTION Reorder(olist:ARRAY[1..4] OF INTEGER):ARRAY[1..4] OF INTEGER;
         
   VAR
      i : INTEGER; (* counter *)
      s : INTEGER; (* storage *)

   BEGIN
      FOR i:=4 DOWNTO 2 DO
         IF olist[i]=0 THEN
            BEGIN
               olist[i]:=olist[i-1];
               olist[i-1]:=0;
            END;   
      Reorder:=olist;   
   END;


   (* --- procedure to generate a permutation of the basic element --- *)

   PROCEDURE Generate(VAR NewElement:ARRAY[1..4] OF INTEGER);

   VAR
      i : INTEGER;                    (* counter *)
      basic : ARRAY[1..4] OF INTEGER; (* basic element*)
      list : ARRAY[1..4] OF INTEGER;  (* list of available positions *)
      r,n : INTEGER;                  (* range and generated random number *)
      lpos : INTEGER;                 (* position in list *)   

   BEGIN
      FOR i:=1 TO 4 DO (* initialization of basic elements and available positions *)
      BEGIN
         basic[i]:=i;
         list[i]:=i;
      END;
      r:=3;
      FOR i:=1 TO 4 DO (* generate a pattern *)
         BEGIN
            n:=i+Random*r; (* take an available position in the list *) 
            lpos:=list[n]; (* read the corresponding entry *)
            list[n]:=0;    (* erase entry *)
            NewElement[lpos]:=basic[i]; (* place basic element at that position *)
            list := Reorder(list);
            r:=r-1;
         END;
   END;


   (* ---- function to compare the generated element with existing patterns --- *)

   FUNCTION NewPattern(list: ARRAY[1..4] OF INTEGER; n: INTEGER):BOOLEAN;

   VAR
      i,j : INTEGER; (* counter *)
      t : INTEGER; 
      test : BOOLEAN;

   BEGIN
      test:=TRUE;
      FOR i:=1 TO n DO
         BEGIN
            t:=0;
            FOR j:=1 TO 4 DO
               IF pattern[i,j]=list[j] THEN t:=t+1;
            IF t=4 THEN test:=FALSE;
         END;
      NewPattern:=test;
   END;
            

   (* --- print the new pattern --- *)

   PROCEDURE PrintOut(NewElement:ARRAY[1..4] OF INTEGER; i: INTEGER);

   VAR 
      j: INTEGER; (* counter *)
      h,v,r,c : INTEGER; (* horizontal and vertical shift for print out *)

   BEGIN
      FillPat(0);
      PenSize(10);
      r:=0;c:=i;
      WHILE c>6 DO (* calculate the row r and colummn i of the element *)
         BEGIN
            r:=r+1;
            c:=c-6;
         END;
      FOR j:= 1 TO 4 DO
         BEGIN 
            IF j<3 THEN v:=0 ELSE v:=1; (* vertical position in a 2x2-array *)
            IF (j MOD 2 = 1) THEN h:=0 ELSE h:=1; (* horizontal position in a 2x2-array *)
            ArcByCenter(10*c+5*h,5*v+10*r,5,0,90);
            Rotate(90*NewElement[j]); 
            ReDrawAll;
            DSelectAll;
         END;
   END;


(* --- main body --- *)

BEGIN
   i:=1;
   REPEAT
      Generate(element);
      IF NewPattern(element,i-1) THEN
         BEGIN
            FOR j:=1 TO 4 DO
               pattern[i,j]:=element[j];
            PrintOut(element,i);
            i:=i+1;
         END;
   UNTIL i=25;
END;
RUN(pattern);

further development

animation (1.1 MB)

Using six elements to choose from the alphabet of 24 different letters out of four elements was then extended to an alphabet of 360 possible letters. This way, the whole ASCII-table could be coded and used to generate a pattern by reading a textfile sequentially. In order to receive a highly connected pattern, that is a pattern with smooth pathes along the arcs, the translated textfile was used as input for a cellular automata with the goal to optimize the amount of smooth connections. For this purpose the function CellType was developed to obtain a measure for the ability to move through the cell along a smooth path. The function checks the connection at the center point of each cell and returns 0 if it is non-smooth and 1 otherwise. Similarly, the function CCheck calculates the amount of smooth connections between a cell and its surrounding neighborhood. The automata then takes up the type of a cell as main criteria: a cell of type 0 is regarded as dead, a cell of type 1 as alive. In every generation the automata replaces non-isolated dead cells or badly connected living cells by a new candidate out of a pool of cells of type one. This way, the pattern improves gradually.

The expression of the final object depends essentially on the density of the pattern. This particular feature can be influenced by three of the five paramters. With the breadth of the arcs the density of the pattern can be adjusted directly. The radius and the amount of cells per row have an influence on the size of each cell, therewith affecting the density of the pattern and the height of the cylinder indirectly. These paramaters act diametrically: an increasing radius leads to an increasing cell size, hence to a decreasing density; an increasing amount of cells per row leads to a decreasing cell size and therefore to an increasing density. With the two remaining parameters the number of rows and the thickness of the wall can be adjusted.

PROCEDURE pattern1;

CONST
   columns = 8;    (* cells per row *)
   rows = 3;       (* number of layers of cylinder *)
   radius = 80;    (* radius on the outside of cylinder *) 
   thickness = 7.5;(* breadth of arcs *)
   depth = 8;      (* wall thickness of cylinder *)   
                                             

VAR
   i,i_plus,i_p,j,l,nc,cc,k : INTEGER;
   max_i,m_i,cr : INTEGER;
   col_i,row_i : REAL;
   InputText,data : STRING;
   letter : CHAR;
   lnumber,loops : INTEGER;
   element : ARRAY[1..4] OF INTEGER;    
   alphabet : ARRAY[0..255,1..4] OF INTEGER; 
   alphabetplus : ARRAY[0..255] OF INTEGER;   
   GoOn : BOOLEAN;   
   pattern, patternTemp : DYNARRAY[,] OF INTEGER; 
   d,factor : REAL;
   alpha,beta, base,height : REAL; 
   hl : HANDLE;   
   r,g,b : LONGINT;
   
   
   (* --- reordering of the list of available positions --- *)
   
   FUNCTION Reorder(olist:ARRAY[1..4] OF INTEGER):ARRAY[1..4] OF INTEGER;
         
   VAR
      i : INTEGER; (* counter *)
      s : INTEGER; (* storage *)

   BEGIN
      FOR i:=4 DOWNTO 2 DO
         IF olist[i]=0 THEN
            BEGIN
               olist[i]:=olist[i-1]; (* shift content down ... *)
               olist[i-1]:=0;        (* ... and fill up rest with zero *)
            END;   
      Reorder:=olist;   
   END;


   (* --- generate a permutation of basic elements --- *)

   PROCEDURE Generate(VAR NewElement:ARRAY[1..4] OF INTEGER);

   VAR
      i : INTEGER;                    (* counter *)
      basic : ARRAY[1..6] OF INTEGER; (* basic element*)
      list : ARRAY[1..4] OF INTEGER;  (* list of available positions *)
      r,n : INTEGER;                  (* range and generated random number *)
      lpos : INTEGER;                 (* position in list *)   

   BEGIN
      FOR i:=1 TO 6 DO basic[i]:=i;          (* six different elements *)
      n:=1+random*5;                         (* choose one ... *)
      FOR i:=n TO 5 DO basic[i]:=basic[i+1]; (* ... erase it out of the list of available elements *)
      n:=1+random*4;                         (* chose another one ... *)
      FOR i:=n TO 4 DO basic[i]:=basic[i+1]; (* ... erase it out of the list of available elements = basic[1] ... basic[4] *)
      FOR i:=1 TO 4 DO list[i]:=i;
      r:=3;
      FOR i:=1 TO 4 DO     (* generate a pattern *)
         BEGIN
            n:=i+Random*r; (* take an available position in the list *) 
            lpos:=list[n]; (* read the corresponding entry *)
            list[n]:=0;    (* erase entry *)
            NewElement[lpos]:=basic[i]; (* place basic element at that position *)
            list := Reorder(list);
            r:=r-1;
         END;
   END;


   (* ---- compare the generated element with existing patterns --- *)

   FUNCTION NewPattern(list: ARRAY[1..4] OF INTEGER; n: INTEGER):BOOLEAN;

   VAR
      i,j : INTEGER; 
      t : INTEGER; 
      test : BOOLEAN;

   BEGIN
      test:=TRUE;
      FOR i:=1 TO n DO
         BEGIN
            t:=0;   (* amount of equal entries *)
            FOR j:=1 TO 4 DO
               IF alphabet[i,j]=list[j] THEN t:=t+1;
            IF t=4 THEN test:=FALSE; (* all entries equal = permutation exists already *)
         END;
      NewPattern:=test;
   END;
            

   (* --- print element using arcs --- *)

   PROCEDURE PrintOutArc(NewElement:ARRAY[1..4] OF INTEGER; i: INTEGER);

   VAR 
      j: INTEGER; 
      h,v,r,c : INTEGER; (* horizontal and vertical shift for print out *)
      
   BEGIN
      FillBack(0,0,0);
      PenFore(0,0,0);
      r:=0;c:=i;
      WHILE c>columns DO (* calculate the row r and colummn i of the element *)
         BEGIN
            r:=r+1;
            c:=c-columns;
         END;
      FOR j:= 1 TO 4 DO
         BEGIN 
            IF j<3 THEN v:=0 ELSE v:=1;           (* vertical position in a 2x2-array *)
            IF (j MOD 2 = 1) THEN h:=0 ELSE h:=1; (* horizontal position in a 2x2-array *)   
            CASE NewElement[j] OF
               1..4:BEGIN
                     FillPat(0);
                     ArcByCenter(10*c+5*h,5*v+10*r,5,0,90);   
                     Rotate(-90*NewElement[j]); 
                   END;   
                  5:BEGIN
                     FillPat(0);
                     ArcByCenter(10*c+5*h,5*v+10*r,5,0,90);   
                     Duplicate(0,0);
                     Rotate(180);
                     END;   
                  6:BEGIN   
                     FillPat(0);
                     ArcByCenter(10*c+5*h,5*v+10*r,5,0,90);   
                     Rotate(90);
                     Duplicate(0,0);
                     Rotate(180);
                   END;
            END;
            ReDraw;
            DSelectAll;
         END;
   END;

   (* ---  arc with breadth --- *)

   PROCEDURE BasicElement2d(n:INTEGER);

   VAR
      ptX,ptY,arcRadius : REAL;
      vertexType,test : INTEGER;

   BEGIN
      ClosePoly;
      BeginPoly;                  (* define element as polyline *)
         AddPoint(base-d,0);      (* base = dimension of square; d = amount of overlapping with next cell *) 
         AddPoint(base-d,-d);
         AddPoint(base+d,-d);
         AddPoint(base+d,0);
         AddPoint(base+d,base+d);
         AddPoint(0,base+d);
         AddPoint(-d,base+d);
         AddPoint(-d,base-d);
         AddPoint(0,base-d);
         AddPoint(base-d,base-d);
      EndPoly;
      GetPolylineVertex(LNewObj,2,ptX,ptY,vertexType,arcRadius); (* pick vertex ... *)
      SetPolylineVertex(LNewObj,2,ptX,ptY,3,d,true);             (* ... and make it round *) 
      GetPolylineVertex(LNewObj,3,ptX,ptY,vertexType,arcRadius);
      SetPolylineVertex(LNewObj,3,ptX,ptY,3,d,true);
      GetPolylineVertex(LNewObj,5,ptX,ptY,vertexType,arcRadius);
      SetPolylineVertex(LNewObj,5,ptX,ptY,3,base+d,true);
      GetPolylineVertex(LNewObj,7,ptX,ptY,vertexType,arcRadius);
      SetPolylineVertex(LNewObj,7,ptX,ptY,3,d,true);
      GetPolylineVertex(LNewObj,8,ptX,ptY,vertexType,arcRadius);
      SetPolylineVertex(LNewObj,8,ptX,ptY,3,d,true);
      GetPolylineVertex(LNewObj,10,ptX,ptY,vertexType,arcRadius);
      SetPolylineVertex(LNewObj,10,ptX,ptY,3,base-d,true);
      RotatePoint(base/2,base/2,90*n);
   END;


   (* --- print arcs with thickness --- *)

   PROCEDURE PrintOutArcThick(NewElement:ARRAY[1..4] OF INTEGER; i: INTEGER);

   VAR 
      j: INTEGER; (* counter *)
      h,v,r,c : INTEGER; (* horizontal and vertical shift for print out *)
      a,b,inter : HANDLE;

   BEGIN
      FillBack(0,0,0);
      PenFore(0,0,0);
      FillPat(1);
      r:=0;c:=i;
      WHILE c>columns DO (* calculate the row r and colummn i of the element *)
         BEGIN
            r:=r+1;
            c:=c-columns;
         END;
      FOR j:= 1 TO 4 DO
         BEGIN 
            IF j<3 THEN v:=0 ELSE v:=1;           (* vertical position in a 2x2-array *)
            IF (j MOD 2 = 1) THEN h:=0 ELSE h:=1; (* horizontal position in a 2x2-array *)   
            CASE NewElement[j] OF
               1..4:BEGIN
                     BasicElement2d(NewElement[j]); 
                     MoveObjs(2*base*c+base*h,base*v+2*base*r,FALSE,FALSE);
                     DSelectAll;
                   END;   
                  5:BEGIN
                     BasicElement2d(2);
                     MoveObjs(2*base*c+base*h,base*v+2*base*r,FALSE,FALSE);
                     DSelectAll;
                     BasicElement2d(4);
                     MoveObjs(2*base*c+base*h,base*v+2*base*r,FALSE,FALSE);
                     DSelectAll;
                     END;   
                  6:BEGIN   
                     BasicElement2d(1);
                     MoveObjs(2*base*c+base*h,base*v+2*base*r,FALSE,FALSE);
                     DSelectAll;
                     BasicElement2d(3);
                     MoveObjs(2*base*c+base*h,base*v+2*base*r,FALSE,FALSE);
                     DSelectAll;
                   END;
            END;
            ReDraw;
            DSelectAll;
         END;
   END;


   (* --- print pattern in bw-blocks --- *)

   PROCEDURE PrintOutColor(NewElement:ARRAY[1..4] OF INTEGER; i: INTEGER);

   VAR 
      j: INTEGER; (* counter *)
      h,v,r,c : INTEGER; (* horizontal and vertical shift for print out *)

   BEGIN
      FillPat(1);
      r:=0;c:=i;
      WHILE c>columns DO (* calculate the row r and colummn i of the element *)
         BEGIN
            r:=r+1;
            c:=c-columns;
         END;
      IF NewElement[1]<>0 
         THEN FillBack(0,0,0)   
         ELSE FillBack(65535,65535,65535);
      Rect(10*c,10*r,10*c+10,10*r+10); 
      ReDraw;
      DSelectAll;
   END;


   (* --- calculate the celltype --- *)

   FUNCTION CellType(NewElement:ARRAY[1..4] OF INTEGER):INTEGER;

   VAR
      t : INTEGER;

   BEGIN
      t:=0; (* count number of bad connections *)
      CASE NewElement[1] OF (* check list of good combinations *)
         1:IF NOT ((((NewElement[4]=3) OR (NewElement[4]=6)) OR (NewElement[3]=4)) OR (NewElement[3]=5)) THEN t:=t+1; 
         3:IF NOT ((((NewElement[4]=1) OR (NewElement[4]=6)) OR (NewElement[2]=4)) OR (NewElement[2]=5)) THEN t:=t+1;
         6:IF NOT ((((((NewElement[4]=1) OR (NewElement[4]=3)) OR (NewElement[2]=4)) OR (NewElement[2]=5)) OR (NewElement[3]=4)) OR (NewElement[3]=5)) THEN t:=t+1;
      END;   
      CASE NewElement[2] OF
         2:IF NOT ((((NewElement[3]=4) OR (NewElement[3]=5)) OR (NewElement[4]=3)) OR (NewElement[4]=6)) THEN t:=t+1; 
         4:IF NOT ((((NewElement[3]=2) OR (NewElement[3]=5)) OR (NewElement[2]=3)) OR (NewElement[2]=6)) THEN t:=t+1;
         5:IF NOT ((((((NewElement[3]=2) OR (NewElement[3]=4)) OR (NewElement[1]=3)) OR (NewElement[1]=6)) OR (NewElement[4]=3)) OR (NewElement[4]=6)) THEN t:=t+1;
      END;
      CASE NewElement[3] OF
         2:IF NOT ((((NewElement[2]=4) OR (NewElement[2]=5)) OR (NewElement[4]=1)) OR (NewElement[4]=6)) THEN t:=t+1; 
         4:IF NOT ((((NewElement[2]=2) OR (NewElement[2]=5)) OR (NewElement[1]=1)) OR (NewElement[1]=6)) THEN t:=t+1;
         5:IF NOT ((((((NewElement[2]=2) OR (NewElement[2]=4)) OR (NewElement[1]=1)) OR (NewElement[1]=6)) OR (NewElement[4]=1)) OR (NewElement[4]=6)) THEN t:=t+1;
      END;      
      CASE NewElement[4] OF
         1:IF NOT ((((NewElement[1]=3) OR (NewElement[1]=6)) OR (NewElement[3]=2)) OR (NewElement[3]=5)) THEN t:=t+1; 
         3:IF NOT ((((NewElement[1]=1) OR (NewElement[1]=6)) OR (NewElement[2]=2)) OR (NewElement[2]=5)) THEN t:=t+1;
         6:IF NOT ((((((NewElement[1]=1) OR (NewElement[1]=3)) OR (NewElement[2]=2)) OR (NewElement[2]=5)) OR (NewElement[3]=2)) OR (NewElement[3]=5)) THEN t:=t+1;
      END;
      IF t>0 
         THEN CellType:=0
         ELSE CellType:=1; (* CellType 1 = good flow through cell *)
   END;


   (* --- check for living cells in the neighborhood  --- *)

   Procedure NCheck(i:INTEGER; VAR n:INTEGER);

   VAR
      seed : INTEGER;

   BEGIN
      seed:=0; (* count number of living neighbors *)
      IF (i<m_i) THEN (* does neighbor exist? *)
         BEGIN
            IF (pattern[i+1,2]=1) THEN seed:=seed+1;
         END;
      IF (i>1) THEN
         BEGIN 
            IF (pattern[i-1,2]=1) THEN seed:=seed+1;
         END;
      IF (i+columns<=m_i) THEN
         BEGIN
            IF (pattern[i+columns,2]=1) THEN seed:=seed+1;
         END;
      IF (i-columns>0) THEN
         BEGIN
            IF (pattern[i-columns,2]=1) THEN seed:=seed+1;
         END;
      n:=seed;
   END;


   (* --- connection between cells smooth? --- *)

   FUNCTION SmoothConnect(a,b,pos:INTEGER):BOOLEAN;

   VAR
      t : BOOLEAN;
      ct : INTEGER;
      element : ARRAY[1..4] OF INTEGER;

   BEGIN
      t:=FALSE;
      CASE a OF  (* check list of good combinations *)
         1: CASE pos OF
               1,5: IF ((b=3) OR (b=6)) THEN t:=TRUE;
               6  : IF ((b=4) OR (b=5)) THEN t:=TRUE;
               8  : IF ((b=2) OR (b=5)) THEN t:=TRUE;
            END;
         2: CASE pos OF
               3,7: IF ((b=4) OR (b=5)) THEN t:=TRUE;
               4  : IF ((b=1) OR (b=6)) THEN t:=TRUE;
               6  : IF ((b=3) OR (b=6)) THEN t:=TRUE;
            END;
         3: CASE pos OF
               1,5: IF ((b=1) OR (b=6)) THEN t:=TRUE;
               2  : IF ((b=2) OR (b=5)) THEN t:=TRUE;
               4  : IF ((b=4) OR (b=5)) THEN t:=TRUE;
            END;
         4: CASE pos OF
               3,7: IF ((b=2) OR (b=5)) THEN t:=TRUE;
               2  : IF ((b=1) OR (b=6)) THEN t:=TRUE;
               8  : IF ((b=3) OR (b=6)) THEN t:=TRUE;
            END;
         5: CASE pos OF
               3,7: IF (((b=2) OR (b=4)) OR (b=5)) THEN t:=TRUE;
               2,4: IF ((b=1) OR (b=6)) THEN t:=TRUE;
               6,8: IF ((b=3) OR (b=6)) THEN t:=TRUE;
            END;
         6: CASE pos OF
               1,5: IF (((b=1) OR (b=3)) OR (b=6)) THEN t:=TRUE;
               2,8: IF ((b=2) OR (b=5)) THEN t:=TRUE;
               4,6: IF ((b=4) OR (b=5)) THEN t:=TRUE;
            END;
      END;
      SmoothConnect:=t;
   END;


   (* --- check amount of existing external connections --- *)

   PROCEDURE CCheck (i:INTEGER; VAR n:INTEGER);   

   VAR
      c : INTEGER;

   BEGIN
      c:=0; (* count number of smooth connections *)
      IF i>1 THEN
         IF pattern[i-1,2]=1 THEN
             BEGIN 
               IF SmoothConnect(alphabet[pattern[i,1],1],alphabet[pattern[i-1,1],2],8) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],1],alphabet[pattern[i-1,1],4],7) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],3],alphabet[pattern[i-1,1],4],8) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],3],alphabet[pattern[i-1,1],2],1) THEN c:=c+1;
            END;
      IF i<m_i THEN
         IF pattern[i+1,2]=1 THEN 
            BEGIN 
               IF SmoothConnect(alphabet[pattern[i,1],2],alphabet[pattern[i+1,1],1],4) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],2],alphabet[pattern[i+1,1],3],5) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],4],alphabet[pattern[i+1,1],3],4) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],4],alphabet[pattern[i+1,1],1],3) THEN c:=c+1;
            END;
      IF i+columns<=m_i THEN
         IF pattern[i+columns,2]=1 THEN 
            BEGIN
               IF SmoothConnect(alphabet[pattern[i,1],3],alphabet[pattern[i+columns,1],1],6) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],3],alphabet[pattern[i+columns,1],2],5) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],4],alphabet[pattern[i+columns,1],2],6) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],4],alphabet[pattern[i+columns,1],1],7) THEN c:=c+1;
            END;
      IF i-columns>0 THEN
         IF pattern[i-columns,2]=1 THEN 
            BEGIN
               IF SmoothConnect(alphabet[pattern[i,1],1],alphabet[pattern[i-columns,1],3],2) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],1],alphabet[pattern[i-columns,1],4],3) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],2],alphabet[pattern[i-columns,1],4],2) THEN c:=c+1;
               IF SmoothConnect(alphabet[pattern[i,1],2],alphabet[pattern[i-columns,1],3],1) THEN c:=c+1;
            END;
      n:=c;
   END;



   (* --- Basic form of final project --- *)

   FUNCTION BasicForm:HANDLE;

      VAR
         r  : REAL;
         f1,f2,f3 : HANDLE;
         test : INTEGER;
         ptX,ptY,arcRadius : REAL;
         vertexType : INTEGER;
   

      BEGIN
         r:=radius;
         BeginMXtrd(0,3*base); (* define cylinder as subtraction of two solids *)
         BeginPoly;
            AddPoint(-r,r);
            AddPoint(-r,-r);
            AddPoint(r,-r);
            AddPoint(r,r);
         EndPoly;
         GetPolylineVertex(LNewObj,1,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,1,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,2,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,2,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,3,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,3,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,4,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,4,ptX,ptY,3,r,true);
         BeginPoly;
            AddPoint(-r,r);
            AddPoint(-r,-r);
            AddPoint(r,-r);
            AddPoint(r,r);
         EndPoly;
         GetPolylineVertex(LNewObj,1,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,1,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,2,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,2,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,3,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,3,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,4,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,4,ptX,ptY,3,r,true);
         EndMXtrd;   
         f1:=LNewObj;
         DSelectAll;
         r:=radius-depth;
         BeginMXtrd(0,3*base);
         BeginPoly;
            AddPoint(-r,r);
            AddPoint(-r,-r);
            AddPoint(r,-r);
            AddPoint(r,r);
         EndPoly;
         GetPolylineVertex(LNewObj,1,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,1,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,2,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,2,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,3,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,3,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,4,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,4,ptX,ptY,3,r,true);
         BeginPoly;
            AddPoint(-r,r);
            AddPoint(-r,-r);
            AddPoint(r,-r);
            AddPoint(r,r);
         EndPoly;
         GetPolylineVertex(LNewObj,1,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,1,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,2,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,2,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,3,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,3,ptX,ptY,3,r,true);
         GetPolylineVertex(LNewObj,4,ptX,ptY,vertexType,arcRadius);
         SetPolylineVertex(LNewObj,4,ptX,ptY,3,r,true);
         EndMXtrd;   
         f2:=LNewObj;
         DSelectAll;
         test:=SubtractSolid(f1,f2,f3);
         Rotate3D(-90,0,0);
         Move3D(0,-base,0);
         BasicForm:=f3;
         DSelectAll;
      END;


   (* --- construction of Basic element --- *)

   PROCEDURE BasicElement3d(n:INTEGER);

   VAR
      test : INTEGER;
      h1,h2,h3 : HANDLE;
      factor_top,factor_bottom,top,bottom: REAL;
      
   BEGIN
      bottom:=radius-1.5*depth;      (* calculate factors for extrusion *)
      factor_bottom:=bottom/radius;
      top:=1.5*radius;
      factor_top:=top/radius;
      BeginMXtrd(top,bottom);        (* extrude object as cone *)
         BasicElement2d(n);
         Scale(factor_top,factor_top);
         DSelectAll;
         BasicElement2d(n);
         Scale(factor_bottom,factor_bottom);
         DSelectAll;
      EndMXtrd;
      SetSelect(LNewObj);   
      Move3D(-base/2,0,0);
      h1:=LNewObj;
      h2:=BasicForm;
      test:=IntersectSolid(h1,h2,h3);
   END;


   (* --- print the pattern in 3d --- *)

   PROCEDURE PrintOutWall(NewElement:ARRAY[1..4] OF INTEGER; i: INTEGER);

   VAR 
      j,test: INTEGER; (* counter *)
      h,v,r,c,ref : INTEGER; (* horizontal and vertical shift for print out *)
      hnew : HANDLE;
      f1,f2,f3 : LONGINT;

   BEGIN
      FillPat(1);
      ColorIndexToRGB(19,f1,f2,f3);
      FillBack(f1,f2,f3);
      FillFore(f1,f2,f3);
      r:=0;c:=i;
      WHILE c>columns DO (* calculate the row r and colummn i of the element *)
         BEGIN
            r:=r+1;
            c:=c-columns;
         END;
      FOR j:= 1 TO 4 DO
         BEGIN 
            IF j<3 THEN v:=0 ELSE v:=1;           (* vertical position in a 2x2-array *)
            IF (j MOD 2 = 1) THEN h:=0 ELSE h:=1; (* horizontal position in a 2x2-array *)   
            FillPat(1);
            CASE NewElement[j] OF
               1..4:BEGIN
                     BasicElement3d(NewElement[j]);
                     MoveObjs(0,base*v+2*base*r,FALSE,FALSE);
                     Rotate3D(0,alpha*c+alpha/2*h,0);
                     DSelectAll;
                   END;   
                  5:BEGIN
                     BasicElement3d(2);
                     MoveObjs(0,base*v+2*base*r,FALSE,FALSE);
                     Rotate3D(0,alpha*c+alpha/2*h,0);
                     DSelectAll;
                     BasicElement3d(4);
                     MoveObjs(0,base*v+2*base*r,FALSE,FALSE);
                     Rotate3D(0,alpha*c+alpha/2*h,0);
                     DSelectAll;
                        END;   
                  6:BEGIN   
                     BasicElement3d(1);
                     MoveObjs(0,base*v+2*base*r,FALSE,FALSE);
                     Rotate3D(0,alpha*c+alpha/2*h,0);
                     DSelectAll;
                     BasicElement3d(3);
                     MoveObjs(0,base*v+2*base*r,FALSE,FALSE);
                     Rotate3D(0,alpha*c+alpha/2*h,0);
                     DSelectAll;
                   END;
            END;
            ReDraw;
            FillPat(0);
         END;
   END;



(* --- main body --- *)

BEGIN
   SelectAll;
   DeleteObjs;
   DoMenuTextByName('Standard Views',1); (* top view *)

   (* --- generate alphabet --- *)
   
   Message('computer generates the alphabet');
   i:=0;i_plus:=0; 
   REPEAT (* generate the alphabet *)
      Generate(element);
      IF NewPattern(element,i-1) THEN
         BEGIN
            FOR j:=1 TO 4 DO alphabet[i,j]:=element[j];
            IF CellType(element)>0
               THEN 
                  BEGIN
                     i_plus:=i_plus+1;
                     alphabetplus[i_plus]:=i;
                  END;
            i:=i+1;
         END;
   UNTIL i=256;

   (* --- read length of data --- *)
   
   GetFile(InputText);
   max_i:=0;
   Open(InputText);
   WHILE NOT Eof(InputText) DO
      BEGIN
         Readln(data);
         max_i:=max_i+Len(data);
      END;
      Close(InputText);
   col_i:=Trunc(Sqrt(max_i))+1; (* display input close to square *)
   row_i:=1;l:=max_i;
   WHILE l > col_i DO
      BEGIN
         l:=l-col_i;
         row_i:=row_i+1;
      END;
   
   (* --- generate the print out using arcs --- *)
   
   m_i:=col_i*row_i;cr:=columns*rows;
   IF m_i<cr THEN m_i:=cr;
   ALLOCATE pattern[1..m_i,1..2];
   ALLOCATE patternTemp[1..m_i,1..2];
   Open(InputText);
   For i:= 1 TO m_i DO
      BEGIN
         IF i<=max_i 
            THEN BEGIN
                    Read(letter);
                    lnumber:=Ord(letter); 
                    FOR j:=1 TO 4 DO element[j]:=alphabet[lnumber,j];
                 END
            ELSE FOR j:=1 TO 4 DO element[j]:=alphabet[32,j]; (* add ' ' to make field a rectangle *) 
         PrintOutArc(element,i);
         pattern[i,1]:=lnumber;
         pattern[i,2]:=CellType(element);
      END;
   Close(InputText);
   hl:=GetLayer(LNewObj);
   SetLayerRenderMode(hl,0,FALSE,TRUE); (* wireframe *)
   
   (* --- generate the print out using colors --- *)
   
         loops:=50;
         SelectAll;
         DeleteObjs;
         For i:= 1 TO m_i DO  (* generate input for automata, display type of each cell *) 
            BEGIN
               IF i<=max_i 
                  THEN BEGIN
                          lnumber:=pattern[i,1]; 
                          FOR j:=1 TO 4 DO element[j]:=alphabet[lnumber,j];
                         END
                  ELSE FOR j:=1 TO 4 DO element[j]:=alphabet[32,j];
               IF CellType(element)=0 
                  THEN BEGIN
                        FOR j:=1 TO 4 DO element[j]:=0;
                        pattern[i,2]:=0;
                       END;
               PrintOutColor(element,i);
            END;
         Close(InputText); 
                              
         (* --- calculate new pattern using cellular automata --- *)
         
         FOR l:=1 TO loops DO (* start automata *)
            BEGIN
               Message('l=',l);
               For i:=1 TO m_i DO
                  BEGIN   
                     NCheck(i,nc);
                     CCheck(i,cc);
                     CASE pattern[i,2] OF 
                           0: IF nc>0
                               THEN BEGIN
                                    i_p:=trunc(1+Random*(i_plus-1)); (* replace cell by a randomly picked cell of type 1 *)
                                    patternTemp[i,1]:=alphabetplus[i_p]; 
                                    FOR j:=1 TO 4 DO element[j]:=alphabet[patternTemp[i,1],j];
                                    patternTemp[i,2]:=CellType(element);
                                   END;
                        1:IF cc<3 THEN patternTemp[i,2]:=0;                   
                     END;
                     IF patternTemp[i,2]=1 
                        THEN BEGIN
                              FOR j:=1 TO 4 DO element[j]:=alphabet[patternTemp[i,1],j]; 
                              PrintOutColor(element,i)   
                             END
                        ELSE BEGIN
                              FOR j:=1 TO 4 DO element[j]:=0;
                              PrintOutColor(element,i);
                             END;
                  END; 
               pattern:=patternTemp;
            END; 
         SelectAll;
         DeleteObjs;

         (* calculate data *)

         m_i:=columns*rows;
         d:=thickness/2;
         alpha:=pi/columns;
         beta:=alpha/2;
         height:=radius*Cos(alpha/2);
         base:=2*radius*sin(alpha/2);
         alpha:=360/columns;

         (* --- printout 2d --- *)

         FOR i:=1 TO m_i DO
             BEGIN
               FOR j:=1 TO 4 DO element[j]:=alphabet[patternTemp[i,1],j];
               PrintOutArcThick(element,i);
             END;
         DSelectAll;      
      

   (* --- printout 3d --- *)

   GoOn:=YNDialog('Do you wish to continue?');
   IF GoOn 
      THEN BEGIN
            SelectAll;
            DeleteObjs;
            FOR i:= 1 TO m_i DO
               BEGIN
                  FOR j:=1 TO 4 DO element[j]:=alphabet[pattern[i,1],j];
                  PrintOutWall(element,i);
                 END;
           END;
   DoMenuTextByName('Standard Views',8); (* top right *)
   hl:=GetLayer(LNewObj);
   SetLayerRenderMode(hl,12,FALSE,TRUE); (* quick render *) 

END;
RUN(pattern1);