1% Copyright (C) 2012-2017,2018 John E. Davis
2%
3% This file is part of the S-Lang Library and may be distributed under the
4% terms of the GNU General Public License.  See the file COPYING for
5% more information.
6%---------------------------------------------------------------------------
7autoload ("glob", "glob");
8import ("png");
9
10% Colormap functions
11
12private define linear_range (a, b, xa, xb)
13{
14   return typecast (xa + ([0:b-a] * (xb-xa)/double(b-a)), UChar_Type);
15}
16
17private define build_colormap_channel (ranges)
18{
19   variable r = UChar_Type[256];
20   variable i = 0;
21   loop (length(ranges)/4)
22     {
23	variable a = ranges[i];
24	variable b = ranges[i+1];
25	variable xa = ranges[i+2];
26	variable xb = ranges[i+3];
27	r[[a:b]] = linear_range (a, b, xa, xb);
28	i += 4;
29     }
30   return r;
31}
32
33define png_build_colormap (r_ranges, g_ranges, b_ranges)
34{
35   return ((build_colormap_channel (r_ranges) shl 16)
36	   + (build_colormap_channel (g_ranges) shl 8)
37	   + (build_colormap_channel (b_ranges)));
38}
39
40private variable Color_Maps = Assoc_Type[Array_Type];
41private variable Color_Map_Dir = path_concat (path_dirname (__FILE__), "cmaps");
42private variable Png_Namespace = current_namespace ();
43
44define png_add_colormap (name, map)
45{
46   Color_Maps[name] = map;
47}
48
49define png_get_colormap (name)
50{
51   if (assoc_key_exists (Color_Maps, name))
52     return Color_Maps[name];
53
54   variable mapfile = strcat (name, ".map");
55   variable file = path_concat (Color_Map_Dir, mapfile);
56   if (stat_file (file) == NULL)
57     throw OpenError, "Unable to load colormap $mapfile"$;
58
59   () = evalfile (file, Png_Namespace);
60
61   if (assoc_key_exists (Color_Maps, name))
62     return Color_Maps[name];
63
64   throw DataError, "$file does not contain the $name color map"$;
65}
66
67define png_get_colormap_names ()
68{
69   variable maps = glob (path_concat (Color_Map_Dir, "*.map"));
70   maps = array_map (String_Type, &path_basename_sans_extname, maps);
71   variable n = length (maps);
72   variable idx = Char_Type[n];
73   _for (0, n-1, 1)
74     {
75	variable i = ();
76	!if (assoc_key_exists (Color_Maps, maps[i]))
77	  idx[i] = 1;
78     }
79   return [maps[where(idx)], assoc_get_keys (Color_Maps)];
80
81}
82
83define png_rgb_to_gray (rgb)
84{
85   variable gray = ((rgb&0xFF) + ((rgb&0xFF00)shr 8) + ((rgb&0xFF0000)shr 16));
86   return typecast ((__tmp(gray)/3.0), UChar_Type);
87}
88
89private define normalize_gray (gray, nlevels)
90{
91   variable g0 = qualifier ("gmin");
92   variable g1 = qualifier ("gmax");
93
94   if ((typeof (gray) == UChar_Type) && (nlevels == 256)
95       && (g0 == NULL) && (g1 == NULL))
96     return gray;
97
98   variable is_bad = isnan(gray) or isinf(gray);
99   variable any_is_bad = any(is_bad);
100   if (any_is_bad)
101     {
102	variable good_gray = gray [where(is_bad == 0)];
103	if (g0 == NULL) g0 = min (good_gray);
104	if (g1 == NULL) g1 = max (good_gray);
105     }
106   else
107     {
108	if (g0 == NULL) g0 = min(gray);
109	if (g1 == NULL) g1 = max(gray);
110     }
111   if (g0 > g1) (g0, g1) = (g1, g0);
112
113   if (g0 != g1)
114     {
115	variable factor = nlevels/double(g1-g0);
116	gray = typecast ((gray-g0)*factor, Int_Type);
117	gray[where (gray<0)] = 0;
118	gray[where (gray>=nlevels)] = (nlevels-1);
119     }
120   else
121     gray = typecast (gray * 0 + 127, Int_Type);
122
123   variable bad_level = 0;
124   if (any_is_bad)
125     gray[where(is_bad)] = bad_level;
126
127   return gray;
128}
129
130private define gray_to_rgb_with_cmap (gray, cmap)
131{
132   if (typeof (cmap) == String_Type)
133     cmap = png_get_colormap (cmap);
134
135   gray = normalize_gray (gray, length(cmap);;__qualifiers());
136   return cmap[gray];
137}
138
139define png_gray_to_rgb ()
140{
141   variable gray;
142   if (_NARGS == 2)
143     return gray_to_rgb_with_cmap (;;__qualifiers ());
144
145   gray = ();
146   gray = normalize_gray (gray, 256;;__qualifiers ());
147   return gray + (gray shl 8) + (gray shl 16);
148}
149
150define png_rgb_get_r (rgb)
151{
152   return typecast ((rgb shr 16) & 0xFF, UChar_Type);
153}
154define png_rgb_get_g (rgb)
155{
156   return typecast ((rgb shr 8) & 0xFF, UChar_Type);
157}
158define png_rgb_get_b (rgb)
159{
160   return typecast (rgb & 0xFF, UChar_Type);
161}
162
163$1 = path_concat (path_dirname (__FILE__), "help/pngfuns.hlp");
164if (NULL != stat_file ($1))
165  add_doc_file ($1);
166
167provide("png");
168