1 #Region "Microsoft.VisualBasic::c98a6d2ecf50a86ffcf021ff4e65ef22, Microsoft.VisualBasic.Core\Extensions\Image\Colors\ColorCube.vb"
2
3     ' Author:
4     ' 
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     ' 
9     ' Copyright (c) 2018 GPL3 Licensed
10     ' 
11     ' 
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     ' 
14     ' 
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     ' 
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     ' 
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Module ColorCube
35     ' 
36     '         Function: Compare, CompareGreater, CompareLess, DegreesToRadians, GetAzimuthTo
37     '                   GetBrightness, (+2 Overloads) GetColorFrom, GetColorsAround, GetColorSequence, GetColorSpectrum
38     '                   GetDistance, GetElevationTo, RadiansToDegrees, WrapAngle
39     ' 
40     ' 
41     ' /********************************************************************************/
42
43 #End Region
44
45 Imports System.Drawing
46 Imports System.Runtime.CompilerServices
47 Imports Microsoft.VisualBasic.CommandLine.Reflection
48 Imports Microsoft.VisualBasic.Language
49 Imports Microsoft.VisualBasic.Scripting.MetaData
50 Imports sys = System.Math
51
52 Namespace Imaging
53
54     ''' <summary>
55     ''' Describes the RGB color space as a 3D cube with the origin at Black.
56     ''' </summary>
57     ''' <remarks>
58     ''' http://social.technet.microsoft.com/wiki/contents/articles/20990.generate-color-sequences-using-rgb-color-cube-in-vb-net.aspx
59     ''' </remarks>
60     <Package("ColorCube",
61                   Publisher:="Reed Kimble",
62                   Category:=APICategories.UtilityTools,
63                   Description:="Sometimes when you are designing a form, or creating some other kind of visual output, you'd like to generate an array of colors which may be shades of a single color or a discernible sequence of individual colors such as the spectrum of a rainbow.  This can be useful for coloring bars in a graph or generating a gradient around some specified color.  Unfortunately the .Net framework does not give us any sophisticated solution for this.
64                   <br />
65 While any number of complex code solutions could be created to attempt to address this problem, if we think of the RGB color space spatially, we can construct a three-dimensional cube which represents all possible colors and can easily be traversed mathematically.",
66                   Url:="http://social.technet.microsoft.com/wiki/contents/articles/20990.generate-color-sequences-using-rgb-color-cube-in-vb-net.aspx")>
67     Public Module ColorCube
68
69         ''' <summary>
70         ''' Compares two colors according to their distance from the origin of the cube (black).
71         ''' </summary>
72         ''' <param name="source"></param>
73         ''' <param name="target"></param>
74         ''' <returns></returns>
75         ''' <remarks></remarks>
76         ''' 
77         <ExportAPI("Compare")>
78         Public Function Compare(source As Color, target As Color) As Integer
79             Dim delta1 As Double = GetDistance(Color.Black, source)
80             Dim delta2 As Double = GetDistance(Color.Black, target)
81             Return delta1.CompareTo(delta2)
82         End Function
83
84         ''' <summary>
85         ''' Returns an integer between 0 and 255 indicating the perceived brightness of the color.
86         ''' </summary>
87         ''' <param name="target">A System.Drawing.Color instance.</param>
88         ''' <returns>An integer indicating the brightness with 0 being dark and 255 being bright.</returns>
89         ''' <remarks>
90         ''' Formula found using web search at:
91         ''' http://www.nbdtech.com/Blog/archive/2008/04/27/Calculating-the-Perceived-Brightness-of-a-Color.aspx This link is external to TechNet Wiki. It will open in a new window.
92         ''' with reference to : http://alienryderflex.com/hsp.html This link is external to TechNet Wiki. It will open in a new window.
93         ''' Effectively the same as measuring a color's distance from black, but constrained to a 0-255 range.
94         ''' </remarks>
95         ''' 
96         <ExportAPI("Brightness")>
97         <Extension>
98         Public Function GetBrightness(target As Color) As Integer
99             Return CInt(sys.Sqrt(0.241 * target.R ^ 2 + 0.691 * target.G ^ 2 + 0.068 * target.B ^ 2))
100         End Function
101
102         ''' <summary>
103         ''' Gets a color from within the cube starting at the origin and moving a given distance in the specified direction.
104         ''' </summary>
105         ''' <param name="azimuth">The side-to-side angle in degrees; 0 points toward red and 90 points toward blue.</param>
106         ''' <param name="elevation">The top-to-bottom angle in degrees; 0 is no green and 90 points toward full green.</param>
107         ''' <param name="distance">The distance to travel within the cube; 500 is max.</param>
108         ''' <returns>The color within the cube at the given distance in the specified direction.</returns>
109         ''' <remarks></remarks>
110         ''' 
111         <ExportAPI("CreateColor")>
112         Public Function GetColorFrom(azimuth As Integer, elevation As Integer, distance As Integer) As Color
113             Return GetColorFrom(Color.Black, azimuth, elevation, distance)
114         End Function
115
116         ''' <summary>
117         ''' Value must be between 0 and 90.
118         ''' </summary>
119         Const InvalidRange$ = "Value must be between 0 and 90."
120
121         ''' <summary>
122         ''' Gets a color from within the cube starting at the specified location and moving a given distance in the specified direction.
123         ''' </summary>
124         ''' <param name="source">The source location within the cube from which to start moving.</param>
125         ''' <param name="azimuth">The side-to-side angle in degrees; 0 points toward red and 90 points toward blue.</param>
126         ''' <param name="elevation">The top-to-bottom angle in degrees; 0 is no green and 90 points toward full green.</param>
127         ''' <param name="distance">The distance to travel within the cube; the approximate distance from black to white is 500.</param>
128         ''' <returns>The color within the cube at the given distance in the specified direction.</returns>
129         ''' <remarks></remarks>
130         ''' 
131         <ExportAPI("CreateColor")>
132         Public Function GetColorFrom(source As Color, azimuth As Double, elevation As Double, distance As Double, Optional isRadians As Boolean = False, Optional alpha% = 255) As Color
133             If azimuth < 0 OrElse azimuth > 90 Then
134                 Throw New ArgumentException("azimuth", InvalidRange)
135             End If
136             If elevation < 0 OrElse elevation > 90 Then
137                 Throw New ArgumentException("elevation", InvalidRange)
138             End If
139
140             Dim a, e, r, g, b As Double
141
142             If isRadians Then
143                 a = azimuth
144                 e = elevation
145             Else
146                 a = DegreesToRadians(azimuth)
147                 e = DegreesToRadians(elevation)
148             End If
149
150             r = distance * sys.Cos(a) * sys.Cos(e)
151             b = distance * sys.Sin(a) * sys.Cos(e)
152             g = distance * sys.Sin(e)
153
154             If Double.IsNaN(r) Then r = 0
155             If Double.IsNaN(g) Then g = 0
156             If Double.IsNaN(b) Then b = 0
157
158             Return Color.FromArgb(
159                 alpha,
160                 sys.Max(sys.Min(source.R + r, 255), 0),
161                 sys.Max(sys.Min(source.G + g, 255), 0),
162                 sys.Max(sys.Min(source.B + b, 255), 0))
163         End Function
164
165         ''' <summary>
166         ''' Creates an array of colors from a selection within a sphere around the specified color.
167         ''' </summary>
168         ''' <param name="target">The color to select around.</param>
169         ''' <param name="distance">The radius of the selection sphere.</param>
170         ''' <param name="increment">The increment within the sphere at which a selection is taken; larger numbers result in smaller selection sets.</param>
171         ''' <returns>An array of colors located around the specified color within the cube.</returns>
172         ''' <remarks></remarks>
173         ''' 
174         <ExportAPI("GetColors")>
175         Public Function GetColorsAround(target As Color, distance As Integer, increment As Integer) As Color()
176             Dim result As New List(Of Color)
177             For a As Integer = 0 To 359 Step increment
178                 For e As Integer = 0 To 359 Step increment
179                     Dim c As Color = GetColorFrom(target, a, e, distance)
180                     If Not result.Contains(c) Then
181                         result.Add(c)
182                     End If
183                 Next
184             Next
185             result.Sort(AddressOf Compare)
186             Return result.ToArray
187         End Function
188
189         ''' <summary>
190         ''' Creates an array of colors in a gradient sequence between two specified colors.
191         ''' </summary>
192         ''' <param name="source">The starting color in the sequence.</param>
193         ''' <param name="target">The end color in the sequence.</param>
194         ''' <param name="increment">The increment between colors.</param>
195         ''' <returns>A gradient array of colors.</returns>
196         ''' <remarks></remarks>
197         ''' 
198         <ExportAPI("Gradients")>
199         Public Function GetColorSequence(source As Color, target As Color, increment As Integer, Optional alpha% = 255) As Color()
200             Dim a As Double = GetAzimuthTo(source, target)
201             Dim e As Double = GetElevationTo(source, target)
202             Dim d As Double = GetDistance(source, target)
203             Dim result As New List(Of Color)
204
205             For i As Integer = 0 To d Step increment
206                 result += GetColorFrom(
207                     source,
208                     a, e, i,
209                     isRadians:=True,
210                     alpha:=alpha%)
211             Next
212
213             Return result.ToArray
214         End Function
215
216         ''' <summary>
217         ''' Creates a rainbow array of colors by selecting from the edges of the cube in ROYGBIV order at the specified increment.
218         ''' </summary>
219         ''' <param name="increment">The increment along the edges at which a selection is taken; larger numbers result in smaller selection sets.</param>
220         ''' <returns>An array of colors in ROYGBIV order at the given increment.</returns>
221         ''' <remarks></remarks>
222         ''' 
223         <ExportAPI("ColorSpectrum")>
224         Public Function GetColorSpectrum(increment As Integer) As Color()
225             Dim result As New List(Of Color)
226             Dim rgb(2) As Integer
227             Dim idx As Integer = 1
228             Dim inc As Integer = increment
229             Dim cmp As Func(Of Integer, Integer, Boolean)
230
231             rgb(0) = 255
232             cmp = AddressOf CompareLess
233             Do
234                 result.Add(Color.FromArgb(rgb(0), rgb(1), rgb(2)))
235                 If cmp(rgb(idx), inc) Then
236                     rgb(idx) += inc
237                 Else
238                     Select Case idx
239                         Case 1
240                             If rgb(2) < 255 Then
241                                 rgb(idx) = 255
242                                 idx = 0
243                                 cmp = AddressOf CompareGreater
244                             Else
245                                 rgb(idx) = 0
246                                 idx = 0
247                                 cmp = AddressOf CompareLess
248                             End If
249                         Case 2
250                             rgb(idx) = 255
251                             idx = 1
252                             cmp = AddressOf CompareGreater
253                         Case 0
254                             If rgb(2) < 255 Then
255                                 rgb(idx) = 0
256                                 idx = 2
257                                 cmp = AddressOf CompareLess
258                             Else
259                                 rgb(idx) = 255
260                                 Exit Do
261                             End If
262                     End Select
263                     inc *= -1
264                 End If
265             Loop
266             result.Add(Color.FromArgb(rgb(0), rgb(1), rgb(2)))
267             Return result.ToArray
268         End Function
269
270         ''' <summary>
271         ''' Gets the distance between two colors within the cube.
272         ''' </summary>
273         ''' <param name="source">The source color in the cube.</param>
274         ''' <param name="target">The target color in the cube.</param>
275         ''' <returns>The distance between the source and target colors.</returns>
276         ''' <remarks></remarks>
277         ''' 
278         <ExportAPI("Distance")>
279         Public Function GetDistance(source As Color, target As Color) As Double
280             Dim squareR As Double = CDbl(target.R) - CDbl(source.R)
281             squareR *= squareR
282             Dim squareG As Double = CDbl(target.G) - CDbl(source.G)
283             squareG *= squareG
284             Dim squareB As Double = CDbl(target.B) - CDbl(source.B)
285             squareB *= squareB
286             Return System.Math.Sqrt(squareR + squareG + squareB)
287         End Function
288
289         <ExportAPI("CompareLess")>
290         Public Function CompareLess(value As Integer, inc As Integer) As Boolean
291             Return value < 255 - sys.Abs(inc)
292         End Function
293
294         <ExportAPI("CompareGreater")>
295         Public Function CompareGreater(value As Integer, inc As Integer) As Boolean
296             Return value > 0 + sys.Abs(inc)
297         End Function
298
299         <ExportAPI("Radians")>
300         Public Function DegreesToRadians(degrees As Double) As Double
301             Return degrees * (Math.PI / 180.0)
302         End Function
303
304         <ExportAPI("Degrees")>
305         Public Function RadiansToDegrees(radians As Double) As Double
306             Return CSng(radians * (180.0 / sys.PI))
307         End Function
308
309         <ExportAPI("Azimuth")>
310         Public Function GetAzimuthTo(source As Color, target As Color) As Double
311             Return WrapAngle(sys.Atan2(CDbl(target.B) - CDbl(source.B), CDbl(target.R) - CDbl(source.R)))
312         End Function
313
314         <ExportAPI("Elevation")>
315         Public Function GetElevationTo(source As Color, target As Color) As Double
316             Return WrapAngle(sys.Atan2(CDbl(target.G) - CDbl(source.G), 255))
317         End Function
318
319         <ExportAPI("WrapAngle")>
320         Public Function WrapAngle(radians As Double) As Double
321             While radians < -Math.PI
322                 radians += sys.PI * 2
323             End While
324             While radians > sys.PI
325                 radians -= sys.PI * 2
326             End While
327             Return radians
328         End Function
329     End Module
330 End Namespace