### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: Spiral of Theodorus: Reversed n Rotate n Fills  (Read 10898 times)

#### Boleeman

• Sr. Member
• Posts: 490
##### Spiral of Theodorus: Reversed n Rotate n Fills
« on: April 02, 2024, 10:26:01 pm »
Spiral of Theodorus  in next reply

Notice how the Spiral of Theodorus begins with a right angled Isosceles Triangle.
« Last Edit: April 06, 2024, 06:44:24 am by Boleeman »

#### Boleeman

• Sr. Member
• Posts: 490
##### Re: Spiral of Theodorus: Finally got it working
« Reply #1 on: April 04, 2024, 10:41:49 am »
Finally have it working:

" Spiral of Theodorus"

Noticed a bug for many triangles the big triangles obscure the smaller triangles.

« Last Edit: April 04, 2024, 12:31:41 pm by Boleeman »

#### circular

• Hero Member
• Posts: 4246
##### Re: Spiral of Theodorus: Working
« Reply #2 on: April 04, 2024, 12:33:51 pm »
Very inspiring.

Here is a version with rounding:
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, Spin,
9.   StdCtrls, Math, LCLIntf;
10.
11. const ArcPrecision = 5;
12.
13. type
14.
15.   { TForm1 }
16.
17.   TForm1 = class(TForm)
18.     chkFill: TCheckBox;
19.     Label1: TLabel;
20.     sbPencolor: TColorButton;
21.     PaintBox1: TPaintBox;
22.     Panel1: TPanel;
23.     seNumTriangs: TSpinEdit;
24.     seMybasesize: TSpinEdit;
25.     sePenwidth: TSpinEdit;
26.     procedure chkFillChange(Sender: TObject);
27.     procedure PaintBox1Paint(Sender: TObject);
28.     procedure sbPencolorColorChanged(Sender: TObject);
29.     procedure seMybasesizeChange(Sender: TObject);
30.     procedure seNumTriangsChange(Sender: TObject);
31.     procedure sePenwidthChange(Sender: TObject);
32.   private
33.     rotpoint: TPoint;
34.     endpt: array of TPoint;
35.   public
36.
37.   end;
38.
39. var
40.   Form1: TForm1;
41.
42. implementation
43.
44. {\$R *.lfm}
45.
46. { TForm1 }
47.
48. procedure TForm1.PaintBox1Paint(Sender: TObject);
49. var
50.   NumTriangles: Integer;
51.   i, j, basesize: Integer;
52.   Angle, PreviousAngle, IntermediateAngle,
53.   Hypo, PreviousHypo, IntermediateHypo: Double;
54.   RandomColor: TColor;
55.   Points: array of TPoint;
56. begin
57.   rotpoint := Point(350, 350);
58.   NumTriangles := seNumTriangs.Value;
59.   basesize := seMybasesize.Value;
60.
61.   Angle := 0; // Reset angle
62.   Hypo := Sqrt((basesize**2) + (basesize**2));
63.
64.   SetLength(endpt, NumTriangles*ArcPrecision + 1);
65.   endpt[0] := Point(round(rotpoint.x + Hypo), rotpoint.y);
66.
67.   for i := 1 to NumTriangles do
68.   begin
69.     PreviousAngle := Angle;
70.     PreviousHypo := Hypo;
71.     // next angle
72.     Angle := Angle + ArcTan(1/Sqrt(i));
73.     Hypo := Sqrt((PreviousHypo**2) + (basesize**2));
74.
75.     for j := 1 to ArcPrecision do
76.     begin
77.       IntermediateAngle := (Angle*j + PreviousAngle*(ArcPrecision-j))/ArcPrecision;
78.       IntermediateHypo := (Hypo*j + PreviousHypo*(ArcPrecision-j))/ArcPrecision;
79.       endpt[(i-1)*ArcPrecision + j] := Point(
80.         Round(rotpoint.x + IntermediateHypo * Cos(IntermediateAngle)),
81.         Round(rotpoint.y - IntermediateHypo * Sin(IntermediateAngle))
82.       );
83.     end;
84.   end;
85.
86.   paintbox1.Canvas.Pen.Width := sePenwidth.Value;
87.   paintbox1.Canvas.Brush.Style := bsSolid;
88.   for i := 0 to NumTriangles - 1 do
89.   begin
90.     with PaintBox1.Canvas do
91.     begin
92.       if chkFill.Checked then
93.       begin
94.         // Generate random RGB color components
95.         repeat
96.           RandomColor := TColor(RGB(Random(256), Random(256), Random(256)));
97.         until (Red(RandomColor) > 120) or (Green(RandomColor) > 120) or (Blue(RandomColor) > 120);
98.
99.         Brush.Color := RandomColor;
100.         Brush.Style := bsSolid;
101.       end else
102.         Brush.Style := bsClear;
103.
104.       setlength(points, ArcPrecision + 2);
105.       points[0] := rotpoint;
106.       move(endpt[i*ArcPrecision], points[1], sizeof(TPoint)*(ArcPrecision+1));
107.       Polygon(points);
108.     end;
109.   end;
110. end;
111.
112. procedure TForm1.chkFillChange(Sender: TObject);
113. begin
114.   Paintbox1.Invalidate;
115. end;
116.
117. procedure TForm1.sbPencolorColorChanged(Sender: TObject);
118. begin
119.     Paintbox1.Invalidate;
120. end;
121.
122. procedure TForm1.seMybasesizeChange(Sender: TObject);
123. begin
124.     Paintbox1.Invalidate;
125. end;
126.
127. procedure TForm1.seNumTriangsChange(Sender: TObject);
128. begin
129.   Paintbox1.Invalidate;
130. end;
131.
132. procedure TForm1.sePenwidthChange(Sender: TObject);
133. begin
134.   Paintbox1.Invalidate;
135. end;
136.
137. end.
Conscience is the debugger of the mind

