Ulam Polygon Spiral Freebasic to Lazarus Conversion Needed

[Boleeman]

Hi All.

I came across some Freebasic code that creates Polygon Spirals based on prime numbers. The code works for Freebasic. The code uses turtle graphics to draw the required spiral.

The info from the Freebasic forum page is:
This program draws a spiral.
See: http://en.wikipedia.org/wiki/Ulam_spiral
The rotation is performed in some numbers that are not prime, for example: 10, 21, 26 ...
In the program, the rotations are performed when the number if it is prime.
By varying the angle of rotation we can obtain various forms of spiral: triangular, square, pentagonal, hexagonal


Here is the freebasic code:

Code: Pascal  [Select][+][-]

1. #include "turtle7.bi"
2. declare function prime (x as integer) as integer
3.  
4. dim as integer n, g
5. dim as double c, p
6.  
7. cls:screen 12:t_init
8. g = int (360/5) ' values 3,4,5,6,.....= triangle, square, pentagonal, hexagonal....
9. p = 0.4 ' step or gap size
10. c = 0
11.  
12. for n = 2 to 100 ' limit
13.    if prime (n) = 1 then t_rt g
14.    t_fd c
15.    c = c + p
16. next n
17. sleep
18. end
19.  
20.  
21.  
22.  
23.  
24.  
25. function prime (x as integer) as integer
26. dim as integer i, p
27. 'number not prime, p = 0
28. 'number yes prime, p = 1
29. p = 0
30. for i = 2 to sqr(x)
31.    if x mod (i) = 0 then p = 0 : exit for
32.    if x mod (i) <> 0 then p = 1 : exit for
33. next i
34. if p = 0 then prime = 0 else prime = 1 end if
35. end function
36.  
37.  
38.  
39.  
40.  
41.  
42.  
43.  
44.  
45.  
46.  
47. //In turtle7.bi we have the following:
48.  
49. SUB T_RT (BYVAL T_ANGLE AS DOUBLE) 'TURN LEFT
50. T_HEADING = T_HEADING - (T_ANGLE * 0.0174532925199433)
51. END SUB
52.  
53. SUB T_FD (BYVAL T_DISTANCE AS DOUBLE) 'BACK X DISTANCE
54. T_DISTANCE = T_DISTANCE * T_SCALE
55. T_NEW_POSITION_X = T_POSITION_X - ( T_DISTANCE * SIN (T_HEADING))
56. T_NEW_POSITION_Y = T_POSITION_Y + ( T_DISTANCE * COS (T_HEADING))
57. T_DRAW1 ()
58. END SUB
59.  
60.  
61. SUB T_ORIENT (BYVAL T_ANGLE AS DOUBLE) 'SET ORIENTATION TURTLE
62. T_HEADING = (T_ANGLE * 0.0174532925199433)
63. END SUB
64.  
65.  
66. #MACRO T_DRAW1 ()
67. 'DRAW SHAPES
68. IF T_PEN = 1 AND T_THICKNESS = 0 AND T_BOLD = 0 THEN LINE (T_POSITION_X , T_POSITION_Y) - (T_NEW_POSITION_X , T_NEW_POSITION_Y) , T_COLOR : END IF
69. IF T_PEN = 1 AND T_THICKNESS > 0 AND T_BOLD = 1 THEN T_SEGMENT (T_POSITION_X , T_POSITION_Y , T_NEW_POSITION_X , T_NEW_POSITION_Y) : END IF
70. T_POSITION_X = T_NEW_POSITION_X
71. T_POSITION_Y = T_NEW_POSITION_Y
72. #ENDMACRO
73.  
74.  
75. SUB T_SEGMENT (BYVAL T_LX1 AS DOUBLE , BYVAL T_LY1 AS DOUBLE , BYVAL T_LX2 AS DOUBLE , BYVAL T_LY2 AS DOUBLE)
76. DIM AS INTEGER T_N
77. DIM AS DOUBLE T_HIP , T_ANG , T_LX , T_LY , T_LPX , T_LPY , T_DX , T_DY
78. T_DX = ABS (T_LX1 - T_LX2)
79. T_DY = ABS (T_LY1 - T_LY2)
80. T_HIP = T_LONG (BYVAL T_LX1 , BYVAL T_LY1 , BYVAL T_LX2 , BYVAL T_LY2 )
81. T_ANG = ATN(T_DY / T_DX)
82.  
83. IF T_BOLD = 1 THEN
84. FOR T_N = 0 TO T_HIP
85. T_DRAW2 (T_N , T_HIP , T_ANG , T_LX , T_LY , T_LPX , T_LPY , T_DX , T_DY)
86. IF T_PEN = 1 AND  T_BOLD = 0  THEN EXIT FOR
87. IF T_PEN = 1 AND T_THICKNESS > 0 THEN CIRCLE (T_LPX , T_LPY) , T_THICKNESS , T_COLOR , , , , F : END IF
88. NEXT T_N
89. END IF
90.  
91. IF T_HOLE = 1 AND T_BOLD = 1 THEN
92. FOR T_N = 0 TO T_HIP
93. IF T_PEN = 1 AND  T_BOLD = 0  THEN EXIT FOR  
94. T_DRAW2 (T_N , T_HIP , T_ANG , T_LX , T_LY , T_LPX , T_LPY , T_DX , T_DY)
95. IF T_PEN = 1 AND T_THICKNESS > 0 THEN CIRCLE (T_LPX , T_LPY) , T_THICKNESS / T_GROSS , T_HOLE_COLOR , , , , F : END IF
96. NEXT T_N
97. END IF
98. END SUB
99.  
100.  
101. SUB T_POSITION (BYVAL T_X AS DOUBLE , BYVAL T_Y AS DOUBLE)
102. T_PEN = 0
103. T_GT (T_X , T_Y)
104. T_PEN = 1
105. END SUB
106.  
107.  
108. SUB T_GT (BYVAL T_X AS DOUBLE , BYVAL T_Y AS DOUBLE) 'GO TO NEW POSITION X , Y
109. T_X = T_X * T_SCALE
110. T_Y = T_Y * T_SCALE
111. T_NEW_POSITION_X = T_CENTER_SCREEN_X + T_X
112. T_NEW_POSITION_Y = T_CENTER_SCREEN_Y + T_Y
113. T_DRAW1 ()
114. END SUB
115.  
116.  
117.  
118. SUB T_LT (BYVAL T_ANGLE AS DOUBLE) 'TURN RIGHT
119. T_HEADING = T_HEADING + (T_ANGLE * 0.0174532925199433)
120. END SUB
121.  
122.  
123.  
124. SUB T_BK (BYVAL T_DISTANCE AS DOUBLE) 'FORWARD X DISTANCE
125. T_DISTANCE = T_DISTANCE * T_SCALE
126. T_NEW_POSITION_X = T_POSITION_X + (T_DISTANCE * SIN(T_HEADING))
127. T_NEW_POSITION_Y = T_POSITION_Y - (T_DISTANCE * COS(T_HEADING))
128. T_DRAW1 ()
129. END SUB
130.  
131.  
132.  
133.  
134. 'INIT T_INIT
135. SUB T_INIT () 'INIT TURTLE
136. 'PARAMETERS COMMONS
137. SCREENINFO T_W , T_H
138. WINDOW (0,0)-(T_W,T_H)
139. T_CENTER_SCREEN_X = INT (T_W / 2)
140. T_CENTER_SCREEN_Y = INT (T_H / 2)
141. T_POSITION_X = T_CENTER_SCREEN_X
142. T_POSITION_Y = T_CENTER_SCREEN_Y
143. T_GT (T_POSITION_X , T_POSITION_Y)
144. T_HEADING = 0
145. T_ORIENT 0
146. T_PEN = 1
147. T_SHAPES = 1'ENABLES OR DISABLES THE SHAPES , VALUES 0 / 1
148. T_THICKNESS = 0 'THICKNESS OF LINES, ARCS, CIRCLES... , VALUES 0...
149. T_BOLD = 0 'ENABLES OR DISABLES THE BOLD TEXT , VALUES 0 / 1
150. T_HOLE = 0 'ENABLE OR DISABLE THE HOLE TEXT , VALUES 0 / 1
151. T_COLOR = 12 'COLOR LINES, ARCS, CIRCLES, ELLIPSES... VALUES 0 ..
152. T_HOLE_COLOR = 14 'COLORED HOLE CHARS VALUES 0 ..
153. T_GROSS = 2 'GROSOR INTERIOR TEXTO , VALUES 1...4
154. T_SCALE = 1 ' SCALE SHAPES, TEXT, NUMBERS...
155. TX_INIT
156. END SUB
157. 'END T_INIT  

