1	#Region "Microsoft.VisualBasic::8e8be001cb1181a81589fdf10ea79183, Microsoft.VisualBasic.Core\Extensions\Image\Colors\ColorMap.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 ColorMapsExtensions
35	'
36	'         Function: (+2 Overloads) ColorSequence
37	'         Delegate Function
38	'
39	'
40	'
41	'     Class ColorMap
42	'
43	'         Properties: Alpha, ColorMapLength, ColorMaps, MaxDepth
44	'
45	'         Constructor: (+3 Overloads) Sub New
46	'         Function: Autumn, Cool, GetMaps, Gray, Hot
47	'                   Jet, Spring, Summer, Winter
48	'
49	'
50	'
51	' /********************************************************************************/
52
53	#End Region
54
55	Imports System.Drawing
56	Imports System.Math
57	Imports System.Runtime.CompilerServices
58	Imports Microsoft.VisualBasic.CommandLine.Reflection
59	Imports Microsoft.VisualBasic.Language
60	Imports Microsoft.VisualBasic.Scripting.MetaData
61
62	Namespace Imaging
63
64	''' <summary>
65	''' Create Custom Color Maps
66	''' </summary>
67	''' <remarks>http://www.codeproject.com/Articles/18150/Create-Custom-Color-Maps-in-C</remarks>
68	'''
69	<Package("ColorMap", Publisher:="Jack J. H. Xu", Category:=APICategories.UtilityTools)>
70	Public Module ColorMapsExtensions
71
72	''' <summary>
73	''' <paramref name="mapName"/>大小写不敏感
74	''' </summary>
75	''' <param name="mapName"></param>
76	''' <param name="map"><see cref="ColorMap.MaxDepth"/></param>
77	''' <param name="min">value should smaller than <see cref="ColorMap.MaxDepth"/> in parameter <paramref name="map"/></param>
78	''' <returns></returns>
79	'''
80	<ExportAPI("Color.Sequence")>
81	<Extension>
82	Public Function ColorSequence(map As ColorMap, Optional mapName$ = ColorMap.PatternJet, Optional min% = 0) As Color()
83	Dim cMap%(,) = map.GetMaps(mapName)()
84	Dim maxDepth% = map.MaxDepth
85	Dim m% = maxDepth * 2
86	Dim sequence As New List(Of Color)
87
88	For i As Integer = 0 To maxDepth - 1
89	Dim colorIndex% = CInt((i - min) * m \ (maxDepth - min))
90	Dim a = cMap(colorIndex, 0)
91	Dim r = cMap(colorIndex, 1)
92	Dim g = cMap(colorIndex, 2)
93	Dim b = cMap(colorIndex, 3)
94	Dim cl As Color = Color.FromArgb(a, r, g, b)
95
96	Call sequence.Add(cl)
97	Next
98
99	Return sequence.ToArray
100	End Function
101
102	ReadOnly __default As ColorMap = New ColorMap(64%)
103
104	<ExportAPI("Color.Sequence")>
105	Public Function ColorSequence(Optional min% = 0, Optional name$ = "Jet") As Color()
106	SyncLock __default
107	Return ColorSequence(__default, name, min)
108	End SyncLock
109	End Function
110
111	Public Delegate Function MapsFunc() As Integer(,)
112	End Module
113
114	Public Class ColorMap
115
116	Public ReadOnly Property ColorMapLength As Integer = 64
117
118	''' <summary>
119	''' Alpha value in the RBG color function.
120	''' </summary>
121	''' <returns></returns>
122	Public ReadOnly Property Alpha As Integer = 255
123
124	Public ReadOnly Property MaxDepth As Integer
125	Get
126	Return CInt(ColorMapLength / 2)
127	End Get
128	End Property
129
130	Sub New()
131	End Sub
132
133	Sub New(colorLength%)
134	ColorMapLength = colorLength
135	End Sub
136
137	''' <summary>
138	'''
139	''' </summary>
140	''' <param name="colorLength%"></param>
141	''' <param name="alpha%"><see cref="Color.A"/>: color alpha value</param>
142	Sub New(colorLength%, alpha%)
143	ColorMapLength = colorLength
144	Me.Alpha = alpha
145	End Sub
146
147	Public ReadOnly Property ColorMaps As New Dictionary(Of String, MapsFunc) From {
148	_
149	{NameOf(Me.Autumn).ToLower, AddressOf Me.Autumn},
150	{NameOf(Me.Cool).ToLower, AddressOf Me.Cool},
151	{NameOf(Me.Gray).ToLower, AddressOf Me.Gray},
152	{NameOf(Me.Hot).ToLower, AddressOf Me.Hot},
153	{NameOf(Me.Jet).ToLower, AddressOf Me.Jet},
154	{NameOf(Me.Spring).ToLower, AddressOf Me.Spring},
155	{NameOf(Me.Summer).ToLower, AddressOf Me.Summer},
156	{NameOf(Me.Winter).ToLower, AddressOf Me.Winter}
157	}
158
159	''' <summary>
160	''' Spring
161	''' </summary>
162	Public Const PatternSpring As String = "Spring"
163	''' <summary>
164	''' Summer
165	''' </summary>
166	Public Const PatternSummer As String = "Summer"
167	''' <summary>
168	''' Autumn
169	''' </summary>
170	Public Const PatternAutumn As String = "Autumn"
171	''' <summary>
172	''' Winter
173	''' </summary>
174	Public Const PatternWinter As String = "Winter"
175	''' <summary>
176	''' Jet
177	''' </summary>
178	Public Const PatternJet As String = "Jet"
179	''' <summary>
180	''' Gray
181	''' </summary>
182	Public Const PatternGray As String = "Gray"
183	''' <summary>
184	''' Hot
185	''' </summary>
186	Public Const PatternHot As String = "Hot"
187	''' <summary>
188	''' Cool
189	''' </summary>
190	Public Const PatternCool As String = "Cool"
191
192	''' <summary>
193	''' If failure, then this function will returns <see cref="Jet"/> by default,
194	''' or nothing if parameter <paramref name="noDefault"/> is set True.
195	''' </summary>
196	''' <param name="name">大小写不敏感</param>
197	''' <returns></returns>
198	Public Function GetMaps(name As String, Optional noDefault As Boolean = False) As MapsFunc
199	Static key As New Value(Of String)
200
201	SyncLock key
202	If Not name Is Nothing AndAlso
203	ColorMaps.ContainsKey(key = name.ToLower) Then
204
205	Return ColorMaps(key)
206	Else
207	If noDefault Then
208	Return Nothing
209	Else
210	Return AddressOf Jet
211	End If
212	End If
213	End SyncLock
214	End Function
215
216	#Region "Color Patterns"
217
218	Public Function Spring() As Integer(,)
219	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
220	Dim spring__1 As Single() = New Single(ColorMapLength - 1) {}
221	For i As Integer = 0 To ColorMapLength - 1
222	spring__1(i) = 1.0F * i / (ColorMapLength - 1)
223	cmap(i, 0) = Alpha
224	cmap(i, 1) = 255
225	cmap(i, 2) = CInt(Truncate(255 * spring__1(i)))
226	cmap(i, 3) = 255 - cmap(i, 1)
227	Next
228	Return cmap
229	End Function
230
231	Public Function Summer() As Integer(,)
232	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
233	Dim summer__1 As Single() = New Single(ColorMapLength - 1) {}
234	For i As Integer = 0 To ColorMapLength - 1
235	summer__1(i) = 1.0F * i / (ColorMapLength - 1)
236	cmap(i, 0) = Alpha
237	cmap(i, 1) = CInt(Truncate(255 * summer__1(i)))
238	cmap(i, 2) = CInt(Truncate(255 * 0.5F * (1 + summer__1(i))))
239	cmap(i, 3) = CInt(Truncate(255 * 0.4F))
240	Next
241	Return cmap
242	End Function
243
244	Public Function Autumn() As Integer(,)
245	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
246	Dim autumn__1 As Single() = New Single(ColorMapLength - 1) {}
247	For i As Integer = 0 To ColorMapLength - 1
248	autumn__1(i) = 1.0F * i / (ColorMapLength - 1)
249	cmap(i, 0) = Alpha
250	cmap(i, 1) = 255
251	cmap(i, 2) = CInt(Truncate(255 * autumn__1(i)))
252	cmap(i, 3) = 0
253	Next
254	Return cmap
255	End Function
256
257	Public Function Winter() As Integer(,)
258	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
259	Dim winter__1 As Single() = New Single(ColorMapLength - 1) {}
260	For i As Integer = 0 To ColorMapLength - 1
261	winter__1(i) = 1.0F * i / (ColorMapLength - 1)
262	cmap(i, 0) = Alpha
263	cmap(i, 1) = 0
264	cmap(i, 2) = CInt(Truncate(255 * winter__1(i)))
265	cmap(i, 3) = CInt(Truncate(255 * (1.0F - 0.5F * winter__1(i))))
266	Next
267	Return cmap
268	End Function
269
270	Public Function Gray() As Integer(,)
271	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
272	Dim gray__1 As Single() = New Single(ColorMapLength - 1) {}
273	For i As Integer = 0 To ColorMapLength - 1
274	gray__1(i) = 1.0F * i / (ColorMapLength - 1)
275	cmap(i, 0) = Alpha
276	cmap(i, 1) = CInt(Truncate(255 * gray__1(i)))
277	cmap(i, 2) = CInt(Truncate(255 * gray__1(i)))
278	cmap(i, 3) = CInt(Truncate(255 * gray__1(i)))
279	Next
280	Return cmap
281	End Function
282
283	''' <summary>
284	''' *
285	''' </summary>
286	''' <returns></returns>
287	Public Function Jet() As Integer(,)
288	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
289	Dim cMatrix As Single(,) = New Single(ColorMapLength - 1, 2) {}
290	Dim n As Integer = CInt(Truncate(Ceiling(ColorMapLength / 4.0F)))
291	Dim nMod As Integer = 0
292	Dim fArray As Single() = New Single(3 * n - 2) {}
293	Dim red As Integer() = New Integer(fArray.Length - 1) {}
294	Dim green As Integer() = New Integer(fArray.Length - 1) {}
295	Dim blue As Integer() = New Integer(fArray.Length - 1) {}
296
297	If ColorMapLength Mod 4 = 1 Then
298	nMod = 1
299	End If
300
301	For i As Integer = 0 To fArray.Length - 1
302	If i < n Then
303	fArray(i) = CSng(i + 1) / n
304	ElseIf i >= n AndAlso i < 2 * n - 1 Then
305	fArray(i) = 1.0F
306	ElseIf i >= 2 * n - 1 Then
307	fArray(i) = CSng(3 * n - 1 - i) / n
308	End If
309	green(i) = CInt(Truncate(Ceiling(n / 2.0F))) - nMod + i
310	red(i) = green(i) + n
311	blue(i) = green(i) - n
312	Next
313
314	Dim nb As Integer = 0
315	For i As Integer = 0 To blue.Length - 1
316	If blue(i) > 0 Then
317	nb += 1
318	End If
319	Next
320
321	For i As Integer = 0 To ColorMapLength - 1
322	For j As Integer = 0 To red.Length - 1
323	If i = red(j) AndAlso red(j) < ColorMapLength Then
324	cMatrix(i, 0) = fArray(i - red(0))
325	End If
326	Next
327	For j As Integer = 0 To green.Length - 1
328	If i = green(j) AndAlso green(j) < ColorMapLength Then
329	cMatrix(i, 1) = fArray(i - CInt(green(0)))
330	End If
331	Next
332	For j As Integer = 0 To blue.Length - 1
333	If i = blue(j) AndAlso blue(j) >= 0 Then
334	cMatrix(i, 2) = fArray(fArray.Length - 1 - nb + i)
335	End If
336	Next
337	Next
338
339	For i As Integer = 0 To ColorMapLength - 1
340	cmap(i, 0) = Alpha
341	For j As Integer = 0 To 2
342	cmap(i, j + 1) = CInt(Truncate(cMatrix(i, j) * 255))
343	Next
344	Next
345	Return cmap
346	End Function
347
348	Public Function Hot() As Integer(,)
349	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
350	Dim n As Integer = 3 * ColorMapLength \ 8
351	Dim red As Single() = New Single(ColorMapLength - 1) {}
352	Dim green As Single() = New Single(ColorMapLength - 1) {}
353	Dim blue As Single() = New Single(ColorMapLength - 1) {}
354	For i As Integer = 0 To ColorMapLength - 1
355	If i < n Then
356	red(i) = 1.0F * (i + 1) / n
357	Else
358	red(i) = 1.0F
359	End If
360	If i < n Then
361	green(i) = 0F
362	ElseIf i >= n AndAlso i < 2 * n Then
363	green(i) = 1.0F * (i + 1 - n) / n
364	Else
365	green(i) = 1.0F
366	End If
367	If i < 2 * n Then
368	blue(i) = 0F
369	Else
370	blue(i) = 1.0F * (i + 1 - 2 * n) / (ColorMapLength - 2 * n)
371	End If
372	cmap(i, 0) = Alpha
373	cmap(i, 1) = CInt(Truncate(255 * red(i)))
374	cmap(i, 2) = CInt(Truncate(255 * green(i)))
375	cmap(i, 3) = CInt(Truncate(255 * blue(i)))
376	Next
377	Return cmap
378	End Function
379
380	Public Function Cool() As Integer(,)
381	Dim cmap As Integer(,) = New Integer(ColorMapLength - 1, 3) {}
382	Dim cool__1 As Single() = New Single(ColorMapLength - 1) {}
383	For i As Integer = 0 To ColorMapLength - 1
384	cool__1(i) = 1.0F * i / (ColorMapLength - 1)
385	cmap(i, 0) = Alpha
386	cmap(i, 1) = CInt(Truncate(255 * cool__1(i)))
387	cmap(i, 2) = CInt(Truncate(255 * (1 - cool__1(i))))
388	cmap(i, 3) = 255
389	Next
390	Return cmap
391	End Function
392	#End Region
393	End Class
394	End Namespace