libCPT.pl
changeset 36 04e8cb4f8073
parent 0 a5233793bf69
equal deleted inserted replaced
35:d3f6ca34c4ea 36:04e8cb4f8073
     1 #======================================================================
     1 #======================================================================
     2 #                    L I B C P T . P L 
     2 #                    L I B C P T . P L 
     3 #                    doc: Wed Nov 15 12:28:49 2000
     3 #                    doc: Wed Nov 15 12:28:49 2000
     4 #                    dlm: Fri May  9 11:40:01 2008
     4 #                    dlm: Mon May 14 21:29:00 2018
     5 #                    (c) 2000 A.M. Thurnherr
     5 #                    (c) 2000 A.M. Thurnherr
     6 #                    uE-Info: 25 31 NIL 0 0 72 2 2 4 NIL ofnI
     6 #                    uE-Info: 75 58 NIL 0 0 72 2 2 4 NIL ofnI
     7 #======================================================================
     7 #======================================================================
     8 
     8 
     9 # HISTORY:
     9 # HISTORY:
    10 #	Nov 15, 2000: - created
    10 #	Nov 15, 2000: - created
    11 #	May 29, 2001: - made bg/fg numeric
    11 #	May 29, 2001: - made bg/fg numeric
    21 #   Jul  1, 2006: - Version 3.3 [HISTORY]
    21 #   Jul  1, 2006: - Version 3.3 [HISTORY]
    22 #   Jul 24, 2006: - modified to use $PRACTICALLY_ZERONY
    22 #   Jul 24, 2006: - modified to use $PRACTICALLY_ZERONY
    23 #	Aug 16, 2006: - BUG: last level was returned on value < first level
    23 #	Aug 16, 2006: - BUG: last level was returned on value < first level
    24 #	May  9, 2008: - adapted to GMT 4.3 (see also IMPLEMENTATION NOTES
    24 #	May  9, 2008: - adapted to GMT 4.3 (see also IMPLEMENTATION NOTES
    25 #					in [mkCPT])
    25 #					in [mkCPT])
       
    26 #	Mar 26, 2018: - BUG: fg colors could not be set?!?!?!?! (both F and B set bg color)
       
    27 #				  - implemented color scaling for input files with rgb vals 0-1
       
    28 #	May 14, 2016: - added input file check
    26 
    29 
    27 #----------------------------------------------------------------------
    30 #----------------------------------------------------------------------
    28 # CPT File Parsing
    31 # CPT File Parsing
    29 #----------------------------------------------------------------------
    32 #----------------------------------------------------------------------
    30 
    33 
    63 		next if /^\s*$/;
    66 		next if /^\s*$/;
    64 		my(@f) = split;
    67 		my(@f) = split;
    65 		if ($f[0] eq 'B') {
    68 		if ($f[0] eq 'B') {
    66 			$CPT{bg_R} = $f[1]; $CPT{bg_G} = $f[2]; $CPT{bg_B} = $f[3];
    69 			$CPT{bg_R} = $f[1]; $CPT{bg_G} = $f[2]; $CPT{bg_B} = $f[3];
    67 		} elsif ($f[0] eq 'F') {
    70 		} elsif ($f[0] eq 'F') {
    68 			$CPT{bg_R} = $f[1]; $CPT{bg_G} = $f[2]; $CPT{bg_B} = $f[3];
    71 			$CPT{fg_R} = $f[1]; $CPT{fg_G} = $f[2]; $CPT{fg_B} = $f[3];
    69 		} elsif ($f[0] eq 'N') {
    72 		} elsif ($f[0] eq 'N') {
    70 			$CPT{nan_R} = $f[1]; $CPT{nan_G} = $f[2]; $CPT{nan_B} = $f[3];
    73 			$CPT{nan_R} = $f[1]; $CPT{nan_G} = $f[2]; $CPT{nan_B} = $f[3];
    71 		} else {
    74 		} else {
       
    75 			croak("$0: format error - 7 fields expected on line: $_") unless ($#f >= 7);
    72 			$CPT{from_z}[$CPT{levels}] = $f[0];
    76 			$CPT{from_z}[$CPT{levels}] = $f[0];
    73 			$CPT{from_R}[$CPT{levels}] = $f[1];
    77 			$CPT{from_R}[$CPT{levels}] = $f[1];
    74 			$CPT{from_G}[$CPT{levels}] = $f[2];
    78 			$CPT{from_G}[$CPT{levels}] = $f[2];
    75 			$CPT{from_B}[$CPT{levels}] = $f[3];
    79 			$CPT{from_B}[$CPT{levels}] = $f[3];
    76 			$CPT{to_z}[$CPT{levels}] = $f[4];
    80 			$CPT{to_z}[$CPT{levels}] = $f[4];
    80 			$CPT{levels}++;
    84 			$CPT{levels}++;
    81 	    }
    85 	    }
    82     }
    86     }
    83     $CPT{color_model} = 'RGB' unless defined($CPT{color_model});
    87     $CPT{color_model} = 'RGB' unless defined($CPT{color_model});
    84     croak("$0: color model $CPT{color_model} not implemented\n")
    88     croak("$0: color model $CPT{color_model} not implemented\n")
    85     	unless ($CPT{color_model} =~ '\+?RGB' || $CPT{color_model} =~ '\+?HSV');
    89     	unless ($CPT{color_model} =~ '\+?[Rr][Gg][Bb]' || $CPT{color_model} =~ '\+?[Hh][Ss][Vv]');
       
    90 
       
    91 	if ($CPT{from_R}[0]>=0 && $CPT{from_R}[0]<=1 &&								# colors in 0-1 range
       
    92 		$CPT{from_G}[0]>=0 && $CPT{from_G}[0]<=1 &&
       
    93 		$CPT{from_B}[0]>=0 && $CPT{from_B}[0]<=1 &&
       
    94     	$CPT{from_R}[$CPT{levels}-1]>=0 && $CPT{from_R}[$CPT{levels}-1]<=1 &&
       
    95 		$CPT{from_G}[$CPT{levels}-1]>=0 && $CPT{from_G}[$CPT{levels}-1]<=1 &&
       
    96 		$CPT{from_B}[$CPT{levels}-1]>=0 && $CPT{from_B}[$CPT{levels}-1]<=1) {
       
    97 			$CPT{bg_R} = round(255 * $CPT{bg_R}); $CPT{bg_G} = round(255 * $CPT{bg_G}); $CPT{bg_B} = round(255 * $CPT{bg_B});
       
    98 			$CPT{fg_R} = round(255 * $CPT{fg_R}); $CPT{fg_G} = round(255 * $CPT{fg_G}); $CPT{fg_B} = round(255 * $CPT{fg_B});
       
    99 			$CPT{nan_R} = round(255 * $CPT{nan_R}); $CPT{nan_G} = round(255 * $CPT{nan_G}); $CPT{nan_B} = round(255 * $CPT{nan_B});
       
   100 			for (my($i)=0; $i<$CPT{levels}; $i++) {
       
   101 				$CPT{from_R}[$i] = round(255 * $CPT{from_R}[$i]);
       
   102 				$CPT{from_G}[$i] = round(255 * $CPT{from_G}[$i]);
       
   103 				$CPT{from_B}[$i] = round(255 * $CPT{from_B}[$i]);
       
   104 				$CPT{to_R}[$i] = round(255 * $CPT{to_R}[$i]);
       
   105 				$CPT{to_G}[$i] = round(255 * $CPT{to_G}[$i]);
       
   106 				$CPT{to_B}[$i] = round(255 * $CPT{to_B}[$i]);
       
   107 			}
       
   108 	}
       
   109 
    86 	return %CPT;
   110 	return %CPT;
    87 }
   111 }
    88 		
   112 		
    89 sub CPTlvl($%)
   113 sub CPTlvl($%)
    90 {
   114 {