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

PRO format_colortable_hexa, table

    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


PRO build_table, tableout
;
; Fabrique le bloc de colortable
;

    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



PRO chcolps, n1, n2, file, PALIT1 = palit1, PALIT2 = palit2
;;
;; Modifie les couleurs d''un fichier postscript
;;
;; Creation : G. Roullet 1999
;;
;
; recupere les 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
;                      print, 'erreur ligne :', nl
                      dist = abs(r-red)+abs(g-green)+abs(b-blue)
                      ind = (where(dist EQ min(dist)))[0]
                      ind = ind[0]
;                      print, 'je trouve            ', long([r, g, b])
;                      print, 'je remplace par ', [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 sorti
;
          printf, numout, ligne, format = '(A)'
    ENDWHILE 
    close, numin
    close, numout
    free_lun, numin
    free_lun, numout

    spawn, 'gs '+fileout

END