Recent

Author Topic: More Trees: Different Pythagoras Tree Styles  (Read 796 times)

Boleeman

  • Sr. Member
  • ****
  • Posts: 490
More Trees: Different Pythagoras Tree Styles
« on: January 26, 2024, 05:17:08 am »
A very nicely coloured Pythagoras Fractal Tree to play around with.
Perhaps would be nice to see BGRABmp version with varying opacity.

Converted from Fwend js source at https://github.com/fwend/Pythagoras-tree

Enjoy.






« Last Edit: January 31, 2024, 03:00:02 pm by Boleeman »

Boleeman

  • Sr. Member
  • ****
  • Posts: 490
Re: Colourful Pythagoras Tree Fractal
« Reply #1 on: January 31, 2024, 11:16:23 am »
Another type with 5 random colors.

Code: Pascal  [Select][+][-]
  1.  unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     procedure FormCreate(Sender: TObject);
  16.     procedure FormPaint(Sender: TObject);
  17.   private
  18.     procedure PythagorasTree(x1, y1, x2, y2: Double; depth: Integer);
  19.   public
  20.     { public declarations }
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. procedure TForm1.PythagorasTree(x1, y1, x2, y2: Double; depth: Integer);
  33. var
  34.   dx, dy, x3, y3, x4, y4, x5, y5: Double;
  35. begin
  36.   if depth > 10 then
  37.     Exit;
  38.  
  39.   dx := x2 - x1;
  40.   dy := y1 - y2;
  41.   x3 := x2 - dy;
  42.   y3 := y2 - dx;
  43.   x4 := x1 - dy;
  44.   y4 := y1 - dx;
  45.   x5 := x4 + (dx - dy) / 2;
  46.   y5 := y4 - (dx + dy) / 2;
  47.  
  48.   case Random(5) + 1 of
  49.     1: Canvas.Pen.Color := clMaroon;
  50.     2: Canvas.Pen.Color := clRed;
  51.     3: Canvas.Pen.Color := clTeal;
  52.     4: Canvas.Pen.Color := TColor($00A5FF);         //Orange color
  53.     5: Canvas.Pen.Color := clGreen;
  54.   end;
  55.   Canvas.Pen.Width:=2;
  56.   Canvas.Line(Round(x1), Round(y1), Round(x2), Round(y2));
  57.   Canvas.Line(Round(x2), Round(y2), Round(x3), Round(y3));
  58.   Canvas.Line(Round(x3), Round(y3), Round(x4), Round(y4));
  59.   Canvas.Line(Round(x4), Round(y4), Round(x1), Round(y1));
  60.  
  61.   PythagorasTree(x4, y4, x5, y5, depth + 1);
  62.   PythagorasTree(x5, y5, x3, y3, depth + 1);
  63. end;
  64.  
  65. procedure TForm1.FormCreate(Sender: TObject);
  66. begin
  67.   Randomize;
  68. end;
  69.  
  70. procedure TForm1.FormPaint(Sender: TObject);
  71. var
  72.   w, h, w2, diff: Integer;
  73. begin
  74.   w := 800;
  75.   h := w * 11 div 16;
  76.   w2 := w div 2;
  77.   diff := w div 12;
  78.  
  79.   PythagorasTree(w2 - diff, h - 10, w2 + diff, h - 10, 0);
  80. end;
  81.  
  82. end.


Boleeman

  • Sr. Member
  • ****
  • Posts: 490
Re: Colourful Pythagoras Tree Fractal
« Reply #2 on: January 31, 2024, 02:59:16 pm »
And two other variations:

