C
C Program PALLET to interpolate colour tables. C C Version: 5.30 C Date: 1999, February 26 C C Coded by: Ludek Klimes C Department of Geophysics, Charles University Prague, C Ke Karlovu 3, 121 16 Praha 2, Czech Republic, C E-mail: klimes@seis.karlov.mff.cuni.cz C C....................................................................... C C This Fortran77 file consists of the following external procedures: C PALLET..Main program to interpolate colour tables. C PALLET C RGBHSV..Subroutine to convert the RGB colour representation into C the HSV colour representation. C RGBHSV C HSVRGB..Subroutine to convert the HSV colour representation into C the RGB colour representation. C HSVRGB C C No other external procedures required. C C....................................................................... C C C Description of the data files: C C The data are read in by the list directed input (free format). C In the description of data files, each numbered paragraph indicates C the beginning of a new input operation (new READ statement). C If the symbolic name of the input variable is enclosed in apostrophes, C the corresponding value in input data is of the type CHARACTER, i.e. C it should be a character string enclosed in apostrophes. If the first C letter of the symbolic name is I-N, the corresponding value is of the C type INTEGER. Otherwise, the input parameter is of the type REAL and C may or may not contain a decimal point. C C Input data read from the * external unit: C The interactive * external unit may also be redirected to the file C containing the relevant data. C (1) 'FILE1','FILE2',FACTOR,/ C 'FILE1'... String with the name of the input data file containing C the table assigning RGB colours to several integers. C 'FILE2'... String with the name of the output data file containing C the table assigning RGB colours to all integers within the C range corresponding to the input. C FACTOR..Brightness factor. Intensities of the input RGB colours C are multiplied by FACTOR. C Default: FACTOR=1. C C C Input file 'FILE1' and output file 'FILE2' with the RGB colour tables: C Each line contains four numbers: C K,R,G,B C K... Index of the colour. Non-negative integer. C R... Content of the red colour. Real between 0 and 1. C G... Content of the green colour. Real between 0 and 1. C B... Content of the blue colour. Real between 0 and 1. C C======================================================================= C C C C Filenames: CHARACTER*80 FILE1,FILE2 C INTEGER K1,K2,K REAL FACTOR,A1,H1,S1,V1,A2,H2,S2,V2,R2,G2,B2,H,S,V,R,G,B C C....................................................................... C FACTOR=1. WRITE(*,'(2A)') ' Enter input and output colour-table filenames,', * ' and brightness factor: ' READ(*,*) FILE1,FILE2,FACTOR C OPEN(1,FILE=FILE1,STATUS='OLD') OPEN(2,FILE=FILE2) READ(1,*,END=90) K2,R2,G2,B2 IF(K2.EQ.0) THEN WRITE(2,'(I3,3F5.2)') K2,R2,G2,B2 ELSE WRITE(2,'(I3,3F5.2)') K2,R2*FACTOR,G2*FACTOR,B2*FACTOR END IF CALL RGBHSV(R2,G2,B2,H2,S2,V2) 10 CONTINUE K1=K2 H1=H2 S1=S2 V1=V2 READ(1,*,END=90) K2,R2,G2,B2 CALL RGBHSV(R2,G2,B2,H2,S2,V2) DO 20 K=K1+1,K2 A2=FLOAT(K-K1)/FLOAT(K2-K1) A1=1.-A2 H=H1*A1+H2*A2 S=S1*A1+S2*A2 V=V1*A1+V2*A2 IF(ABS(H1-H2).GT.0.5) THEN IF(H1+H2.LT.1.) THEN IF(H1.LT.H2) THEN H=H+A1 ELSE H=H+A2 END IF ELSE IF(H1.GE.H2) THEN H=H-A1 ELSE H=H-A2 END IF END IF END IF S=S*FACTOR V=V*FACTOR CALL HSVRGB(H,S,V,R,G,B) WRITE(2,'(I3,3F5.2)') K,R,G,B 20 CONTINUE GO TO 10 C 90 CONTINUE CLOSE(1) CLOSE(2) STOP END C C======================================================================= C C C SUBROUTINE RGBHSV(R,G,B,H,S,V) REAL R,G,B,H,S,V C C Subroutine to convert the RGB colour representation into the HSV C colour representation. C C Input: C R... Red. C G... Green. C B... Blue. C C Output: C H... Hue: red=0., green=1/3, blue=2/3. C S... Saturation or chroma: saturation*value=chroma=pure colour. C V... Value = pure colour + white. C C No subroutines and external functions referred. C C Date: 1999, February 26 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C * REAL PI * PARAMETER (PI=3.141593) C C....................................................................... C H=0. IF(R.GE.G.AND.R.GE.B) THEN V=R IF(B.GE.G) THEN S=(V-G) IF(S.GT.0.) THEN * H=11./12.-ASIN((B-G)/S-0.5)/2./PI H=(6.-(B-G)/S)/6. END IF ELSE S=(V-B) IF(S.GT.0.) THEN * H= 1./12.+ASIN((G-B)/S-0.5)/2./PI H=(0.+(G-B)/S)/6. END IF END IF ELSE IF(G.GE.B) THEN V=G IF(R.GE.B) THEN S=(V-B) IF(S.GT.0.) THEN * H= 3./12.-ASIN((R-B)/S-0.5)/2./PI H=(2.-(R-B)/S)/6. END IF ELSE S=(V-R) IF(S.GT.0.) THEN * H= 5./12.+ASIN((B-R)/S-0.5)/2./PI H=(2.+(B-R)/S)/6. END IF END IF ELSE V=B IF(G.GE.R) THEN S=(V-R) IF(S.GT.0.) THEN * H= 7./12.-ASIN((G-R)/S-0.5)/2./PI H=(4.-(G-R)/S)/6. END IF ELSE S=(V-G) IF(S.GT.0.) THEN * H= 9./12.+ASIN((R-G)/S-0.5)/2./PI H=(4.+(R-G)/S)/6. END IF END IF END IF IF(H.LT.0.) THEN H=H+1. END IF IF(H.GT.1.) THEN H=H-1. END IF C If V is saturation (comment if V is chroma): * IF(V.GT.0.) THEN * S=S/V * END IF C RETURN END C C======================================================================= C C C SUBROUTINE HSVRGB(H,S,V,R,G,B) REAL H,S,V,R,G,B C C Subroutine to convert the HSV colour representation into the RGB C colour representation. C C Input: C H... Hue: red=0., green=1/3, blue=2/3. C S... Saturation or chroma: saturation*value=chroma=pure colour. C V... Value = pure colour + white. C C Output: C R... Red. C G... Green. C B... Blue. C C No subroutines and external functions referred. C C Date: 1999, February 26 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C * REAL PI * PARAMETER (PI=3.141593) C C....................................................................... C R=0. G=0. B=0. IF(H.LE.1./6.) THEN R=1. IF(H.LE.0.) THEN * B=-SIN(2.*PI*(H+1./12.))+0.5 B=-6.*H ELSE * G= SIN(2.*PI*(H-1./12.))+0.5 G= 6.*H END IF ELSE IF(H.LE.3./6.) THEN G=1. IF(H.LE.2./6.) THEN * R=-SIN(2.*PI*(H-3./12.))+0.5 R=-6.*H+2. ELSE * B= SIN(2.*PI*(H-5./12.))+0.5 B= 6.*H-2. END IF ELSE IF(H.LE.5./6.) THEN B=1. IF(H.LE.4./6.) THEN * G=-SIN(2.*PI*(H-7./12.))+0.5 G=-6.*H+4. ELSE * R= SIN(2.*PI*(H-9./12.))+0.5 R= 6.*H-4. END IF ELSE R=1. IF(H.LE.1.) THEN * B=-SIN(2.*PI*(H-11./12.))+0.5 B=-6.*H+6. ELSE * G= SIN(2.*PI*(H-13./12.))+0.5 G= 6.*H-6. END IF END IF C If V is saturation: * R=V*(1.-S*(1.-R)) * G=V*(1.-S*(1.-G)) * B=V*(1.-S*(1.-B)) C If V is chroma: R=V-S*(1.-R) G=V-S*(1.-G) B=V-S*(1.-B) C IF(R.LT.0.) THEN C PALLET-01 CALL ERROR('PALLET-01: Red colour component negative') END IF IF(R.GT.1.) THEN C PALLET-02 CALL ERROR('PALLET-02: Red colour component greater than 1') END IF IF(G.LT.0.) THEN C PALLET-03 CALL ERROR('PALLET-03: Green colour component negative') END IF IF(G.GT.1.) THEN C PALLET-04 CALL ERROR('PALLET-04: Green colour component greater than 1') END IF IF(B.LT.0.) THEN C PALLET-05 CALL ERROR('PALLET-05: Blue colour component negative') END IF IF(B.GT.1.) THEN C PALLET-06 CALL ERROR('PALLET-06: Blue colour component greater than 1') END IF C RETURN END C C======================================================================= C INCLUDE 'error.for' C error.for C C======================================================================= C