Color wheel: Difference between revisions

Content added Content deleted

Inline

@@ Line 229: / Line 229: @@
 In '''[https://formulae.org/?example=Color_wheel this]''' page you can see the program(s) related to this task and their results.
+=={{header|FreeBASIC}}==
+<lang freebasic>#include "fbgfx.bi"
+Sub HSVtoRGB(h As Single, s As Integer, v As Integer, Byref r As Integer, Byref g As Integer, Byref b As Integer)
+    If s = 0 Then
+        r = v
+        g = v
+        b = v
+        Return
+    End If
+    h = h Mod 360
+    Dim As Single hue = h
+    Select Case h
+    Case 0f To 51.5f
+        hue = ((hue         ) * (30f / (51.5f          )))
+    Case 51.5f To 122f
+        hue = ((hue -  51.5f) * (30f / (122f   -  51.5f))) + 30
+    Case 122f To 142.5f
+        hue = ((hue -   122f) * (30f / (142.5f -   122f))) + 60
+    Case 142.5f To 165.5f
+        hue = ((hue - 142.5f) * (30f / (165.5f - 142.5f))) + 90
+    Case 165.5f To 192f
+        hue = ((hue - 165.5f) * (30f / (192f   - 165.5f))) + 120
+    Case 192f To 218.5f
+        hue = ((hue -   192f) * (30f / (218.5f -   192f))) + 150
+    Case 218.5f To 247f
+        hue = ((hue - 218.5f) * (30f / (247f   - 218.5f))) + 180
+    Case 247f To 275.5f
+        hue = ((hue -   247f) * (30f / (275.5f -   247f))) + 210
+    Case 275.5f To 302.5f
+        hue = ((hue - 275.5f) * (30f / (302.5f - 275.5f))) + 240
+    Case 302.5f To 330f
+        hue = ((hue - 302.5f) * (30f / (330f   - 302.5f))) + 270
+    Case 330f To 344.5f
+        hue = ((hue -   330f) * (30f / (344.5f -   330f))) + 300
+    Case 344.5f To 360f
+        hue = ((hue - 344.5f) * (30f / (360f   - 344.5f))) + 330
+    End Select
+    h = hue
+    h = h Mod 360
+    Dim As Single h1 = h / 60
+    Dim As Integer i = Int(h1)
+    Dim As Single f = h1 - i
+    Dim As Integer p = v * (255 - s) / 256
+    Dim As Integer q = v * (255 - f * s) / 256
+    Dim As Integer t = v * (255 - (1 - f) * s) / 256
+    Select Case As Const i
+    Case 0
+        r = v
+        g = t
+        b = p
+        Return
+    Case 1
+        r = q
+        g = v
+        b = p
+        Return
+    Case 2
+        r = p
+        g = v
+        b = t
+        Return
+    Case 3
+        r = p
+        g = q
+        b = v
+        Return
+    Case 4
+        r = t
+        g = p
+        b = v
+        Return
+    Case 5
+        r = v
+        g = p
+        b = q
+        Return
+    End Select
+End Sub
+Const pi As Single = 4 * Atn(1)
+Const radius = 160
+Const xres = (radius * 2) + 1, yres = xres
+Screenres xres, yres, 32
+Windowtitle "Color wheel"
+Dim As Integer r,g,b
+Dim As Single dx, dy, dist, angle
+Do
+    Screenlock
+    Cls
+    For x As Integer = 0 To (radius * 2) - 1
+        For y As Integer = 0 To (radius * 2) - 1
+            dx = x - radius
+            dy = radius - y
+            dist = Sqr(dx * dx + dy * dy)
+            If dist < radius Then
+                angle = Atan2(dy, dx) * (180/pi)
+                If angle <   0 Then angle += 360
+                If angle > 360 Then angle -= 360
+                HSVtoRGB(angle, (dist / radius) * 255, 255, r, g, b)
+                Pset(x, y), Rgb(r, g, b)
+            End If
+        Next y
+    Next x
+    Screenunlock
+Loop Until Inkey = Chr(27)</lang>
 =={{header|GML}}==