;+ ; ; @file_comments ; ; @categories ; ; @param TABLE ; ; @restrictions ; ; @examples ; ; @history ; ; ; @version ; $Id$ ; ;- PRO format_colortable_hexa, table ; compile_opt idl2, strictarrsubs ; tvlct, r, g, b, /get z = strarr(256) y = strarr(256) for k=0,255 do z[k]='00'+strtrim(string(r[k], format = '(Z)'),2) for k=0,255 do y[k]=y[k]+strmid(z[k],strlen(z[k])-2,2) for k=0,255 do z[k]='00'+strtrim(string(g[k], format = '(Z)'),2) for k=0,255 do y[k]=y[k]+strmid(z[k],strlen(z[k])-2,2) for k=0,255 do z[k]='00'+strtrim(string(b[k], format = '(Z)'),2) for k=0,255 do y[k]=y[k]+strmid(z[k],strlen(z[k])-2,2) table = strlowcase(y) END ; ;+ ; ; @file_comments ; Build a bloc of colortable ; ; @categories ; ; @param TABLEOUT ; ; @restrictions ; ; @examples ; ; @history ; ; @version ; $Id$ ; ;- PRO build_table, tableout ; compile_opt idl2, strictarrsubs ; format_colortable_hexa, table tableout = strarr(25) tableout[0] = '/COLORTAB < ' FOR k = 0, 8 DO tableout[0] = tableout[0]+table[k]+' ' FOR i = 1, 22 DO BEGIN FOR k = 11*i-2, 11*i+8 DO tableout[i] = tableout[i]+table[k]+' ' ENDFOR FOR k = 251, 255 DO tableout[i] = tableout[i]+table[k]+' ' tableout[i] = tableout[i]+'> def' END ; ;+ ; ; @file_comments ; Modify colors of a postscript file ; ; @categories ; ; @param N1 {in}{required} ; Number of elements in the first dimension ; ; @param N2 {in}{required} ; Number of elements in the second dimension ; ; @param FILE ; A scalar of string type, the name of the ".pro" file to be tested ; if necessary, the input name is completed with '.pro' and its path ; found in !path ; ; @keyword PALIT1 ; ; @keyword PALIT2 ; ; @restrictions ; ; @examples ; ; @history ; G. Roullet 1999 ; ; @version ; $Id$ ; ;- PRO chcolps, n1, n2, file, PALIT1 = palit1, PALIT2 = palit2 ; compile_opt idl2, strictarrsubs ; ; recuperate palettes ; lct, n1 IF keyword_set(palit1) THEN palit, palit1 tvlct, red, green, blue, /get lct, n2 IF keyword_set(palit2) THEN palit, palit2 tvlct, red1, green1, blue1, /get ; ; ; filein = file fileout = file+'.new' openr, numin, filein, /get_lun openw, numout, fileout, /get_lun ligne = '' nl = 0 colortab = 0 ; ; Scan le fichier ; WHILE NOT(eof(numin)) DO BEGIN readf, numin, ligne, format = '(A)' nl = nl+1 ; ; Replace setrgbcolor statements ; pos = strpos(ligne, 'setrgbcolor') IF pos NE -1 THEN BEGIN r = round(float(strmid(ligne, pos-18, 6))*255) g = round(float(strmid(ligne, pos-12, 6))*255) b = round(float(strmid(ligne, pos-6, 6))*255) ind = where(r EQ red AND g EQ green AND b EQ blue) ind = ind[0] IF ind[0] NE -1 THEN BEGIN r1 = red1[ind]/255. g1 = green1[ind]/255. b1 = blue1[ind]/255. color = string(r1, g1, b1, format = '(3(F5.3,:,X))') strput, ligne, color, pos-18 ENDIF ELSE BEGIN ; ras = report('erreur ligne :' + string(nl)) dist = abs(r-red)+abs(g-green)+abs(b-blue) ind = (where(dist EQ min(dist)))[0] ind = ind[0] ; ras = report( $ ; ['I found ' + string(long([r, g, b])), $ ; 'I replace it by ' + string([red[ind], green[ind], blue[ind]])]) r1 = red1[ind]/255. g1 = green1[ind]/255. b1 = blue1[ind]/255. color = string(r1, g1, b1, format = '(3(F5.3,:,X))') strput, ligne, color, pos-18 ENDELSE ENDIF ; ; Replace COLORTAB ; pos = strpos(ligne, '/COLORTAB') IF pos NE -1 THEN BEGIN build_table, table n = 0 colortab = 1 ENDIF IF colortab THEN BEGIN ligne = table[n] n = n+1 IF n EQ 24 THEN colortab = 0 ENDIF ; ; Ecrit le fichier de sortie ; printf, numout, ligne, format = '(A)' ENDWHILE close, numin close, numout free_lun, numin free_lun, numout spawn, 'gs '+fileout END