source: trunk/SRC/ToBeReviewed/POSTSCRIPT/chcolps.pro @ 510

;+
;
; @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
;
; write output file
;
          printf, numout, ligne, format = '(A)'
    ENDWHILE
    close, numin
    close, numout
    free_lun, numin
    free_lun, numout

    spawn, 'gs '+fileout

END