Super Ellipse (Rosetta Code task)

[AndyA]

'https://rosettacode.org/wiki/Superellipse

I have an old one, but it's new for QB64.

I originally did this code in JustBasic back in about 2006(?), not sure exactly when but it's included in the JustBasic or Liberty Basic download.

As TempodiBasic showed the code before posting on Rosetta, here it is.

Code: QB64: [Select]

1. _Title "Super Ellipse"
2.  
3. Dim As Integer sw, sh
4. Dim As Single i
5. sw = 480: sh = 480
6.  
7. Screen _NewImage(sw, sh, 8)
8. Cls , 15
9.  
10. 'Show different possible Super Ellipse shapes
11. Color 10
12. For i = 0.2 To 5.0 Step .1
13.     Call SuperEllipse(sw \ 2, sh \ 2, 200, 200, i, 80)
14. Next
15.  
16. 'Show task specified Super Ellipse
17. Color 0
18. Call SuperEllipse(sw \ 2, sh \ 2, 200, 200, 2.5, 200)
19. Sleep
20. System
21.  
22. Sub SuperEllipse (cX As Integer, cY As Integer, wide As Integer, high As Integer, pow As Double, segs As Integer)
23.     Dim As Double power, inc, theta, cosTheta, sinTheta
24.     Dim As Integer x1, y1
25.     'Limit 'pow' to acceptable values
26.     If pow < .1 Then pow = .1
27.     If pow > 150 Then pow = 150
28.     power = 2 / pow - 1
29.     inc = 360.0 / segs * 0.0174532925199432957692369
30.     PSet (wide + cX, cY)
31.     For theta = inc To 6.28318530717958647692528 + inc Step inc
32.         cosTheta = Cos(theta): sinTheta = Sin(theta)
33.         x1 = wide * cosTheta * Abs(cosTheta) ^ power + cX
34.         y1 = high * sinTheta * Abs(sinTheta) ^ power + cY
35.         Line -(x1, y1)
36.     Next
37. End Sub

[TempodiBasic]

Hi AndyA
Cool that you joined to post solutions of Rosetta Code tasks!
Fine demo of SuperEllipse.

[AndyA]

Hi TempodiBasic

Was going to post directly to Rossetta, but decided let the QB64 community see them here before the world sees the code, just like you did.