include include include include define NONE 0 define RED 1 define GREEN 2 define BLUE 3 define NUM_COLOR 256 define MIN_INDEX 1 define MAX_INDEX 200 define MIN_INTEN 0 define MAX_INTEN 255 define LOW_VERB 1 define MED_VERB 2 define HIGH_VERB 3 procedure t_scmapc () # t_scmapc -- Parse colormap table as written by SAOimage. Produces a # colormap image suitable as input to vdisplay.celco. Optionally write # the colormap as integer triples to STDOUT. # Based on SAOimage C code, see copyright notice included # Z. G. Levay 28 January 1992 # 4/6/93 Rewrote inttab. All known flavors of SAOimage color maps # seem to work correctly now. # * Copyright: 1989 Smithsonian Astrophysical Observatory # * You may do anything you like with this file except remove # * this copyright. The Smithsonian Astrophysical Observatory # * makes no representations about the suitability of this # * software for any purpose. It is provided "as is" without # * express or implied warranty. .help 0 = sunview background color (normally white) 1-200 = frame buffer data values, windowed 201 = cursor color (white) 202 = black 0 0 0 203 = white 255 255 255 204 = red 255 0 0 205 = green 0 255 0 206 = blue 0 0 255 207 = yellow 255 255 0 208 = cyan 0 255 255 209 = magenta 255 0 255 210 = coral 255 114 86 211 = maroon 255 52 179 212 = orange 255 165 0 213 = khaki 255 246 143 214 = orchid 255 131 250 215 = turquoise 64 224 208 216 = violet 238 130 238 217 = wheat 255 231 186 218-254 = reserved for use by other windows 255 = black (sunview foreground color) .endhelp pointer sp pointer saocmap pointer cmapimg pointer line, word int ip, jp int nch int scm bool pscf real value int color real rgamma, ggamma, bgamma int tok bool index pointer inds, ints int id pointer cmap[3] int cm int debug bool fullr int ci1, ci2 int open() getline(), ctowrd(), fscan(), ctotok(), clgeti(), immap() bool streq(), clgetb() real ctor(), ggamav() pointer impl2r() long clktime() begin call smark (sp) call salloc (saocmap, SZ_FNAME, TY_CHAR) call salloc (cmapimg, SZ_FNAME, TY_CHAR) call salloc (line, SZ_LINE, TY_CHAR) call salloc (word, SZ_LINE, TY_CHAR) call malloc (inds, NUM_COLOR, TY_REAL) call malloc (ints, NUM_COLOR, TY_REAL) call clgstr ("saocmap", Memc[saocmap], SZ_FNAME) if (streq (Memc[saocmap], "STDIN")) scm = STDIN else scm = open (Memc[saocmap], READ_ONLY, TEXT_FILE) call clgstr ("cmapimg", Memc[cmapimg], SZ_FNAME) debug = clgeti ("debug") # Map the colormap image cm = immap (Memc[cmapimg], NEW_FILE, 0) # Header stuff IM_NDIM(cm) = 2 IM_LEN(cm,1) = NUM_COLOR IM_LEN(cm,2) = 3 IM_PIXTYPE(cm) = TY_REAL # Each color cmap[RED] = impl2r (cm,1) cmap[GREEN] = impl2r (cm,2) cmap[BLUE] = impl2r (cm,3) pscf = false color = NONE nch = 0 index = true # Initialize color map to zero call amovkr (0.0, Memr[cmap[RED]], NUM_COLOR) call amovkr (0.0, Memr[cmap[GREEN]], NUM_COLOR) call amovkr (0.0, Memr[cmap[BLUE]], NUM_COLOR) while (fscan (scm) != EOF) { # For each line call gargwrd (Memc[word], SZ_LINE) if (debug > MED_VERB) { call printf ("Word A: %s\n") call pargstr (Memc[word]) } if (streq (Memc[word], "PSEUDOCOLOR")) { pscf = true break } } if (!pscf) { call close (scm) call error (0, "PSEUDOCOLOR keyword not found") } fullr = clgetb ("fullrange") if (fullr) { # Use the full range of the color map (0:255) ci1 = MIN_INTEN ci2 = MAX_INTEN } else { # Use the limited (DSI) range of the color map (1:200) ci1 = MIN_INDEX ci2 = MAX_INDEX } while (getline (scm, Memc[line]) != EOF) { # Scan lines for Color keyword, RED, GREEN, or BLUE ip = 1 nch = ctowrd (Memc[line], ip, Memc[word], SZ_LINE) if (debug > MED_VERB) { call printf ("Word B: %s\n") call pargstr (Memc[word]) } if (streq (Memc[word], "RED:")) { color = RED rgamma = ggamav (Memc[line], ip, debug) id = 0 } else if (streq (Memc[word], "GREEN:")) { call inttab (Memr[inds], Memr[ints], id, Memr[cmap[color]], NUM_COLOR, ci1, ci2, rgamma, debug) color = GREEN ggamma = ggamav (Memc[line], ip, debug) id = 0 } else if (streq (Memc[word], "BLUE:")) { call inttab (Memr[inds], Memr[ints], id, Memr[cmap[color]], NUM_COLOR, ci1, ci2, ggamma, debug) color = BLUE bgamma = ggamav (Memc[line], ip, debug) id = 0 } else if (Memc[word] == '\#') next else { # Working on a color ip = 1 repeat { # To end of line tok = ctotok (Memc[line], ip, Memc[word], SZ_LINE) if (debug > MED_VERB) { call printf ("Token: %s %d %d\n") call pargstr (Memc[word]) call pargi (nch) call pargi (ip) } if (tok == TOK_NUMBER) { jp = 1 nch = ctor (Memc[word], jp, value) if (index) { # An index value id = id + 1 call fillim (Memr[inds], id, value) index = false } else { # An intensity value call fillim (Memr[ints], id, value) index = true } if (debug > LOW_VERB) { call printf ("Value: %f %d %d\n") call pargr (value) call pargi (nch) call pargi (ip) } } } until (tok == TOK_NEWLINE) } } # Fill the last (Blue) color map line call inttab (Memr[inds], Memr[ints], id, Memr[cmap[color]], NUM_COLOR, ci1, ci2, bgamma, debug) if (!fullr) # Force "standard" graphics colors (201:217) # to make imd graphics correct call grfcolor (Memr[cmap[RED]], Memr[cmap[GREEN]], Memr[cmap[BLUE]], NUM_COLOR, rgamma, ggamma, bgamma) if (clgetb ("listmap")) # List the colormap values on STDOUT call listcm (Memr[cmap[RED]], Memr[cmap[GREEN]], Memr[cmap[BLUE]], NUM_COLOR) # Update the header IM_LIMTIME(cm) = clktime (long (0)) # Force the data range 0:1 call imputr (cm, "i_minpixval", 0.0) call imputr (cm, "i_maxpixval", 1.0) call imaddr (cm, "datamin", 0.0) call imaddr (cm, "datamax", 1.0) IM_MIN(cm) = 0.0 IM_MAX(cm) = 1.0 # Close the colormap image call imunmap (cm) call mfree (inds, TY_REAL) call mfree (ints, TY_REAL) call close (scm) end real procedure ggamav (line, ip, debug) char line[ARB] int ip int debug int nch real gamma char word[SZ_LINE] int ctowrd() real ctor() bool streq() begin nch = ctowrd (line, ip, word, SZ_LINE) gamma = 1.0 if (streq (word, "gamma")) { nch = ctor (line, ip, gamma) if (debug > LOW_VERB) { call printf ("gamma: %d %d %f\n") call pargi (ip) call pargi (nch) call pargr (gamma) } } return (gamma) end procedure fillim (vec, id, val) real vec[ARB] int id real val begin vec[id] = val end procedure inttab (inds, ints, nnode, cmap, cmapsize, ci1, ci2, gamma, debug) real inds[ARB] real ints[ARB] int nnode real cmap[ARB] int cmapsize int ci1, ci2 real gamma int debug real x, x1, x2, dx real y, y1, y2, dy int i, i1, i2 real sl, b int node real di begin i1 = ci1 i2 = ci2 di = real (i2 - i1) node = 1 x1 = inds[node] x2 = inds[node+1] dx = x2 - x1 y1 = ints[node] y2 = ints[node+1] dy = y2 - y1 sl = dy / dx b = y1 - sl * x1 if (debug > LOW_VERB) { call printf ("Node %d\n") call pargi (node) call printf ("X: %f %f %f\n") call pargr (x1) call pargr (x2) call pargr (dx) call printf ("Y: %f %f %f\n") call pargr (y1) call pargr (y2) call pargr (dy) call printf ("Slope %f Intercept %f\n") call pargr (sl) call pargr (b) } do i = i1, i2 { x = real (i - i1) / di if (x <= x1) y = y1 else if (x > x2) { if ((node + 1) == nnode) y = y2 else { node = node + 1 x1 = inds[node] x2 = inds[node+1] dx = x2 - x1 y1 = ints[node] y2 = ints[node+1] dy = y2 - y1 sl = dy / dx b = y1 - sl * x1 if (debug > LOW_VERB) { call printf ("Node %d\n") call pargi (node) call printf ("X: %f %f %f\n") call pargr (x1) call pargr (x2) call pargr (dx) call printf ("Y: %f %f %f\n") call pargr (y1) call pargr (y2) call pargr (dy) call printf ("Slope %f Intercept %f\n") call pargr (sl) call pargr (b) } y = x * sl + b } } else { y = x * sl + b } y = min (max (y, 0.0), 1.0) y = y ** (1.0 / gamma) cmap[i+1] = y if (debug >= LOW_VERB) { call printf ("%d x: %f; y: %f\n") call pargi (i) call pargr (x) call pargr (y) call flush (STDOUT) } } end procedure listcm (red, green, blue, cmsiz) real red[ARB], green[ARB], blue[ARB] int cmsiz int i begin do i = 1, cmsiz { call printf ("%4d%5d%5d%5d\n") call pargi (i) call pargi (int (red[i] * real (MAX_INTEN))) call pargi (int (green[i] * real (MAX_INTEN))) call pargi (int (blue[i] * real (MAX_INTEN))) } end procedure grfcolor (red, green, blue, ncol, rgamma, ggamma, bgamma) real red[ARB], green[ARB], blue[ARB] int ncol real rgamma, ggamma, bgamma begin # 0 = sunview background color (normally white) red[1] = 1.0 green[1] = 1.0 blue[1] = 1.0 # 201 = cursor color (white) red[202] = 1.0 green[202] = 1.0 blue[202] = 1.0 # 202 = black 0 0 0 red[203] = 0.0 green[203] = 0.0 blue[203] = 0.0 # 203 = white 255 255 255 red[204] = 1.0 green[204] = 1.0 blue[204] = 1.0 # 204 = red 255 0 0 red[205] = 1.0 green[205] = 0.0 blue[205] = 0.0 # 205 = green 0 255 0 red[206] = 0.0 green[206] = 1.0 blue[206] = 0.0 # 206 = blue 0 0 255 red[207] = 0.0 green[207] = 0.0 blue[207] = 1.0 # 207 = yellow 255 255 0 red[208] = 1.0 green[208] = 1.0 blue[208] = 0.0 # 208 = cyan 0 255 255 red[209] = 0.0 green[209] = 1.0 blue[209] = 1.0 # 209 = magenta 255 0 255 red[210] = 1.0 green[210] = 0.0 blue[210] = 1.0 # 210 = coral 255 114 86 red[211] = 1.0 green[211] = 0.447 ** (1.0 / ggamma) blue[211] = 0.337 ** (1.0 / bgamma) # 211 = maroon 255 52 179 red[212] = 1.0 green[212] = 0.204 ** (1.0 / ggamma) blue[212] = 0.702 ** (1.0 / bgamma) # 212 = orange 255 165 0 red[213] = 1.0 green[213] = 0.647 ** (1.0 / ggamma) blue[213] = 0.0 # 213 = khaki 255 246 143 red[214] = 1.0 green[214] = 0.965 ** (1.0 / ggamma) blue[214] = 0.561 ** (1.0 / bgamma) # 214 = orchid 255 131 250 red[215] = 1.0 green[215] = 0.514 ** (1.0 / ggamma) blue[215] = 0.980 ** (1.0 / bgamma) # 215 = turquoise 64 224 208 red[216] = 0.251 ** (1.0 / rgamma) green[216] = 0.878 ** (1.0 / ggamma) blue[216] = 0.816 ** (1.0 / bgamma) # 216 = violet 238 130 238 red[217] = 0.933 ** (1.0 / rgamma) green[217] = 0.510 ** (1.0 / ggamma) blue[217] = 0.933 ** (1.0 / bgamma) # 217 = wheat 255 231 186 red[218] = 1.0 green[218] = 0.906 ** (1.0 / ggamma) blue[218] = 0.729 ** (1.0 / bgamma) #218-254 = reserved for use by other windows # 255 = black (sunview foreground color) red[256] = 0.0 green[256] = 0.0 blue[256] = 0.0 end