Is there a converter that converts Freebasic code to Lazarus that is similar to the Delphi to Lazarus converter?

I thought I came across some converter on Github


Actually found a converter at https://sourceforge.net/projects/basic-to-pascal/   but will it work?

Had a go at converting and got the pas source below:

Code: Pascal  [Select][+][-]

1. var : integer n, g;
2. var : double c, p;
3.  
4. ClrScr:screen 12:t_init;
5. g = int (360/8) { values 3,4,5,6,.....= triangle, square, pentagonal, hexagonal....;
6. p = 0.8 { step;
7. c = 0;
8.  
9. for n = 2 to 100 { limit;
10. if prime (n) = 1 then t_rt g
11. begin
12. t_fd c;
13. c = c + p;
14. next n;
15. sleep;
16. end;
17.  
18. function prime (x as integer) as integer;
19. var : integer i, p;
20. {number not prime, p = 0 }
21. {number yes prime, p = 1 }
22. p = 0;
23. for i = 2 to sqr(x);
24. if x mod (i) = 0 then p = 0 : exit for
25. begin
26. if x mod (i) <> 0 then p = 1 : exit for
27. begin
28. next i;
29. if p = 0 then prime = 0 else prime = 1 end
30. begin
31. end;

The converted Turtle7.bi to pascal gave:

Code: Pascal  [Select][+][-]

1. #macro tx_draw1 ();
2. {draw text }
3. if tx_pen = 1 and tx_thickness = 0 andtx_bold = 0 then line (tx_position_x , tx_position_y) - (tx_new_position_x , tx_new_position_y) , tx_color : end
4. begin
5. if tx_pen = 1 and tx_thickness > 0 andtx_bold = 1 then tx_segment (tx_position_x , tx_position_y , tx_new_position_x , tx_new_position_y) : end
6. begin
7. tx_position_x = tx_new_position_x;
8. tx_position_y = tx_new_position_y;
9. #endmacro;
10.  
11. procedure tx_gt (byval tx_x as double , byval tx_y as double){ go to new position x , y;
12. begin
13. tx_x= tx_x* tx_scale;
14. tx_y= tx_y* tx_scale;
15. tx_new_position_x= tx_center_screen_x+ tx_x;
16. tx_new_position_y= tx_center_screen_y+ tx_y;
17. if tx_pen= 1 and tx_thickness = 0 and tx_bold= 0 then line (tx_position_x , tx_position_y) - (tx_new_position_x , tx_new_position_y)
18. begin
19. if tx_pen= 1 and tx_thickness > 0 and tx_bold= 1 then tx_segment (tx_position_x , tx_position_y , tx_new_position_x , tx_new_position_y)
20. begin
21. tx_draw1 ();
22. tx_position_x= tx_new_position_x;
23. tx_position_y= tx_new_position_y;
24. end;
25.  
26. procedure tx_position (byval tx_x as double , byval tx_y as double);
27. begin
28. tx_pen= 0;
29. tx_gt (tx_x , tx_y);
30. tx_pen= 1;
31. end;
32.  
33. procedure tx_home () { go home turtle;
34. begin
35. tx_pen= 0;
36. tx_position_x = tx_w \ 2;
37. tx_position_y = tx_h \ 2;
38. tx_pen= 1;
39. end;
40.  
41. procedure tx_bk (byval tx_distance as double) { forward x distance;
42. begin
43. tx_distance= tx_distance* tx_scale;
44. tx_new_position_x= tx_position_x+ (tx_distance*sin(tx_heading));
45. tx_new_position_y= tx_position_y- (tx_distance*cos(tx_heading));
46. if tx_pen= 1 and tx_thickness = 0 and tx_bold= 0 then line (tx_position_x , tx_position_y) - (tx_new_position_x , tx_new_position_y)
47. begin
48. if tx_pen= 1 and tx_thickness > 0 and tx_bold= 1 then tx_segment (tx_position_x , tx_position_y , tx_new_position_x , tx_new_position_y)
49. begin
50. tx_draw1 ();
51. tx_position_x= tx_new_position_x;
52. tx_position_y= tx_new_position_y;
53. end;
54.  
55. procedure tx_fd (byval tx_distance as double) { back x distance;
56. begin
57. tx_distance= tx_distance* tx_scale;
58. tx_new_position_x= tx_position_x- ( tx_distance*sin (tx_heading));
59. tx_new_position_y= tx_position_y+ ( tx_distance*cos (tx_heading));
60. if tx_pen= 1 and tx_thickness = 0 and tx_bold= 0 then line(tx_position_x , tx_position_y) - (tx_new_position_x , tx_new_position_y)
61. begin
62. if tx_pen= 1 and tx_thickness > 0 and tx_bold= 1 then tx_segment (tx_position_x , tx_position_y , tx_new_position_x , tx_new_position_y)
63. begin
64. tx_draw1 ();
65. tx_position_x= tx_new_position_x;
66. tx_position_y= tx_new_position_y;
67. end;
68.  
69. procedure tx_lt (byval tx_angle as double) { turn right;
70. begin
71. tx_heading= tx_heading+ (tx_angle * 0.0174532925199433);
72. end;
73.  
74. procedure tx_rt (byval tx_angle as double) { turn left;
75. begin
76. tx_heading= tx_heading- (tx_angle * 0.0174532925199433);
77. end;
78.  
79. function tx_long (byval tx_x1 as double , byval tx_y1 as double , byval tx_x2 as double , byval tx_y2 as double) as double{ calculate distance/ lenght two points;
80. var : double tx_dx= tx_x1 - tx_x2;
81. var : double tx_dy= tx_y1 - tx_y2;
82. return sqr((tx_dx^2) + (tx_dy^2));
83. end;
84.  
85. #macro tx_draw2 (tx_n , tx_hip , tx_ang , tx_lx , tx_ly , tx_lpx , tx_lpy , tx_dx , tx_dy);
86. tx_ly = sin(tx_ang) * tx_n;
87. tx_lx = cos(tx_ang) * tx_n;
88. if tx_lx1 < tx_lx2 and tx_ly1 < tx_ly2 then tx_lpx = tx_lx + tx_lx1 : tx_lpy = tx_ly + tx_ly1 : end
89. begin
90. if tx_lx1 < tx_lx2 and tx_ly1 > tx_ly2 then tx_lpx = tx_lx + tx_lx1 : tx_lpy = tx_ly1 - tx_ly : end
91. begin
92. if tx_lx1 > tx_lx2 and tx_ly1 < tx_ly2 then tx_lpx = tx_lx + tx_lx2 : tx_lpy = tx_ly2 - tx_ly : end
93. begin
94. if tx_lx1 > tx_lx2 and tx_ly1 > tx_ly2 then tx_lpx = tx_lx1 - tx_lx : tx_lpy = tx_ly1 - tx_ly : end
95. begin
96. if tx_lx1 = tx_lx2 and tx_ly1 < tx_ly2 then tx_lpx = tx_lx + tx_lx2 : tx_lpy = tx_ly2 - tx_ly : end
97. begin
98. if tx_lx1 = tx_lx2 and tx_ly1 > tx_ly2 then tx_lpx = tx_lx + tx_lx2 : tx_lpy = tx_ly2 + tx_ly : end
99. begin
100. if tx_lx1 < tx_lx2 and tx_ly1 = tx_ly2 then tx_lpx = tx_lx2 - tx_lx : tx_lpy = tx_ly2 + tx_ly : end
101. begin
102. if tx_lx1 > tx_lx2 and tx_ly1 = tx_ly2 then tx_lpx = tx_lx2 + tx_lx : tx_lpy = tx_ly2 + tx_ly : end
103. begin
104. if tx_lx1 = tx_lx2 and tx_ly1 = tx_ly2 then tx_lpx = tx_lx1 : tx_lpy = tx_ly1 : end
105. begin
106. #endmacro;
107.  
108. procedure tx_segment (byval tx_lx1 as double , byval tx_ly1 as double , byval tx_lx2 as double , byval tx_ly2 as double);
109. begin
110. var : integer tx_n;
111. var : double tx_hip , tx_ang , tx_lx , tx_ly , tx_lpx , tx_lpy , tx_dx , tx_dy;
112. tx_dx= abs (tx_lx1- tx_lx2);
113. tx_dy= abs (tx_ly1- tx_ly2);
114. tx_hip= sqr(tx_dx * tx_dx+ tx_dy * tx_dy);
115. tx_ang= atn(tx_dy/ tx_dx);
116.  
117. iftx_bold= 1 then
118. begin
119. for tx_n= 0 to tx_hip;
120. tx_ly= sin(tx_ang)* tx_n;
121. tx_lx= cos(tx_ang)* tx_n;
122. tx_draw2 (tx_n , tx_hip , tx_ang , tx_lx , tx_ly , tx_lpx , tx_lpy , tx_dx , tx_dy);
123. if tx_pen = 1 and tx_thickness > 0 then circle (tx_lpx , tx_lpy) , tx_thickness , tx_color , , , , f : end
124. begin
125. next tx_n;
126. end;
127.  
128. iftx_hole= 1 and tx_bold= 1 then
129. begin
130. for tx_n= 0 to tx_hip;
131. tx_ly= sin(tx_ang)* tx_n;
132. tx_lx= cos(tx_ang)* tx_n;
133. tx_draw2 (tx_n , tx_hip , tx_ang , tx_lx , tx_ly , tx_lpx , tx_lpy , tx_dx , tx_dy);
134. if tx_pen = 1 and tx_thickness > 0 then circle (tx_lpx , tx_lpy) , tx_thickness / tx_gross , tx_hole_color , , , , f : end
135. begin
136. next tx_n;
137. end;
138. end;

[MarkMLl]

Please don't capitalise Ulam's name like that: it's offensive to those of us who have studied his work on cellular automata etc.

I'd suggest that you're looking at this wrong. To borrow an old joke: "First catch your turtle".

MarkMLl

[Boleeman]

.

[Boleeman]

..

[wp]

I think instead of looking for ready-made solutions it would be more rewarding for you if you would try to understand the BASIC code (BASIC is not sooo much different from Pascal), and then you can do the conversion yourself. It would have the advantage that you understand every line of the code then.

[Boleeman]

Many thanks to those who had helped me out. Much appreciated..