pro setkolor,colors,icols,ocols,rgbfil=rgbfil,oldr=oldr,oldg=oldg,oldb=oldb,$
_ref_extra=ex
;+
;procedure setkolor
; loads specified colors into color table in specified indices
; (this used to be called "setcolor" but the name was changed to
; avoid a clash with JHUAPL's procedure of the same name)
;
;syntax
; setkolor,colors,icols,ocols,rgbfil=rgbfil,oldr=oldr,oldg=oldg,oldb=oldb
;
;parameters
; colors [INPUT; required] string array containing the names
; of the colors to be loaded
; icols [INPUT] integer array specifying into which index
; each color goes to
; * if size does not match COLORS, ignored
; * default is to go from 0:255
; ocols [OUTPUT] byte array of size [3,N(COLORS)] containing
; the hexadecimal values determined for each COLORS, as an
; rgb triplet
;
;keywords
; rgbfil [INPUT] name of file containing (r,g,b) color values
; and corresponding names in same format as:-
; * the default, /usr/lib/X11/rgb.txt
; * note: some new linux systems don't seem to have this file.
; those users can copy over this file from another system, or
; use the copy provided in !ARDB+'/rgb.txt'
; oldr [OUTPUT] the old R colors
; oldg [OUTPUT] the old G colors
; oldb [OUTPUT] the old B colors
; * NOTE: to undo the setting, just do
; TVLCT,OLDR,OLDG,OLDB
; _ref_extra [JUNK] here only to prevent crashing the program
;
;example
; plot,findgen(10)/10.,color=1 & setkolor,'green',1
; oplot,sin(findgen(10.)),color=2 & setkolor,'#ff0000',2
;
;restrictions
; * requires subroutine NARY2DEC
; * RGBFIL bit works only on UNIX
; * messes with the current color table
; * feature, not a bug: if !D.N_COLORS < 256, and a SETKOLOR
; command is issued before a plot window is opened, a color
; table is loaded in which gets lopped off at !D.N_COLORS,
; and all subsequent plots appear dim.
;
;history
; vinay kashyap (99Jul)
; bug correction for ICOLS=!D.N_COLORS
; STRMID must have 3 args for back-compatibility (VK FebMMI/A.Maggio)
; changed name from SETCOLOR to SETKOLOR (VK FebMMI)
; added optional output OCOLS and check for UNIX (VK; Jun02)
; added checks to find rgb.txt in !ARDB if, as in some linux
; distributions, /usr/lib/X11/rgb.txt doesn't exist (VK; Mar07)
; bug correction: local copy was trying to override RGBFIL (JJD; May08)
; added switch to choose file_search() instead of findfile()
; for IDL 7+ (JJD/VK; Apr14)
;-
forward_function findfile,file_search
; usage
ncol=n_elements(colors)
if ncol eq 0 then begin
print,'Usage: setkolor,colors,icols,ocols,rgbfil=rgbfil,$'
print,' oldr=oldr,oldg=oldg,oldb=oldb'
print,' loads specified colors into color table'
print,' [see also: PEASECOLR]
return
endif
; check inputs
nic=n_elements(icols) & jcols=lindgen(ncol)+1
if not keyword_set(rgbfil) then rgbfil='/usr/lib/X11/rgb.txt'
; should we use findfile or file_search?
idlversion=float(strmid(!version.release,0,1))
; does RGBFIL exist? if not, look in !ARDB
if idlversion le 6 then fil=findfile(rgbfil,count=nfil) else $
fil=file_search(rgbfil,count=nfil)
if nfil eq 0 then begin
zTOPDIR='/data/fubar/SCAR/'
ivar=0 & defsysv,'!TOPDIR',exists=ivar ;if !TOPDIR exists
if ivar ne 0 then setsysval,'TOPDIR',zTOPDIR,/getval else begin
tmp=routine_info('SETKOLOR',/source) & scardir=tmp.PATH
jvar=strpos(scardir,'pro/misc/setkolor.pro') ;we know where SETKOLOR is
if jvar[0] lt 0 then $
jvar=strpos(scardir,'pro/util/setkolor.pro') ;we DO know where it is too
zTOPDIR=strmid(scardir,0,jvar-1)
endelse
rgbfil=filepath('rgb.txt',root_dir=zTOPDIR,subdirectory='ardb')
endif
; initialize color table
tvlct,rr,gg,bb,/get & mcol=n_elements(rr)
; optional outputs
oldr=rr & oldg=gg & oldb=bb
ocols=bytarr(3,ncol)
; stupid user tricks
szc=size(colors) & nszc=n_elements(szc)
if szc(nszc-2) ne 7 then begin
message,'returning: input colors must be strings',/info & return
endif
if nic gt 0 and nic ne ncol then message,$
'mismatch: ignoring color indices',/info else $
if nic gt 0 then jcols=icols
if ncol ge mcol then begin
message,'too many colors; ignoring past '+strtrim(mcol,2),/info
cols=colors(0:mcol-1L)
jcols=jcols(0:mcol-1L)
ncol=mcol
endif else cols=colors
; translate each color into RGB components using RGBFIL if needed
rc=rr & gc=gg & bc=bb
for i=1L,ncol do begin ;{for each color
cc=strlowcase(strtrim(cols(i-1L),2)) & ii=jcols(i-1L)
if ii ge mcol then begin
message,'Color '+strtrim(ii,2)+' currently unavailable (max:'+$
strtrim(mcol-1L,2)+')',/info
goto,nextcol ;{yeah, a goto
endif
c1=strmid(cc,0,1)
if c1 eq '#' then begin ;(decode color from hex
lcol=strlen(cc)-1
case lcol of
3: begin ;{of the form #rgb
cr0=strmid(cc,1,1) & cg0=strmid(cc,2,1) & cb0=strmid(cc,3,1)
nary2dec,cr0,r0,/hex & nary2dec,cg0,g0,/hex & nary2dec,cb0,b0,/hex
rc(ii)=r0*17 & gc(ii)=g0*17 & bc(ii)=b0*17
end ;#rgb}
6: begin ;{of the form #rrggbb
cr0=strmid(cc,1,2) & cg0=strmid(cc,3,2) & cb0=strmid(cc,5,2)
nary2dec,cr0,r0,/hex & nary2dec,cg0,g0,/hex & nary2dec,cb0,b0,/hex
rc(ii)=r0 & gc(ii)=g0 & bc(ii)=b0
end ;#rrggbb}
else: message,'cannot understand color: '+cc,/info ;do nothing
endcase
endif else begin ;)(decode color from RGBFIL
if !version.OS_FAMILY eq 'unix' then begin ;(only on UNIX
cmd='grep -i "'+cc+'" '+rgbfil
spawn,cmd,cmtch & nmtch=n_elements(cmtch)
if not keyword_set(cmtch) then nmtch=0
case nmtch of
0: message,'no matches found for color: '+cc,/info ;do nothing
else: begin
k=0L & norm0=total(fix(byte(cc))) & dnorm=norm0
for j=0L,nmtch-1L do begin
c1=strtrim(strlowcase(strmid(cmtch(j),11,strlen(cmtch(j))-11)),2)
norm=total(fix(byte(c1)))
if abs(norm-norm0) lt dnorm then begin
k=j & dnorm=abs(norm-norm0)
endif
endfor
message,'choosing color: '+cmtch(k),/info
rc(ii)=long(strmid(cmtch(k),0,3))
gc(ii)=long(strmid(cmtch(k),4,3))
bc(ii)=long(strmid(cmtch(k),8,3))
end
endcase
endif else begin ;UNIX)(not UNIX
message,'cannot decode color name on non-UNIX platform',/info
endelse ;not UNIX)
endelse ;decode color)
message,'setting COL='+strtrim(ii,2)+' to ['+$
strtrim(long(rc(ii)),2)+','+$
strtrim(long(gc(ii)),2)+','+$
strtrim(long(bc(ii)),2)+']',/info
ocols[0,i-1]=rc[ii] & ocols[1,i-1]=gc[ii] & ocols[2,i-1]=bc[ii]
nextcol: ;the goto came here}
endfor ;I=1,NCOL}
; load new colors
tvlct,rc,gc,bc
return
end