n$ setrgbl.001
$---------------------------------------------------------------
$! RUN file to define procs to set RGBLEVS by various rules
$# Run POPS PLOT
$-----------------------------------------------------------------------
$;  Copyright (C) 2006, 2012
$;  Associated Universities, Inc. Washington DC, USA.
$;
$;  This program is free software; you can redistribute it/or
$;  and/or modify it under the terms of the GNU General Public
$;  License as published by the Free Software Foundation; either
$;  version 2 of the License, or (at your option) any later
$;  version.
$;
$;  This program is distributed in the hope that it will be
$;  useful, but WITHOUT ANY WARRANTY; without even the implied
$;  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
$;  PURPOSE.  See the GNU General Public License for more
$;  details.
$;
$;  You should have received a copy of the GNU General Public
$;  License along with this program; if not, write to the Free
$;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,
$;  MA 02139, USA.
$;
$;  Correspondence concerning AIPS should be addressed as
$;  follows:
$;         Internet email: aipsmail@nrao.edu.
$;         Postal address: AIPS Project Office
$;                         National Radio Astronomy Observatory
$;                         520 Edgemont Road
$;                         Charlottesville, VA 22903-2475 USA
$-----------------------------------------------------------------------
$
PROC INITLEVS
$     yy = last negative, xx radius, jj highest lev
rgblevs=0
jj = 0;
yy = 0.
for ii=2:30; if (levs(ii) > levs(ii-1)) then;
    jj=ii; end; end
if (jj <= 0) then jj = 20; for ii = 1:10;
    levs(ii)=-11+ii; levs(10+ii)=ii; end; end
for ii=1:jj; if (levs(ii)<0) then; yy = ii; end; end
xx = max (yy, jj-yy);  xx = max (xx, 2)
$                                  check rgbgamma
for ii = 1:3
   if (rgbgam(ii) <= 0.0) then rgbgam(ii)=2.2; end; end
return; finish

PROC CIRCLEVS
initlevs
x = 2; if (docirc>0) then; x = 3; end
for ii = 1:jj
   if (ii <= yy) then; kk = yy - ii + 1;
      else kk = ii - yy; end
   tt = (kk - 1) / (xx - 1) * 90 * x
   if (tt < 90) then; rr = 0
      bb = cos(tt); gg = sin(tt)
   else; if (tt <= 180) then; bb = 0
      gg = sin(tt); rr = -cos(tt)
   else; gg = 0
      bb = -sin(tt); rr = -cos(tt)
      end; end
   rr = min (1, max (rr, 0.0))
   gg = min (1, max (gg, 0.0))
   bb = min (1, max (bb, 0.0))
   rgblevs(1,ii) = rr ** (1/rgbgam(1))
   rgblevs(2,ii) = gg ** (1/rgbgam(2))
   rgblevs(3,ii) = bb ** (1/rgbgam(3))
   end
return
finish
$
PROC RAINLEVS
initlevs
for ii = 1:jj
   if (ii <= yy) then; kk = yy - ii + 1;
      else kk = ii - yy; end
   rr = -1 + 2 * (kk - 1) / (xx - 1)
   rr = max (rr, 0.0)
   bb = 1 - 2 * (kk - 1) / (xx - 1)
   bb = max (bb, 0.0)
   gg = 1.0 - rr - bb
   gg = max (0.0, min (1.0, gg))
   rgblevs(1,ii) = rr ** (1/rgbgam(1))
   rgblevs(2,ii) = gg ** (1/rgbgam(2))
   rgblevs(3,ii) = bb ** (1/rgbgam(3))
   end
return
finish
$
PROC FLAMLEVS
initlevs
for ii = 1:jj
   if (ii <= yy) then; kk = yy - ii + 1;
      else kk = ii - yy; end
   tt = (kk - 0.8) / (xx - 0.8)
   rr = 255 / 170 * tt
   rr = max (0, min (1, rr))
   rgblevs(1,ii) = rr ** (1/rgbgam(1))
   bb = (tt - 160/266) / (1 - 160/255)
   bb = max (0, min (1, bb))
   rgblevs(3,ii) = bb ** (1/rgbgam(3))
   if (tt <= 170/255) then
      gg = (tt - 100/255)/70 * 131
   else
      gg = (tt - 170/255)/85*124 + 131/255
      end
    gg = max (0, min (1, gg))
    rgblevs(2,ii) = gg ** (1/rgbgam(1))
    end
return
finish
$
PROC STEPLEVS(X)
initlevs
x = max (5, min (10, x)); x = ceil (x-0.4999)
for ii = 1:jj
  if (ii <= yy) then; kk = yy - ii + 1
  else; kk = ii - yy; end
  bb = 0; gg = 0; rr = 0
  kk = mod (kk-1, x) + 1
  if (x <= 7) then;
    if (kk = 1) then bb = 1; end
    if (kk = 2) then bb = 1; gg = 1; end
    if (kk = 3) then gg = 1; end
    if (kk = 4) then gg = 1; rr = 1; end
    if (kk = 5) then rr = 1; end
    if (kk = 6) then rr = 1; bb = 1; end
    if (kk = 7) then rr = 1; bb = 1; gg = 1; end; end
  if (x = 8) then
    if (kk = 1) then rr=0.58; bb=0.827; end
    if (kk = 2) then bb=0.93; end
    if (kk = 3) then gg=0.88; bb=0.93; end
    if (kk = 4) then gg=0.93; end
    if (kk = 5) then rr=0.93; gg=0.93; end
    if (kk = 6) then rr=0.93; gg=0.60; end
    if (kk = 7) then rr=0.93; end
    if (kk = 8) then rr=0.47; gg=0.23; bb=0.06; end; end
  if (x = 9) then
    if (kk = 1) then rr=0.06; gg=0.06; bb=0.06; end
    if (kk = 2) then rr=0.14; bb=0.28; end
    if (kk = 3) then bb=0.50; end
    if (kk = 4) then rr=0.06; gg=0.30; bb=0.80; end
    if (kk = 5) then gg=0.23; end
    if (kk = 6) then gg=0.90; end
    if (kk = 7) then rr=1.00; gg=1.00; end
    if (kk = 8) then rr=1.00; gg=0.35; end
    if (kk = 9) then rr=1.00; end; end
  if (x = 10) then
    if (kk = 1) then rr=0.05; gg=0.05; bb=0.05; end
    if (kk = 2) then rr=0.10; gg=0.50; bb=0.80; end
    if (kk = 3) then bb=1.00; end
    if (kk = 4) then gg=0.35; end
    if (kk = 5) then rr=1.00; end
    if (kk = 6) then rr=1.00; gg=0.35; end
    if (kk = 7) then rr=1.00; gg=1.00; end
    if (kk = 8) then gg=0.70; end
    if (kk = 9) then rr=0.40; bb=0.40; end
    if (kk = 10) then rr=1; gg=1; bb=1; end; end
  if (x > 8) then; rgblevs(1,ii) = rr ** (1/rgbgam(1))
    rgblevs(2,ii) = gg ** (1/rgbgam(2))
    rgblevs(3,ii) = bb ** (1/rgbgam(3))
  else;  rgblevs(1,ii) = rr
    rgblevs(2,ii) = gg
    rgblevs(3,ii) = bb; end
  end
return
finish
$