program kreisbaum;{circle tree}
{Draw circles, squares, octagons, on each free three corners smaller ones}
uses crt, graph;

var gd, gm : integer;
    figur, farbe : byte;

procedure figurz(x, y, radius: integer; figur: byte);
  begin                                      {Draw figure on point with radius}
    figur:=(figur mod 6);                    {Only 5 different figures}
    if figur=0 then pieslice(x, y, 0, 360, radius);
                                             {1: filled circle}
    if figur=1 then circle(x, y, radius);    {2: simple circle}
    if ((figur=4) or (figur=5)) and (radius>=4)
                                             {4/5: octagon}
      then begin
             moveto(x+radius, y);            {Start draw on 0 degree}
             lineto(x+3*(radius div 4), y-3*(radius div 4));
             lineto(x, y-radius);            {Eight lines in 45 degree steps}
             lineto(x-3*(radius div 4), y-3*(radius div 4));
             lineto(x-radius, y);            {With length 3/4 * radius}
             lineto(x-3*(radius div 4), y+3*(radius div 4));
             lineto(x, y+radius);
             lineto(x+3*(radius div 4), y+3*(radius div 4));
             lineto(x+radius, y);
           end
      else if (figur=4) or (figur=5) then figur:=2;
                                             {Smaller octagons as squares}
    if (figur=2) or (figur=3) then           {2/4: square}
      begin                                  {4 square lines}
        line(x+radius, y, x, y-radius);      {Beginning right to top corner}
        line(x, y-radius, x-radius, y);
        line(x-radius, y, x, y+radius);
        line(x, y+radius, x+radius, y);
      end;
    if (figur=3) or (figur=5) then
      floodfill(x, y, getcolor);             {Filled square(3) or octagon(5)}
  end;

procedure baum2(x, y, radius: integer; farbe, figur: byte); forward;
procedure baum3(x, y, radius: integer; farbe, figur: byte); forward;
procedure baum4(x, y, radius: integer; farbe, figur: byte); forward;

procedure baum1(x, y, radius: integer; farbe, figur: byte);
  begin                                      {Baum1: figure on top of last}
    setcolor(farbe);                         {Set color farbe}
    setfillstyle(1, farbe);                  {Set filling color farbe}
    farbe:=farbe+1;                          {Choose next color}
    if (farbe mod 16 =0) then farbe:=farbe+1;{of 1-15}
    figurz(x, y, radius, figur);             {Draw choosed figure}
    figur:=figur+1;                          {Choose next figure}
    if radius>1 then                         {End when radius 1 else}
      begin                                  {Next figures left, right, top}
        baum3(x-round(radius*1.5), y, radius div 2, farbe, figur);
        baum4(x+round(radius*1.5), y, radius div 2, farbe, figur);
        baum1(x, y-round(radius*1.5), radius div 2, farbe, figur);
      end;                                   {with half radius}
  end;

procedure baum2(x, y, radius: integer; farbe, figur: byte);
  begin                                      {Baum2: Figure on bottom of last}
    setcolor(farbe);                         {Same steps as in Baum1}
    setfillstyle(1, farbe);
    farbe:=farbe+1;
    if (farbe mod 16=0) then farbe:=farbe+1;
    figurz(x, y, radius, figur);
    figur:=figur+1;
    if radius>1 then
      begin                                  {Next figures left, right, bottom}
        baum3(x-round(radius*1.5), y, radius div 2, farbe, figur);
        baum4(x+round(radius*1.5), y, radius div 2, farbe, figur);
        baum2(x, y+round(radius*1.5), radius div 2, farbe, figur);
      end;
  end;

procedure baum3(x, y, radius: integer; farbe, figur: byte);
  begin                                      {Baum3: Figure on left of last}
    setcolor(farbe);                         {Same steps as in Baum1}
    setfillstyle(1, farbe);
    farbe:=farbe+1;
    if (farbe mod 16=0) then farbe:=farbe+1;
    figurz(x, y, radius, figur);
    figur:=figur+1;
    if radius>1 then
      begin                                  {Next figures left, bottom, top}
        baum3(x-round(radius*1.5), y, radius div 2, farbe, figur);
        baum2(x, y+round(radius*1.5), radius div 2, farbe, figur);
        baum1(x, y-round(radius*1.5), radius div 2, farbe, figur);
      end;
  end;

procedure baum4(x, y, radius: integer; farbe, figur: byte);
  begin                                      {Baum4: Figure on right of last}
    setcolor(farbe);                         {Same steps as in Baum1}
    setfillstyle(1, farbe);
    farbe:=farbe+1;
    if (farbe mod 16=0) then farbe:=farbe+1;
    figurz(x, y, radius, figur);
    figur:=figur+1;
    if radius>1 then
      begin                                  {Next figures top, bottom, right}
        baum1(x, y-round(radius*1.5), radius div 2, farbe, figur);
        baum2(x, y+round(radius*1.5), radius div 2, farbe, figur);
        baum4(x+round(radius*1.5), y, radius div 2, farbe, figur);
      end;
  end;

procedure baum5(x, y, radius: integer; farbe, figur: byte);
                                             {Draw first figure}
  var ch : char;

  begin
    setcolor(farbe);                         {Same steps as in Baum1}
    setfillstyle(1, farbe);
    farbe:=farbe+1;
    if (farbe mod 16=0) then farbe:=farbe+1;
    figurz(x, y, radius, figur);
    figur:=figur+1;
    delay(0);                                {No waiting time}
    if radius>1 then
      begin                                  {Next figures on top, bottom}
        baum1(x, y-round(radius*1.5), radius div 2, farbe, figur);
        baum2(x, y+round(radius*1.5), radius div 2, farbe, figur);
                                             {Next figures on left, right}
        baum3(x-round(radius*1.5), y, radius div 2, farbe, figur);
        baum4(x+round(radius*1.5), y, radius div 2, farbe, figur);
      end;                                   {Recursion}

  end;

begin
  gd:=9; gm:=2;
  initgraph(gd, gm, 'd:\tp\bgi');            {Load graphic driver}
  figur:=0;                                  {Start with figure 0}
  farbe:=1;                                  {and color 1 (blue)}
  repeat
    baum5(320, 240, 64, farbe, figur);       {Start on center of screen}
    delay(5000);                             {Waiting time after one tree}
    cleardevice;                             {Clear screen}
    figur:=figur+1;                          {Next figure}
    farbe:=farbe+1;                          {Next color}
    if (farbe mod 16=0) then farbe:=farbe+1; {but only 1-15}
  until keypressed;                          {End with any key}
  closegraph;                                {Back to text mode}
end.