#### Boleeman

• Sr. Member
• Posts: 490
##### Re: Spiral of Theodorus: Working
« Reply #3 on: April 04, 2024, 12:42:41 pm »
That's so Cool Circular.
I thought maybe even PolyBezier for the outside border?

Kinda glad I got it working, as I came across a few dead ends in the creation process. Tried converting the CSharp version, by it had transformations in it. Later realised bgrabmp does some tranforms. Anyhow, I started from the basics in Lazarus, got a few triangles working, and then applied arrays to make it dynamic.

Actually a Phong fill/shading using BgraBMP would also be nice to see.

I saw a C version on Github that is transparent (attached below is screenshot). Don't know how to do that properly yet. That would show the bigger triangles over the smaller triangles.

Just thought of a fix: Looping it in reverse so the bigger triangles are drawn first.

« Last Edit: April 04, 2024, 12:59:30 pm by Boleeman »

#### circular

• Hero Member
• Posts: 4246
##### Re: Spiral of Theodorus: Working
« Reply #4 on: April 04, 2024, 07:18:38 pm »
I thought about PolyBezier but in the end it was easier to compute intermediate points rather than to compute the Bezier control points.

Sure with BGRABitmap you could do it with gradients, antialiasing and transparency.
Conscience is the debugger of the mind

#### Boleeman

• Sr. Member
• Posts: 490
##### Re: Spiral of Theodorus: Working
« Reply #5 on: April 06, 2024, 06:43:06 am »
Now Reversed the order of the triangles to prevent the bigger triangles covering the smaller ones.

Rotate
Save to png
Back color

What I noticed was that even though there were different colors, the files sizes of the pngs files were still amazingly small in size.
« Last Edit: April 06, 2024, 07:10:26 am by Boleeman »

#### circular

• Hero Member
• Posts: 4246
##### Re: Spiral of Theodorus: Reversed n Rotate n Fills
« Reply #6 on: April 06, 2024, 07:41:23 am »
Very colorful!

It reminds me of some seashells
Conscience is the debugger of the mind

#### AlexTP

• Hero Member
• Posts: 2421
##### Re: Spiral of Theodorus: Reversed n Rotate n Fills
« Reply #7 on: April 06, 2024, 07:49:43 am »
On Linux gtk2, SpinEdits are all truncated...
and controls are not properly aligned by X.

#### Roland57

• Sr. Member
• Posts: 425
##### Re: Spiral of Theodorus: Reversed n Rotate n Fills
« Reply #8 on: April 06, 2024, 09:47:00 am »
@Boleeman

Thanks for sharing.

Here is a BGRABitmap version (a command line tool using the bgrabitmappack4nogui.lpk package).

P.-S. By the way, there are gorgious LaTeX examples in this discussion.
« Last Edit: April 06, 2024, 11:13:38 am by Roland57 »
My projects are on Gitlab and on Codeberg.

#### Boleeman

• Sr. Member
• Posts: 490
##### Re: Spiral of Theodorus: Reversed n Rotate n Fills
« Reply #9 on: April 07, 2024, 05:26:09 am »
Thanks Roland57 for your transparent  BGRABitmap version.

I checked out those LaTeX examples. Love this sort of geometry stuff.

It is quite amazing to think it comes from Surds/Square Roots.
When I was a student many years ago my teachers never taught me about this sort of stuff.
I learnt about it a at Uni, when I got introduced to fractals.

AlexTP:
Just delete the long Label and create your own.
I was in a hurry to get the code done that I forgot to redo the labels.

Been working on about 5 different things, with coding logic not always going the right way!

I noticed there were 9549 Views. Not sure what is going on. Seems quite high.
« Last Edit: April 07, 2024, 05:28:11 am by Boleeman »

#### cdbc

• Hero Member
• Posts: 1171
##### Re: Spiral of Theodorus: Reversed n Rotate n Fills
« Reply #10 on: April 07, 2024, 08:08:18 am »
Hi
Regards Benny
If it ain't broke, don't fix it
PCLinuxOS(rolling release) 64bit -> KDE5 -> FPC 3.2.2 -> Lazarus 2.2.6 up until Jan 2024 from then on it's: KDE5/QT5 -> FPC 3.3.1 -> Lazarus 3.0

#### Roland57

• Sr. Member
• Posts: 425
##### Re: Spiral of Theodorus: Reversed n Rotate n Fills
« Reply #11 on: April 18, 2024, 01:24:14 pm »
Thanks Roland57 for your transparent  BGRABitmap version.

I replaced the method for computing points, with another method that I find easier to understand (using vectors).

Code: Pascal  [Select][+][-]
1.   LPoint1 := PointF(0.0, 0.0);
2.   LPoint2 := PointF(1.0, 0.0);
3.
4.   for i := 1 to ANumTriangles do
5.   begin