Viewing contents of file '../idllib/user_contrib/creaso/showct.pro'
; Copyright(c) 1992, CreaSo Creative Software Systems GmbH. All rights reserved.
;	Unauthorized reproduction prohibited.
;+
; NAME:
;	SHOWCT
;
; PURPOSE:
;	Show (set) a colortable.
;
; CALLING SEQUENCE:
;	showct, red, green, blue
;
; INPUTS:
;       red      - Red   values of the colortable.
;       green    - Green values of the colortable.
;       blue     - Blue  values of the colortable.
;
; KEYWORDS:
;	bottom   - Stretch bottom value.
;	top      - Stretch top value.
;       gamma    - Gamma value.
;       rev      - Reverse the colortable.
;       chop     - Chop top if 1, clip if 0.
;
; OUTPUTS:
;	colors   - The rgb colors set by this procedure as a [3,n] array.
;
; COMMON BLOCKS:
;	None.
;
; SIDE EFFECTS:
;       A file is read.
;
; RESTRICTIONS:
;	Tested on VAX/VMS only.
;
; MODIFICATION HISTORY:
;	September 1992, HJB, CreaSo	Created.
;-
pro showct, red, green, blue, bottom=bottom, top=top, gamma=gamma, $
            rev=rev, colors=colors, chop=chop

   ;a: Reverse colortable if requested.

   if (keyword_set(rev)) then begin
      r = reverse(red)
      g = reverse(green)
      b = reverse(blue)
   endif else begin
      r = red
      g = green
      b = blue
   endelse

   ;a: Interpolate.

   if (!d.table_size eq 256) then tvlct, [0,255], [0,255], [0,255]
   nc = !d.table_size
   if (nc ne 256) then begin
      p = (lindgen(nc) * 255) / (nc-1)
      r = r(p)
      g = g(p)
      b = b(p)
   endif

   ;a: Stretch

   if (not keyword_set(bottom)) then bottom = 0
   if (not keyword_set(top)   ) then top    = 100
   if (not keyword_set(gamma) ) then gamma  = 1.0
   if (not keyword_set(chop)  ) then chop   = 0

   bplus = 0
   tplus = 0
   if (top eq bottom) then if (top lt 100) then tplus = 1 else bplus = -1

   low  = (bottom+bplus) * (nc-1)/100
   high = (top+tplus)    * (nc-1)/100
   if (gamma eq 1.0) then begin              ; Simple case
      slope = float(nc-1)/(high-low)         ; Scale to range of 0 : nc-1
      intercept = -slope*low
      p = long(findgen(nc)*slope+intercept)  ; subscripts to select
   endif else begin                          ; Gamma ne 0
      slope = 1. / (high-low)                ; Range of 0 to 1.
      intercept = -slope * low
      p = findgen(nc) * slope + intercept > 0.0
      p = long(nc * (p ^ gamma))
   endelse
   if (chop ne 0) then begin
      too_high = where(p ge nc, n)
      if (n gt 0) then p(too_high) = 0L
   endif
   r = r(p)
   g = g(p)
   b = b(p)
   tvlct, r, g, b

   ;a: Load return array

   colors = bytarr(3,n_elements(r))
   colors(0,*) = r
   colors(1,*) = g
   colors(2,*) = b

end