Code: Pascal  [Select][+][-]
  1.  unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
  9.  
  10. type
  11.   { TForm1 }
  12.  
  13.   TForm1 = class(TForm)
  14.     procedure FormPaint(Sender: TObject);
  15.     procedure FormCreate(Sender: TObject);
  16.   private
  17.     procedure DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
  18.   public
  19.     { Public declarations }
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26.  
  27. {$R *.lfm}
  28.  
  29. procedure TForm1.FormCreate(Sender: TObject);
  30. begin
  31.   // Set the form size
  32.   Width := 400;
  33.   Height := 200;
  34. end;
  35.  
  36. procedure TForm1.DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
  37. var
  38.   dx, dy, x3, y3, x4, y4, x5, y5: Integer;
  39.   colorIntensity: Double;
  40.   newcolor: TColor;
  41. begin
  42.   Canvas.Pen.Color := clBlue;
  43.   if currentDepth > 0 then
  44.   begin
  45.     // Calculate the differences in x and y coordinates between the two points
  46.     dx := x2 - x1;
  47.     dy := y2 - y1;
  48.  
  49.     // Calculate the coordinates for the three additional points to create the branches
  50.     x3 := x2 - dy;
  51.     y3 := y2 + dx;
  52.     x4 := x1 - dy;
  53.     y4 := y1 + dx;
  54.     x5 := x4 + (dx - dy) div 2;
  55.     y5 := y4 + (dx + dy) div 2;
  56.  
  57.     colorIntensity := 1.0 - (currentDepth / maxDepth);
  58.     newcolor := RGBToColor(Round(255 * colorIntensity), Round(255 * colorIntensity), 255);
  59.  
  60.     Canvas.Polygon([Point(x1, ClientHeight - y1), Point(x4, ClientHeight - y4),
  61.                     Point(x5, ClientHeight - y5), Point(x3, ClientHeight - y3),
  62.                     Point(x2, ClientHeight - y2), Point(x1, ClientHeight - y1)]);
  63.     Canvas.Brush.Color := newcolor;
  64.  
  65.     DrawPythagorasTree(x5, y5, x3, y3, currentDepth - 1, maxDepth);
  66.     DrawPythagorasTree(x4, y4, x5, y5, currentDepth - 1, maxDepth);
  67.   end;
  68. end;
  69.  
  70. procedure TForm1.FormPaint(Sender: TObject);
  71. var
  72.   centerX: Integer;
  73. begin
  74.   // Calculate the center of the form
  75.   centerX := ClientWidth div 2;
  76.  
  77.   // Adjust the starting points to the center
  78.   DrawPythagorasTree(centerX - 100, 100, centerX + 100, 100, 8, 12);
  79. end;
  80.  
  81. end.

and

Code: Pascal  [Select][+][-]
  1.  unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
  9.  
  10. type
  11.   { TForm1 }
  12.  
  13.   TForm1 = class(TForm)
  14.     procedure FormPaint(Sender: TObject);
  15.     procedure FormCreate(Sender: TObject);
  16.   private
  17.     procedure DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
  18.   public
  19.     { Public declarations }
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26.  
  27. {$R *.lfm}
  28.  
  29. procedure TForm1.FormCreate(Sender: TObject);
  30. begin
  31.   // Set the form size
  32.   Width := 400;
  33.   Height := 200;
  34. end;
  35.  
  36. procedure TForm1.DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
  37. var
  38.   dx, dy, x3, y3, x4, y4, x5, y5: Integer;
  39.   colorIntensity: Double;
  40.   newcolor: TColor;
  41. begin
  42.   Canvas.Pen.Color := clBlue;
  43.   if currentDepth > 0 then
  44.   begin
  45.     // Calculate the differences in x and y coordinates between the two points
  46.     dx := x2 - x1;
  47.     dy := y2 - y1;
  48.  
  49.     // Calculate the coordinates for the three additional points to create the branches
  50.     x3 := x2 - dy;
  51.     y3 := y2 + dx;
  52.     x4 := x1 - dy;
  53.     y4 := y1 + dx;
  54.     x5 := x4 + (dx - dy) div 2;
  55.     y5 := y4 + (dx + dy) div 2;
  56.  
  57.     colorIntensity := 1.0 - (currentDepth / maxDepth);
  58.     newcolor := RGBToColor(Round(255 * colorIntensity), Round(255 * colorIntensity), 255);
  59.  
  60.     Canvas.Polygon([Point(x1, ClientHeight - y1), Point(x4, ClientHeight - y4),
  61.                     Point(x5, ClientHeight - y5), Point(x3, ClientHeight - y3),
  62.                     Point(x2, ClientHeight - y2), Point(x1, ClientHeight - y1)]);
  63.     Canvas.Brush.Color := newcolor;
  64.  
  65.     DrawPythagorasTree(x5, y5, x3, y3, currentDepth - 1, maxDepth);
  66.     DrawPythagorasTree(x4, y4, x5, y5, currentDepth - 1, maxDepth);
  67.   end;
  68. end;
  69.  
  70. procedure TForm1.FormPaint(Sender: TObject);
  71. var
  72.   centerX: Integer;
  73. begin
  74.   // Calculate the center of the form
  75.   centerX := ClientWidth div 2;
  76.  
  77.   // Adjust the starting points to the center
  78.   DrawPythagorasTree(centerX - 100, 100, centerX + 100, 100, 8, 12);
  79. end;
  80.  
  81. end.

lainz

  • Hero Member
  • *****
  • Posts: 4522
  • Web, Desktop & Android developer
    • https://lainz.github.io/
Re: More Trees: Different Pythagoras Tree Styles
« Reply #3 on: January 31, 2024, 04:46:14 pm »
 :)

Very good

 

TinyPortal © 2005-2018