!> !!##NAME !! M_color(3) - [M_color::INTRO] a Fortran module that lets you !! convert between common color models (LICENSE:PD) !! !!##SYNOPSIS !! !! !! use M_color, only : & !! !! & hue, & !! & closest_color_name, & !! & color_name2rgb, & !! & rgbmono !! !!##DESCRIPTION !! Highly accurate color conversions are a tricky business, and color !! is a complex topic; but the simplified translations between common !! color models found here work quite well for basic conversions. !! !! Typically the only user routine called is HUE(3f). HUE(3f) is !! a single routine that interfaces to all the private low-level !! color conversion routines to convert a color's components from !! one color model to another. HUE(3f) converts between the !! following color models: !! !! RGB: Red, Green, Blue (color TV monitors) !! HLS: Hue, Lightness, Saturation !! CMY: Cyan, Magenta, Yellow (pigment-based printing devices) !! HSV: Hue, Saturation, Value !! YIQ: Broadcast TV color system !! !! In addition to those reversible color model conversions there !! are: !! !! CLOSEST_COLOR_NAME(3f): given RGB values, try to find closest !! named color !! !! COLOR_NAME2RGB(3f): given a standard color name, return RGB color !! values in range 0 to 100 !! !! RGBMONO(3f): convert RGB colors to a reasonable grayscale !! (non-reversible) !! !! DESIGN OF THE MODULE !! !! The rest of the library is composed of PRIVATE procedures. Internally !! for each color model supported the general idea of the module is that !! there are two routines for each color model: !! !! + One converts that model to the RGB model !! + The other converts from RGB to that model !! !! This allows conversions between all color models with only 2*N !! routines. That is, to go from model A to model B the module !! would internally make two calls: !! !! call modelA2rgb(...) !! call rgb2modelB(...) !! !! The resulting internal routines are: !! !! HLSRGB: given hue, lightness, saturation calculate red, !! green, and blue components !! + RGBVAL ensures a value is in the appropriate range and !! quadrant !! HVSRGB: given hue, saturation, value calculate red, green, !! and blue components !! CMYRGB: given cyan, magenta, yellow components calculate !! red, green, blue components !! YIQRGB: given luma(gray scale), orange-blue chrominance, !! and purple-green chrominance components calculate red, green, !! and blue components !! RGBHVS: given red, green, blue values calculate hue, value, !! and saturation components !! RGBHLS: given red, green, blue values calculate hue, !! lightness, and saturation components !! RGBCMY: given red, green, blue values calculate cyan, !! magenta, yellow components !! RGBYIQ: given red, green, blue values calculate luma(gray !! scale), orange-blue chrominance, and purple-green chrominance !! components !! !!##EXAMPLE !! !! Sample program: !! !! program demo_M_color !! use M_color, only : hue !! use M_color, only : closest_color_name !! use M_color, only : color_name2rgb !! use M_color, only : rgbmono !! implicit none !! character(len=100) :: string ! at least 20 characters !! character(len=20) :: name !! character(len=20) :: echoname !! real :: red,green,blue !! real :: gray !! integer :: ierr !! ! find the names of colors given RGB values !! write(*,*)'Find names given values' !! !! call closest_color_name( 100.0, 0.0, 0.0, string) !! write(*,*)trim(string) !! !! call closest_color_name( 0.0, 100.0, 0.0, string) !! write(*,*)trim(string) !! !! call closest_color_name( 0.0, 0.0, 100.0, string) !! write(*,*)trim(string) !! !! ! list colors known to colorname2rgb(3f) & corresponding RGB values !! write(*,*)'given names find RGB values' !! ! get the RGB values and English name of the color !! call color_name2rgb('RED',red,green,blue,echoname) !! ! display the English name and RGB values for the name !! write(*,*)echoname,int([red,green,blue]) !! !! write(*,*)'Do some conversions between RGB, HLS, and HLS' !! write(*,*)'and check them against expected values' !! ! NAME RGB(0-255) HLS(0-100) !! call chk('hls','red', [100, 0, 0 ], [0, 50, 100]) !! call chk('hls','orange', [100, 65, 0 ], [39, 50, 100]) !! call chk('hls','yellow', [100, 100, 0 ], [60, 50, 100]) !! call chk('hls','green', [0, 100, 0 ], [120, 50, 100]) !! call chk('hls','cyan', [0, 100, 100], [180, 50, 100]) !! call chk('hls','blue', [0, 0, 100], [240, 50, 100]) !! call chk('hls','magenta', [100, 0, 100], [300, 50, 100]) !! call chk('hls','black', [0, 0, 0 ], [0, 0, 0 ]) !! call chk('hls','white', [100, 100, 100], [0, 100, 0 ]) !! ! NAME RGB(0-255) HSV(0-100) !! call chk('hsv','red', [100, 0, 0 ], [0, 100, 100]) !! call chk('hsv','yellow', [100, 100, 0 ], [60, 100, 100]) !! call chk('hsv','green', [0, 100, 0 ], [120, 100, 100]) !! call chk('hsv','cyan', [0, 100, 100], [180, 100, 100]) !! call chk('hsv','blue', [0, 0, 100], [240, 100, 100]) !! call chk('hsv','magenta', [100, 0, 100], [300, 100, 100]) !! call chk('hsv','white', [100, 100, 100], [0, 0, 100]) !! call chk('hsv','black', [0, 0, 0 ], [0, 0, 0 ]) !! call chk('hsv','gray50', [50, 50, 50 ], [0, 0, 50 ]) !! call chk('hsv','silver', [75, 75, 75 ], [0, 0, 75 ]) !! call chk('hsv','red4', [55, 0, 0 ], [0, 100, 55 ]) !! call chk('hsv','olive', [50, 50, 0 ], [60, 100, 50 ]) !! call chk('hsv','lime', [0, 100, 0 ], [120, 100, 100]) !! call chk('hsv','teal', [0, 50, 50 ], [180, 100, 50 ]) !! call chk('hsv','navy', [0, 0, 50 ], [240, 100, 50 ]) !! call chk('hsv','purple', [63, 13, 94 ], [277, 87, 94 ]) !! call chk('hsv','magenta4',[55, 0, 55 ], [300, 100, 55 ]) !! call chk('hsv','maroon', [69, 19, 38 ], [338, 73, 69 ]) !! !! write(*,*)'Get some grayscale values from RGB color values' !! call rgbmono(100., 0., 0.,gray,ierr);write(*,*)'red ',gray !! call rgbmono( 0.,100., 0.,gray,ierr);write(*,*)'green ',gray !! call rgbmono( 0., 0.,100.,gray,ierr);write(*,*)'blue ',gray !! call rgbmono(100.,100., 0.,gray,ierr);write(*,*)'Yellow ',gray !! call rgbmono( 0.,100.,100.,gray,ierr);write(*,*)'Cyan ',gray !! call rgbmono(100., 0.,100.,gray,ierr);write(*,*)'Magenta ',gray !! call rgbmono(100.,100.,100.,gray,ierr);write(*,*)'White ',gray !! call rgbmono( 00., 0., 0.,gray,ierr);write(*,*)'Black ',gray !! call rgbmono( 50., 0., 0.,gray,ierr);write(*,*)'Maroon ',gray !! call rgbmono(100., 50., 50.,gray,ierr);write(*,*)'Pink ',gray !! contains !! subroutine chk(modelout,name,rgb,other) !! ! given a color convert to MODELOUT and compare to expected values !! character(len=*),intent(in) :: name !! integer,intent(in) :: rgb(3), other(3) !! character(len=*),intent(in) :: modelout !! real :: val1,val2,val3 !! integer :: status !! ! convert RGB values to MODELOUT values !! call hue('rgb',REAL(rgb(1)),REAL(rgb(2)),REAL(rgb(3)),& !! & modelout,val1,val2,val3,status) !! ! left-justify name to 10 characters or more !! write(*,'(a,1x)',advance='no') & !! & [ character(len=max(10,len_trim(name))) ::' '//trim(name)] !! write(*,'(a,1x,3(i3,1x))',advance='no') & !! & modelout//' EXPECTED',other !! write(*,'(a,1x,3(i3,1x))',advance='no') & !! & 'GOT',int([val1+0.5,val2+0.5,val3+0.5]) !! write(*,'(a,i0)')'STATUS ',status !! end subroutine chk !! end program demo_M_color !! !!##REFERENCES !! The algorithms are based on chapter 17 of "Fundamentals of !! Interactive Computer Graphics"; J. D. Foley and A. Van Dam. !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== module M_color implicit none ! ident_1="@(#) M_color color(3f) convert between common color models" private public hue ! converts a color's components from one color model to another public closest_color_name ! given RGB values, try to find closest named color public color_name2rgb ! given a color name, return rgb color values in range 0 to 100 public rgbmono ! convert RGB colors to a reasonable grayscale !---------------------------- private hlsrgb ! convert HLS(hue, lightness, saturation) values to RGB (red, green, blue) components private hvsrgb ! given hue, saturation, value calculate red, green, & blue components private cmyrgb ! given cyan,magenta, and yellow calculate red,green,blue components !---------------------------- private rgbhls ! given red,green,blue calculate hue,lightness, and saturation components private rgbhvs ! given red, green, blue calculate hue, saturation and value components private rgbcmy ! given red,green,blue calculate cyan,magenta, and yellow components private rgbyiq ! given RGB calculate luma, orange-blue chrominance, and purple-green chrominance !---------------------------- private rgbval ! internal routine to ensure a value is in the appropriate range and quadrant contains !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! HUE(3f) - [M_color] converts a color's components from one color !! model to another. (LICENSE:PD) !! !!##SYNOPSIS !! !! subroutine hue(modei,clr1i,clr2i,clr3i,modeo,clr1o,clr2o,clr3o,status) !! !! character(len=*),intent(in) :: modei !! character(len=*),intent(in) :: modeo !! real,intent(in) :: clr1i,clr2i,clr3i !! real,intent(out) :: clr1o,clr2o,clr3o !! integer,intent(out) :: status !! !!##DESCRIPTION !! !! HUE(3f) translates from the first model type to the second. !! !! MODEI specifies the color model that applies to the input color !! components CLR1I, CLR2I, and CLR3I. !! !! MODEO specifies the color model desired for the output color components !! CLR1O, CLR2O, and CLR3O. !! !! At a minimum, this procedure equates the output color values to the !! input color values. !! !! Valid values for MODEI and MODEO as well as the corresponding meanings !! for CLR1*, CLR2*, and CLR3* are: !! !! | mode | clr1 | clr2 | clr3 !! | ----- | ---------------- |--------------|--------------- !! | 'hls' | hue | lightness | saturation !! | 'hsl' | hue | saturation | lightness !! | 'hvs' | hue | value | saturation !! | 'hsv' | hue | saturation | value !! | 'rgb' | red | green | blue !! | 'cmy' | cyan | magenta | yellow !! | 'yiq' | luma(gray-scale) | orange-blue | purple-green !! | | | chrominance | chrominance !! !! + lightness, value, saturation, red, green, blue, cyan, magenta, !! and yellow range from 0 to 100, !! + hue ranges from 0 to 360 degrees, !! + y ranges from 0 to 100, !! + i ranges from -60 to 60, !! + q ranges from -52 to 52 !! !! The STATUS variable can signal the following conditions: !! !! -1 modei = modeo, so no substantial conversion was done, !! 1 one of the input color values was outside the allowable range, !! 2 modei was invalid !! 3 modeo was invalid !! 999 unknown error !! !!##EXAMPLE !! !! !! Sample program !! !! program demo_hue !! use M_color, only : hue !! implicit none !! ! NAME RGB(0-255) HLS(0-100) !! call chk('hls','red', [100, 0, 0 ], [0, 50, 100]) !! call chk('hls','orange', [100, 65, 0 ], [39, 50, 100]) !! call chk('hls','yellow', [100, 100, 0 ], [60, 50, 100]) !! call chk('hls','green', [0, 100, 0 ], [120, 50, 100]) !! call chk('hls','cyan', [0, 100, 100], [180, 50, 100]) !! call chk('hls','blue', [0, 0, 100], [240, 50, 100]) !! call chk('hls','magenta', [100, 0, 100], [300, 50, 100]) !! call chk('hls','black', [0, 0, 0 ], [0, 0, 0 ]) !! call chk('hls','white', [100, 100, 100], [0, 100, 0 ]) !! ! NAME RGB(0-255) HSV(0-100) !! call chk('hsv','red', [100, 0, 0 ], [0, 100, 100]) !! call chk('hsv','yellow', [100, 100, 0 ], [60, 100, 100]) !! call chk('hsv','green', [0, 100, 0 ], [120, 100, 100]) !! call chk('hsv','cyan', [0, 100, 100], [180, 100, 100]) !! call chk('hsv','blue', [0, 0, 100], [240, 100, 100]) !! call chk('hsv','magenta', [100, 0, 100], [300, 100, 100]) !! call chk('hsv','black', [0, 0, 0 ], [0, 0, 0 ]) !! call chk('hsv','white', [100, 100, 100], [0, 0, 100]) !! !! call chk('hsv','gray50', [50, 50, 50 ], [0, 0, 50 ]) !! call chk('hsv','silver', [75, 75, 75 ], [0, 0, 75 ]) !! call chk('hsv','red4', [55, 0, 0 ], [0, 100, 55 ]) !! call chk('hsv','olive', [50, 50, 0 ], [60, 100, 50 ]) !! call chk('hsv','lime', [0, 100, 0 ], [120, 100, 100]) !! call chk('hsv','teal', [0, 50, 50 ], [180, 100, 50 ]) !! call chk('hsv','navy', [0, 0, 50 ], [240, 100, 50 ]) !! call chk('hsv','purple', [63, 13, 94 ], [277, 87, 94 ]) !! call chk('hsv','magenta4',[55, 0, 55 ], [300, 100, 55 ]) !! call chk('hsv','maroon', [69, 19, 38 ], [338, 73, 69 ]) !! contains !! subroutine chk(modelout,name,rgb,other) !! ! given a color convert to MODELOUT and compare to expected values !! character(len=*),intent(in) :: name !! integer,intent(in) :: rgb(3), other(3) !! character(len=*),intent(in) :: modelout !! real :: val1,val2,val3 !! integer :: status !! ! convert RGB values to MODELOUT values !! call hue('rgb',REAL(rgb(1)),REAL(rgb(2)),REAL(rgb(3)),& !! & modelout,val1,val2,val3,status) !! ! left-justify name to 10 characters or more !! write(*,'(a,1x)',advance='no') & !! & [ character(len=max(10,len_trim(name))) ::' '//trim(name)] !! write(*,'(a,1x,3(i3,1x))',advance='no') & !! & modelout//' EXPECTED',other !! write(*,'(a,1x,3(i3,1x))',advance='no') & !! & 'GOT',int([val1+0.5,val2+0.5,val3+0.5]) !! write(*,'(a,i0)')'STATUS ',status !! end subroutine chk !! end program demo_hue !! !! Results: !! !! red hls EXPECTED 0 50 100 GOT 0 50 100 STATUS 0 !! orange hls EXPECTED 39 50 100 GOT 39 50 100 STATUS 0 !! yellow hls EXPECTED 60 50 100 GOT 60 50 100 STATUS 0 !! green hls EXPECTED 120 50 100 GOT 120 50 100 STATUS 0 !! cyan hls EXPECTED 180 50 100 GOT 180 50 100 STATUS 0 !! blue hls EXPECTED 240 50 100 GOT 240 50 100 STATUS 0 !! magenta hls EXPECTED 300 50 100 GOT 300 50 100 STATUS 0 !! black hls EXPECTED 0 0 0 GOT 0 0 0 STATUS 0 !! white hls EXPECTED 0 100 0 GOT 0 100 0 STATUS 0 !! black hsv EXPECTED 0 0 0 GOT 0 0 0 STATUS 0 !! gray50 hsv EXPECTED 0 0 50 GOT 0 0 50 STATUS 0 !! silver hsv EXPECTED 0 0 75 GOT 0 0 75 STATUS 0 !! white hsv EXPECTED 0 0 100 GOT 0 0 100 STATUS 0 !! red4 hsv EXPECTED 0 100 55 GOT 0 100 55 STATUS 0 !! red hsv EXPECTED 0 100 100 GOT 0 100 100 STATUS 0 !! olive hsv EXPECTED 60 100 50 GOT 60 100 50 STATUS 0 !! yellow hsv EXPECTED 60 100 100 GOT 60 100 100 STATUS 0 !! green hsv EXPECTED 120 100 100 GOT 120 100 100 STATUS 0 !! lime hsv EXPECTED 120 100 100 GOT 120 100 100 STATUS 0 !! teal hsv EXPECTED 180 100 50 GOT 180 100 50 STATUS 0 !! cyan hsv EXPECTED 180 100 100 GOT 180 100 100 STATUS 0 !! navy hsv EXPECTED 240 100 50 GOT 240 100 50 STATUS 0 !! blue hsv EXPECTED 240 100 100 GOT 240 100 100 STATUS 0 !! purple hsv EXPECTED 277 87 94 GOT 277 86 94 STATUS 0 !! magenta4 hsv EXPECTED 300 100 55 GOT 300 100 55 STATUS 0 !! magenta hsv EXPECTED 300 100 100 GOT 300 100 100 STATUS 0 !! maroon hsv EXPECTED 338 73 69 GOT 337 72 69 STATUS 0 !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine hue(modei,clr1i,clr2i,clr3i,modeo,clr1o,clr2o,clr3o,status) ! ident_2="@(#) M_color hue(3f) convert color components from one color model to another" character(len=*),intent(in) :: modei real,intent(in) :: clr1i,clr2i,clr3i character(len=*),intent(in) :: modeo real,intent(out) :: clr1o,clr2o,clr3o integer,intent(out) :: status character(len=3) :: input_color_model,output_color_model real :: c1, c2, c3, r, g, b !----------------------------------------------------------------------------------------------------------------------------------- !-- initialize the status flag. status=0 !-- set the output colors equal to invalid values clr1o=-99999.0 clr2o=-99999.0 clr3o=-99999.0 !-- ensure that the input character strings are lowercase input_color_model=lower(modei) output_color_model=lower(modeo) !----------------------------------------------------------------------------------------------------------------------------------- !-- check for a trivial instance where the input and output model names are the same if(input_color_model == output_color_model) then clr1o=clr1i clr2o=clr2i clr3o=clr3i status=-1 return endif !----------------------------------------------------------------------------------------------------------------------------------- !-- check for a transpose of terms, another trivial instance. SELECT CASE (input_color_model) CASE ('hls','hsl','hvs','hsv') if( input_color_model == 'hls' .and. output_color_model == 'hsl' & & .or.input_color_model == 'hsl' .and. output_color_model == 'hls' & & .or.input_color_model == 'hvs' .and. output_color_model == 'hsv' & & .or.input_color_model == 'hsv' .and. output_color_model == 'hvs') then clr1o=clr1i clr2o=clr3i clr3o=clr2i status=-1 return endif END SELECT !----------------------------------------------------------------------------------------------------------------------------------- !-- assign new variables so that the input arguments can't possibly be changed by subsequent procedures. c1=clr1i c2=clr2i c3=clr3i !----------------------------------------------------------------------------------------------------------------------------------- !-- first, convert input values to rgb values. SELECT CASE (input_color_model) CASE ('hls'); call hlsrgb(c1,c2,c3,r,g,b,status) CASE ('hvs'); call hvsrgb(c1,c2,c3,r,g,b,status) CASE ('hsl'); call hlsrgb(c1,c3,c2,r,g,b,status) CASE ('hsv'); call hvsrgb(c1,c3,c2,r,g,b,status) CASE ('cmy'); call cmyrgb(c1,c2,c3,r,g,b,status) CASE ('yiq'); call yiqrgb(c1,c2,c3,r,g,b,status) CASE ('rgb'); r=c1;g=c2;b=c3 CASE DEFAULT ! unknown input model name status=2 return END SELECT !----------------------------------------------------------------------------------------------------------------------------------- if(status /= 0 )then return endif !----------------------------------------------------------------------------------------------------------------------------------- !-- then convert from RGB to the desired output values ! SELECT CASE (output_color_model) CASE ('hls'); call rgbhls(r,g,b,clr1o,clr2o,clr3o,status) CASE ('hsl'); call rgbhls(r,g,b,clr1o,clr3o,clr2o,status) CASE ('hvs'); call rgbhvs(r,g,b,clr1o,clr2o,clr3o,status) CASE ('hsv'); call rgbhvs(r,g,b,clr1o,clr3o,clr2o,status) CASE ('cmy'); call rgbcmy(r,g,b,clr1o,clr2o,clr3o,status) CASE ('rgb'); clr1o=r; clr2o=g; clr3o=b CASE ('yiq'); call rgbyiq(r,g,b,clr1o,clr2o,clr3o,status) CASE DEFAULT ! unknown output model name status=3 return END SELECT !----------------------------------------------------------------------------------------------------------------------------------- if(status /= 0 )then return endif !----------------------------------------------------------------------------------------------------------------------------------- end subroutine hue !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! RGBHLS(3fp) - [M_color] Given red, green, and blue color components !! calculates the hue, lightness, and saturation for a color (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine rgbhls(r,g,b,h,l,s,status) !! !! ! red component as a value of 0 to 100 !! real, intent(in) :: r !! ! green component as a value of 0 to 100 !! real, intent(in) :: g !! ! blue component as a value of 0 to 100 !! real, intent(in) :: b !! ! hue value in the range of 0 to 360 degrees !! real, intent(out) :: h !! ! lightness as a percent value from 0 to 100 !! real, intent(out) :: l !! ! saturation as a percent from 0 to 100 !! real, intent(out) :: s !! integer :: status !! !!##DESCRIPTION !! RGB values are in the range 0-100; hue is 0-360 degrees; !! lightness and saturation have a range of 0-100. !! !! Color RGB HLS !! Red 100.0 0.0 0.0 0 50.0 100.0 !! Yellow 100.0 100.0 0.0 60 50.0 100.0 !! Green 0.0 100.0 0.0 120 50.0 100.0 !! Cyan 0.0 100.0 100.0 180 50.0 100.0 !! Blue 0.0 0.0 100.0 240 50.0 100.0 !! Magenta 100.0 0.0 100.0 300 50.0 100.0 !! White 100.0 100.0 100.0 (any) 100.0 (any) !! Black 0.0 0.0 0.0 (any) 0.0 (any) !! Maroon 50.0 0.0 0.0 0 25.0 100.0 !! Pink 100.0 50.0 50.0 0 75.0 100.0 !! !! AUTHOR !! John S. Urban !! !! LICENSE !! Public Domain subroutine rgbhls(r0,g0,b0,h,l,s,status) ! ident_3="@(#) M_color rgbhls(3fp) given red green blue values calculate hue lightness saturation" ! given : r, g, b each as a value of 0 to 100 ! desired: h as a value of 0 to 360 degrees. ! . l and s each as a value of 0 to 100 ! real :: r0,g0,b0 real :: r,g,b,h,l,s real :: clrmax,clrmin,clrdel,clrsum,rr,gg,bb integer :: status if(r0 < 0.0 .or. r0 > 100.0 ) status = 1 !---- passive check for valid range of values. if(g0 < 0.0 .or. g0 > 100.0 ) status = 1 !---- passive check for valid range of values. if(b0 < 0.0 .or. b0 > 100.0 ) status = 1 !---- passive check for valid range of values. r=r0/100.0 g=g0/100.0 b=b0/100.0 clrmax=amax1(r,g,b) clrmin=amin1(r,g,b) clrdel=clrmax-clrmin clrsum=clrmax+clrmin l=clrsum/2.0 if(clrdel /= 0.0 ) then rr=(clrmax-r)/clrdel gg=(clrmax-g)/clrdel bb=(clrmax-b)/clrdel if(l <= 0.5) then s=clrdel/clrsum else s=clrdel/(2.0-clrsum) endif if(r == clrmax) then h=bb-gg else if(g == clrmax) then h=2.0 +rr-bb else if(b == clrmax) then h=4.0 +gg-rr endif h=h*60.0 if(h < 0.0 ) then h=h+360.0 endif else s=0.0 h=0.0 endif l=l*100.0 s=s*100.0 if(h < 0.0 ) h = 0.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) if(h > 360.0 ) h = 360.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) if(l < 0.0 ) l=0.0 if(l > 100.0 ) l = 100.0 if(s < 0.0 ) s=0.0 if(s > 100.0 ) s = 100.0 end subroutine rgbhls !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! RGBHVS(3fp) - [M_color] calculates the hue, value, & saturation !! for a color given in red, green, & blue components values. !! (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine rgbhvs(r,g,b,h,v,s,status) !! !! ! the red component as a value of 0 to 100. !! real, intent(in) :: r !! ! the green component as a value of 0 to 100. !! real, intent(in) :: g !! ! the blue component as a value of 0 to 100. !! real, intent(in) :: b !! ! the hue value in the range of 0 to 360 degrees !! real, intent(out) :: h !! ! the "value" as a percent value from 0 to 100. !! real, intent(out) :: v !! ! the saturation as a percent from 0 to 100. !! real, intent(out) :: s !! integer :: status !! !! !!##DESCRIPTION !! RGBHVS(3f) calculates the hue, value, & saturation for a color !! given in red, green, & blue components values. !! !! Color Color !! name Hex (R,G,B) (H,S,V) !! Black #000000 (0,0,0) (0º,0%,0%) !! White #FFFFFF (100,100,100) (0º,0%,100%) !! Red #FF0000 (100,0,0) (0º,100%,100%) !! Lime #00FF00 (0,100,0) (120º,100%,100%) !! Blue #0000FF (0,0,100) (240º,100%,100%) !! Yellow #FFFF00 (100,100,0) (60º,100%,100%) !! Cyan #00FFFF (0,100,100) (180º,100%,100%) !! Magenta #FF00FF (100,0,100) (300º,100%,100%) !! Silver #C0C0C0 (75,75,75) (0º,0%,75%) !! Gray #808080 (50,50,50) (0º,0%,50%) !! Maroon #800000 (50,0,0) (0º,100%,50%) !! Olive #808000 (50,50,0) (60º,100%,50%) !! Green #008000 (0,50,0) (120º,100%,50%) !! Purple #800080 (50,0,50) (300º,100%,50%) !! Teal #008080 (0,50,50) (180º,100%,50%) !! Navy #000080 (0,0,50) (240º,100%,50%) !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine rgbhvs(r0,g0,b0,h,v,s,status) ! ident_4="@(#) M_color rgbhvs(3fp) given red green blue calculate hue saturation value components" !---- this procedure calculates a hue, saturation, value equivalent for a ! color given in red, green, & blue components. ! given : r, g, b each as a value of 0 to 100. ! desired: h as a value of 0 to 360 degrees. ! . s and v each as a value of 0 to 100. ! real,intent(in) :: r0,g0,b0 real,intent(out) :: h,v,s integer :: status real :: r,g,b real :: clrmax,clrmin,clrdel,rr,gg,bb if(r0 < 0.0 .or. r0 > 100.0 ) status = 1 !---- check for valid range of values. if(g0 < 0.0 .or. g0 > 100.0 ) status = 1 !---- check for valid range of values. if(b0 < 0.0 .or. b0 > 100.0 ) status = 1 !---- check for valid range of values. r=r0 g=g0 b=b0 r=r/100.0 g=g/100.0 b=b/100.0 clrmax=amax1(r,g,b) clrmin=amin1(r,g,b) clrdel=clrmax-clrmin v=clrmax if(clrmax /= 0.0 )then s=clrdel/clrmax else s=0.0 endif if(s /= 0.0 )then rr=(clrmax-r)/clrdel gg=(clrmax-g)/clrdel bb=(clrmax-b)/clrdel if(r == clrmax)then h=bb-gg else if(g == clrmax) then h=2.0 +rr-bb else if(b == clrmax) then h=4.0 +gg-rr endif h=h*60.0 if(h < 0.0 ) then h=h+360.0 endif endif v=v*100.0 s=s*100.0 if(h > 360.0 ) h = 360.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) if(h < 0.0 ) h = 0.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) if(v > 100.0 ) v = 100.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) if(v < 0.0 ) v = 0.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) if(s > 100.0 ) s = 100.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) if(s < 0.0 ) s = 0.0 !---- Eliminate any roundoff that exceeds the limits (or hide formula bug!) end subroutine rgbhvs !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! cmyrgb(3fp) - [M_color] calculates the cyan, magenta, and yellow !! components given the red, green, and blue component values. !! (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine cmyrgb(c,m,y,r,g,b,status) !! !! ! cyan component as a value in the range of 0 to 100 !! real, intent(in) :: c !! ! magenta component as a value in the range of 0 to 100 !! real, intent(in) :: m !! ! yellow component as a value in the range of 0 to 100 !! real, intent(in) :: y !! ! red component as a value in the range of 0 to 100 !! real, intent(out) :: r !! ! green component as a value in the range of 0 to 100 !! real, intent(out) :: g !! ! blue component as a value in the range of 0 to 100 !! real, intent(out) :: b !! integer :: status !! !!##DESCRIPTION !! CMYRGB(3f) calculates the cyan, magenta, and yellow components !! given the red, green, and blue component values. !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine cmyrgb(c,m,y,r,g,b,status) ! ident_5="@(#) M_color cmyrgb(3fp) given cyan magenta yellow calculate red green blue components" ! given : r, g, b each as a value of 0 to 100 ! desired: c, m, y each as a value of 0 to 100 real,intent(in) :: c,m,y real,intent(out) :: r,g,b integer :: status if(c < 0.0 .or. c > 100.0 ) status = 1 !---- passively check for valid range of values. if(m < 0.0 .or. m > 100.0 ) status = 1 !---- passively check for valid range of values. if(y < 0.0 .or. y > 100.0 ) status = 1 !---- passively check for valid range of values. r= 100.0 - c g= 100.0 - m b= 100.0 - y end subroutine cmyrgb !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! rgbcmy(3fp) - [M_color] calculates the cyan, magenta, and yellow !! components given the red, green, and blue component values. !! (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine rgbcmy(r,g,b,c,m,y,status) !! !! ! the red component as a value in the range of 0 to 100 !! real, intent(in) :: r !! ! the green component as a value in the range of 0 to 100 !! real, intent(in) :: g !! ! the blue component as a value in the range of 0 to 100 !! real, intent(in) :: b !! ! the cyan component as a value in the range of 0 to 100 !! real, intent(out) :: c !! ! the magenta component as a value in the range of 0 to 100 !! real, intent(out) :: m !! ! the yellow component as a value in the range of 0 to 100 !! real, intent(out) :: y !! integer :: status !! !!##DESCRIPTION !! rgbcmy(3fp) calculates the cyan, magenta, and yellow !! components given the red, green, and blue component values. !! !!##EXAMPLE !! !! Sample values: !! !! Color !! name (C,M,Y) (R,G,B) Hex !! Black (100,100,100) (0,0,0) #000000 !! White (0,0,0) (100,100,100) #FFFFFF !! Red (0,100,100) (100,0,0) #FF0000 !! Green (100,0,100) (0,100,0) #00FF00 !! Blue (100,100,0) (0,0,100) #0000FF !! Yellow (0,0,100) (100,100,0) #FFFF00 !! Cyan (100,0,0) (0,100,100) #00FFFF !! Magenta (0,100,0) (100,0,100) #FF00FF !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine rgbcmy(r,g,b,c,m,y,status) ! ident_6="@(#) M_color rgbcmy(3fp) given red green blue calculate cyan magenta yellow components" ! given : r, g, b each as a value of 0 to 100 ! desired: c, m, y each as a value of 0 to 100 real,intent(in) :: r,g,b real,intent(out) :: c,m,y integer :: status if(r < 0.0 .or. r > 100.0 ) status = 1 !---- check for valid range of values. if(g < 0.0 .or. g > 100.0 ) status = 1 !---- check for valid range of values. if(b < 0.0 .or. b > 100.0 ) status = 1 !---- check for valid range of values. c = 100.0 - r m = 100.0 - g y = 100.0 - b end subroutine rgbcmy !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! RGBMONO(3f) - [M_color] converts RGB colors to a reasonable grayscale !! intensity !! (LICENSE:PD) !! !!##SYNOPSIS !! !! subroutine rgbmono(rr,rg,rb,ri,status) !! !! real, intent(in) :: RR !! real, intent(in) :: RG !! real, intent(in) :: RB !! real, intent(out) :: RI !! integer :: status !! !!##DESCRIPTION !! RGBMONO(3f) converts RGB colors to a reasonable grayscale intensity. !! This can be used to produce monochrome images from color images. !! Intensity is calculated from the specified Red, Green, Blue intensities !! as 0.30*R + 0.59*G + 0.11*B, as in U.S. color television systems, !! NTSC encoding. Note that most devices do not have an infinite range !! of monochrome intensities available. !! !!##OPTIONS !! RR red component of the input color in the range 0 to 100 !! RG green component of the input color in the range 0 to 100 !! RB blue component of the input color in the range 0 to 100 !! !!##RETURNS !! RI grayscale intensity calculated in the range 0 to 100 !! status zero (0) if no error occurred, otherwise result is out !! of bounds !! !!##EXAMPLES !! !! Sample: !! !! program demo_rgbmono !! use M_color, only : rgbmono !! implicit none !! real :: gray !! integer :: ierr !! call rgbmono(100.0, 0.0, 0.0,gray,ierr); write(*,*)'red ',gray !! call rgbmono( 0.0,100.0, 0.0,gray,ierr); write(*,*)'green ',gray !! call rgbmono( 0.0, 0.0,100.0,gray,ierr); write(*,*)'blue ',gray !! call rgbmono(100.0,100.0, 0.0,gray,ierr); write(*,*)'Yellow ',gray !! call rgbmono( 0.0,100.0,100.0,gray,ierr); write(*,*)'Cyan ',gray !! call rgbmono(100.0, 0.0,100.0,gray,ierr); write(*,*)'Magenta ',gray !! call rgbmono(100.0,100.0,100.0,gray,ierr); write(*,*)'White ',gray !! call rgbmono( 00.0, 0.0, 0.0,gray,ierr); write(*,*)'Black ',gray !! call rgbmono( 50.0, 0.0, 0.0,gray,ierr); write(*,*)'Maroon ',gray !! call rgbmono(100.0, 50.0, 50.0,gray,ierr); write(*,*)'Pink ',gray !! end program demo_rgbmono !! !! Results: !! !! red 30.0000019 !! green 58.9999962 !! blue 11.0000000 !! Yellow 89.0000000 !! Cyan 70.0000000 !! Magenta 41.0000000 !! White 100.000000 !! Black 0.00000000 !! Maroon 15.0000010 !! Pink 65.0000000 !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine rgbmono(rr,rg,rb,ri,status) ! ident_7="@(#) M_color rgbmono(3f) convert RGB colors to a reasonable grayscale" ! monochrome devices that support intensity can have intensity calculated from the specified Red, Green, Blue ! intensities as 0.30*R + 0.59*G + 0.11*B, as in US color television systems, NTSC encoding. ! Note that most devices do not have an infinite range of monochrome intensities available. real,intent(in) :: rr,rg,rb ! red, green, blue, & intensity range from 0 to 100 real,intent(out) :: ri integer,intent(out) :: status status=0 if(rr < 0.0 .or. rr > 100.0 ) status = 1 !---- passive check for valid range of values. if(rg < 0.0 .or. rg > 100.0 ) status = 1 !---- passive check for valid range of values. if(rb < 0.0 .or. rb > 100.0 ) status = 1 !---- passive check for valid range of values. ri = 0.30*rr + 0.59*rg + 0.11*rb end subroutine rgbmono !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! RGBVAL(3fp) - [M_color] is an internal private function used by !! hlsrgb(3fp). (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine rgbval(clr1,clr2,h) !! !! integer, intent(in) :: h ! H is the hue value in degrees !! real, intent(in) :: clr1 ! !! real, intent(in) :: clr2 ! !! !!##DESCRIPTION !! Function RGBVAL(3f) is an internal private function used by !! hlsrgb(). !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain real function rgbval(clr1,clr2,h) ! ident_8="@(#) M_color rgbval(3fp) ensure a value is in the appropriate range and quadrant" real :: clr1,clr2 real :: h real :: h2 h2=h do if(h2 > 360.0 ) then h2=h2-360.0 cycle endif exit enddo do if( h2 < 0.0 ) then h2=h2+360.0 cycle endif exit enddo if(h2 < 60.0 ) then rgbval=clr1+(clr2-clr1)*h2/60.0 else if(h2 < 180.0) then rgbval=clr2 else if(h2 < 240.0) then rgbval=clr1+(clr2-clr1)*(240.0-h2)/60.0 else rgbval=clr1 endif end function rgbval !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! HLSRGB(3fp) - [M_color] calculates the red, green, & blue !! components for a color given in hue, lightness, & saturation !! values. (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine hlsrgb (h,l,s,r,g,b,status) !! !! ! hue value in the range of 0 to 360 degrees !! real, intent(in) :: h !! ! lightness as a percent value from 0 to 100. !! real, intent(in) :: l !! ! saturation as a percent from 0 to 100. !! real, intent(in) :: s !! ! red component as a value of 0 to 100. !! real, intent(out) :: r !! ! green component as a value of 0 to 100. !! real, intent(out) :: g !! ! blue component as a value of 0 to 100. !! real, intent(out) :: b !! integer :: status !! !!##DESCRIPTION !! HLSRGB(3f) calculates the red, green, & blue components for a !! color given in hue, lightness, & saturation values. !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine hlsrgb(H,L,S,R,G,B,status) ! ident_9="@(#) M_color hlsrgb(3fp) convert HLS(hue lightness saturation) values to RGB components" ! given : hue as a value of 0 to 360 degrees. ! . lightness and saturation each as a value of 0 to 100. ! desired: r, g, and b each as a value of 0 to 100. ! real,intent(in) :: H,L,S real,intent(out) :: R,G,B integer :: status real :: hue,lightness,saturation real :: clr1,clr2 if(h < 0.0 .or. h > 360.0 ) status = 1 ! passively report on bad input values if(l < 0.0 .or. l > 100.0 ) status = 1 ! passively report on bad input values if(s < 0.0 .or. s > 100.0 ) status = 1 ! passively report on bad input values hue = H lightness = L/100.0 saturation = S/100.0 if( saturation == 0.0 ) then R = lightness G = lightness B = lightness endif if(lightness <= 0.50) then clr2= lightness*( 1.0 + saturation ) else clr2= lightness + saturation - lightness * saturation endif clr1= 2.0 * lightness - clr2 R = rgbval(clr1,clr2,hue+120.0) *100.0 G = rgbval(clr1,clr2,hue) *100.0 B = rgbval(clr1,clr2,hue-120.0) *100.0 end subroutine hlsrgb !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! HVSRGB(3fp) - [M_color] calculates the red, green, & blue !! components for a color given in hue, value, & saturation values. !! (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine hvsrgb(h,v,s,r,g,b,status) !! !! ! H is the hue value in the range of 0 to 360 degrees !! real, intent(in) :: h !! ! V is the "value" as a percent value from 0 to 100. !! real, intent(in) :: v !! ! S is the saturation as a percent from 0 to 100. !! real, intent(in) :: s !! ! R is the red component as a value of 0 to 100. !! real, intent(out) :: r !! ! G is the green component as a value of 0 to 100. !! real, intent(out) :: g !! ! B is the blue component as a value of 0 to 100. !! real, intent(out) :: b !! integer :: status !! !!##DESCRIPTION !! HVSRGB(3f) calculates the red, green, & blue components for a !! color given in hue, value, & saturation values. !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine hvsrgb(h,v,s,r,g,b,status) ! ident_10="@(#) M_color hvsrgb(3fp) given hue saturation value calculate red green blue components" ! given : hue as value of 0 to 360 degrees. ! . saturation and value each as a value of 0 to 100. ! desired: r, g, and b as a value of 0 to 100. real,intent(in) :: h,v,s real,intent(out) :: r,g,b integer :: status real :: hue,value,saturation integer :: ifloor real :: f,p,q,t if(h < 0.0 .or. h > 360.0 ) status = 1 ! passively report on bad input values if(v < 0.0 .or. v > 100.0 ) status = 1 ! passively report on bad input values if(s < 0.0 .or. s > 100.0 ) status = 1 ! passively report on bad input values hue=h value=v/100.0 saturation=s/100.0 !----------------------------------------------------------------------------------------------------------------------------------- if(saturation == 0.0) then r=value g=value b=value endif !----------------------------------------------------------------------------------------------------------------------------------- if(hue == 360.0) then hue=0.0 endif !----------------------------------------------------------------------------------------------------------------------------------- hue=hue/60.0 ifloor=int(hue) f=hue-ifloor p=value*(1.0-saturation) q=value*(1.0-(saturation*f)) t=value*(1.0-(saturation*(1-f))) select case (ifloor) case (0) ;r=value; g=t; b=p case (1) ;r=q; g=value; b=p case (2) ;r=p; g=value; b=t case (3) ;r=p; g=q; b=value case (4) ;r=t; g=p; b=value case (5) ;r=value; g=p; b=q case default end select r=r*100.0 g=g*100.0 b=b*100.0 end subroutine hvsrgb !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! YIQRGB(3fp) - [M_color] Convert luma, orange-blue chrominance, !! and purple-green chrominance to RGB values. (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine yiqrgb(y,i,q,r,g,b,status) !! !! real,intent(in) :: y,i,q !! real,intent(out) :: r,g,b !! integer :: status !! !!##DESCRIPTION !! Convert luma, orange-blue chrominance, and purple-green !! chrominance to RGB values. !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine yiqrgb(y,i,q,r,g,b,status) ! ident_11="@(#) M_color yiqrgb(3fp) convert luma orange-blue chrominance purple-green chrominance to RGB" real,intent(in) :: y,i,q real,intent(out) :: r,g,b integer :: status ! !---- i don't believe that this is an exhaustive test of value ranges ! for yiq. for example yiq=(100.0,60.0,52.0) when converted to ! rgb produces values greater than 100!? ! if(i < -60.0 .or. i > 60.0) status = 1 if(q < -53.0 .or. q > 53.0) status = 1 r = 1.0 * y + 0.956 * i + 0.621 * q g = 1.0 * y - 0.272 * i - 0.647 * q b = 1.0 * y - 1.106 * i + 1.703 * q !r= 1.0 *y + 0.94826224*i + 0.62401264*q !g= 1.0 *y - 0.27606635*i - 0.63981043*q !b= 1.0 *y - 1.1054502 *i + 1.7298578 *q ! !-- If outside the valid range of values, truncate to allow for reasonable roundoff and then retest. ! This should pass values essentially 0 or 100, but fail others. ! The above formula for rgb from yiq can give answers slightly less than 0 and slightly greater than 100.0 ! The truncation should fix this. ! The retest should then catch the instances such as yiq=(100.0,60.0,52.0) as mentioned earlier. r=min(100.0,max(0.0,r)) g=min(100.0,max(0.0,g)) b=min(100.0,max(0.0,b)) end subroutine yiqrgb !============================================= !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! RGBYIQ(3fp) - [M_color] Convert RGB values to luma, orange-blue !! chrominance, and purple-green chrominance. (LICENSE:PD) !! !!##SYNOPSIS !! !! !! subroutine rgbyiq(r,g,b,y,i,q,status) !! !! real,intent(in) :: r,g,b !! real,intent(out) :: y,i,q !! integer :: status !! !!##DESCRIPTION !! Convert RGB values to luma, orange-blue chrominance, and !! purple-green chrominance. !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine rgbyiq(r,g,b,y,i,q,status) ! ident_12="@(#) M_color rgbyiq(3fp) convert RGB to luma orange-blue chrominance purple-green chrominance" real,intent(in) :: r,g,b real,intent(out) :: y,i,q integer :: status if(r < 0.0 .or. r > 100.0) status=1 if(g < 0.0 .or. g > 100.0) status=1 if(b < 0.0 .or. b > 100.0) status=1 y= 0.299 * r + 0.587 * g + 0.114 * b i= 0.596 * r - 0.274 * g - 0.322 * b q= 0.211 * r - 0.523 * g + 0.312 * b !-- Eliminate any roundoff that exceeds the limits. if(i < -59.57 ) i = -59.57 if(i > 59.57 ) i = 59.57 if(q < -52.26 ) q = -52.26 if(q > 52.26 ) q = 52.26 end subroutine rgbyiq !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! closest_color_name(3f) - [M_color] returns the closest name for the !! given RGB values. !! (LICENSE:PD) !! !!##SYNOPSIS !! !! subroutine closest_color_name(r,g,b,closestname) !! !! real,intent(in) :: r,g,b !! character(len=20),intent(out) :: closestname !! !!##DESCRIPTION !! CLOSEST_COLOR_NAME(3f) returns the closest name for the given RGB values. !! Most X11 Windows color names are supported. !! !!##OPTIONS !! R red component, range of 0 to 100 !! G green component, range of 0 to 100 !! B blue component, range of 0 to 100 !! !!##RETURNS !! CLOSESTNAME name of color found closest to given RGB value !! !!##EXAMPLE !! !! !! Sample program !! !! program demo_closest_color_name !! use M_color, only : closest_color_name !! character(len=100) :: string ! at least 20 characters !! string=' ' !! !! call closest_color_name(100.0, 0.0, 0.0,string) !! write(*,*)trim(string) !! !! call closest_color_name( 0.0,100.0, 0.0,string) !! write(*,*)trim(string) !! !! call closest_color_name( 0.0, 0.0,100.0,string) !! write(*,*)trim(string) !! !! end program demo_closest_color_name !! !! Results: !! !! red !! green !! blue !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine closest_color_name(r,g,b,closestname) ! ident_13="@(#) M_color closest_color_name(3f) given RGB values try to find closest named color" real,intent(in) :: r,g,b character(len=*),intent(out) :: closestname real :: rn,gn,bn real :: distance, minimum_distance character(len=20) :: echoname integer :: i character(len=20) :: string !----------------------------------------------------------------------------------------------------------------------------------- minimum_distance=1000.0 closestname='Unknown' INFINITE: do i=1,1000 write(string,'(i0)')i call color_name2rgb(string,rn,gn,bn,echoname) ! get next color if(echoname == 'Unknown') exit INFINITE distance=sqrt( (r-rn)**2 + (g-gn)**2 + (b-bn)**2 ) if(distance < minimum_distance)then closestname=echoname minimum_distance=min(minimum_distance,distance) endif enddo INFINITE end subroutine closest_color_name !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! COLOR_NAME2RGB(3f) - [M_color] returns the RGB values in the range 0 to !! 100 for a given known color name. !! (LICENSE:PD) !! !!##SYNOPSIS !! !! subroutine color_name2rgb(name,r,g,b,echoname) !! !! character(len=20),intent(in) :: name !! real,intent(out) :: r,g,b !! character(len=20),intent(out) :: echoname !! !!##DESCRIPTION !! COLOR_NAME2RGB(3f) returns the RGB values in the range 0 to 100 !! for a given known color name. Most X11 Windows color names are !! supported. If the name is not found ECHONAME is set to "Unknown". !! !!##EXAMPLE !! !! A sample program: !! !! program demo_color_name2rgb !! use M_color, only : hue, color_name2rgb !! implicit none !! ! !! ! list colors known to colorname2rgb(3f) & corresponding RGB values !! ! !! character(len=20) :: name !! character(len=20) :: echoname !! real :: red,green,blue !! integer :: i !! TRYALL: do i=1,10000 !! ! weird little thing where the color names have aliases !! ! that are numeric strings !! write(name,'(i0)')i !! ! get the RGB values and English name of the color !! call color_name2rgb(name,red,green,blue,echoname) !! ! the last color name is "Unknown" so the loop should exit !! if(echoname == 'Unknown')exit TRYALL !! ! display the English name and RGB values for the name !! write(*,*)echoname,int([red,green,blue]) !! enddo TRYALL !! !write(*,*)'Number of colors found is ',i-1 !! end program demo_color_name2rgb !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! Public Domain subroutine color_name2rgb(name,r,g,b,echoname) ! ident_14="@(#) M_color color_name2rgb(3f) given a color name return rgb color values in range 0 to 100" character(len=*),intent(in) :: name real,intent(out) :: r,g,b character(len=*),intent(out),optional :: echoname character(len=20) :: newname !----------------------------------------------------------------------------------------------------------------------------------- ! returns name in ECHONAME; which is usually not useful unless NAME represents an integer string. ! Note that an integer converted to a string can be used to go sequentially thru the names until NEWNAME="Unknown" ! Color names can generally be listed using showrgb(1) in GNU/Linux and Unix environments that support X11 Windows: ! A structure would normally be used for the data; but a large SELECT is easy to maintain. ! a numeric name is an alias for each color to facilitate going thru them sequentially since they are not an array. select case(trim(lower(name))) case("1", "snow") ; newname="snow" ; r=255 ; g=250 ; b=250 case("2", "ghostwhite") ; newname="ghostwhite" ; r=248 ; g=248 ; b=255 case("3", "whitesmoke") ; newname="whitesmoke" ; r=245 ; g=245 ; b=245 case("4", "gainsboro") ; newname="gainsboro" ; r=220 ; g=220 ; b=220 case("5", "floralwhite") ; newname="floralwhite" ; r=255 ; g=250 ; b=240 case("6", "oldlace") ; newname="oldlace" ; r=253 ; g=245 ; b=230 case("7", "linen") ; newname="linen" ; r=250 ; g=240 ; b=230 case("8", "antiquewhite") ; newname="antiquewhite" ; r=250 ; g=235 ; b=215 case("9", "papayawhip") ; newname="papayawhip" ; r=255 ; g=239 ; b=213 case("10", "blanchedalmond") ; newname="blanchedalmond" ; r=255 ; g=235 ; b=205 case("11", "bisque") ; newname="bisque" ; r=255 ; g=228 ; b=196 case("12", "peachpuff") ; newname="peachpuff" ; r=255 ; g=218 ; b=185 case("13", "navajowhite") ; newname="navajowhite" ; r=255 ; g=222 ; b=173 case("14", "moccasin") ; newname="moccasin" ; r=255 ; g=228 ; b=181 case("15", "cornsilk") ; newname="cornsilk" ; r=255 ; g=248 ; b=220 case("16", "ivory") ; newname="ivory" ; r=255 ; g=255 ; b=240 case("17", "lemonchiffon") ; newname="lemonchiffon" ; r=255 ; g=250 ; b=205 case("18", "seashell") ; newname="seashell" ; r=255 ; g=245 ; b=238 case("19", "honeydew") ; newname="honeydew" ; r=240 ; g=255 ; b=240 case("20", "mintcream") ; newname="mintcream" ; r=245 ; g=255 ; b=250 case("21", "azure") ; newname="azure" ; r=240 ; g=255 ; b=255 case("22", "aliceblue") ; newname="aliceblue" ; r=240 ; g=248 ; b=255 case("23", "lavender") ; newname="lavender" ; r=230 ; g=230 ; b=250 case("24", "lavenderblush") ; newname="lavenderblush" ; r=255 ; g=240 ; b=245 case("25", "mistyrose") ; newname="mistyrose" ; r=255 ; g=228 ; b=225 case("26", "white") ; newname="white" ; r=255 ; g=255 ; b=255 case("27", "black") ; newname="black" ; r=0 ; g=0 ; b=0 case("28", "darkslategray") ; newname="darkslategray" ; r=47 ; g=79 ; b=79 case("29", "dimgray") ; newname="dimgray" ; r=105 ; g=105 ; b=105 case("30", "slategray") ; newname="slategray" ; r=112 ; g=128 ; b=144 case("31", "lightslategray") ; newname="lightslategray" ; r=119 ; g=136 ; b=153 case("32", "gray") ; newname="gray" ; r=190 ; g=190 ; b=190 case("33", "lightgray") ; newname="lightgray" ; r=211 ; g=211 ; b=211 case("34", "midnightblue") ; newname="midnightblue" ; r=25 ; g=25 ; b=112 case("35", "navy") ; newname="navy" ; r=0 ; g=0 ; b=128 case("36", "navyblue") ; newname="navyblue" ; r=0 ; g=0 ; b=128 case("37", "cornflowerblue") ; newname="cornflowerblue" ; r=100 ; g=149 ; b=237 case("38", "darkslateblue") ; newname="darkslateblue" ; r=72 ; g=61 ; b=139 case("39", "slateblue") ; newname="slateblue" ; r=106 ; g=90 ; b=205 case("40", "mediumslateblue") ; newname="mediumslateblue" ; r=123 ; g=104 ; b=238 case("41", "lightslateblue") ; newname="lightslateblue" ; r=132 ; g=112 ; b=255 case("42", "mediumblue") ; newname="mediumblue" ; r=0 ; g=0 ; b=205 case("43", "royalblue") ; newname="royalblue" ; r=65 ; g=105 ; b=225 case("44", "blue") ; newname="blue" ; r=0 ; g=0 ; b=255 case("45", "dodgerblue") ; newname="dodgerblue" ; r=30 ; g=144 ; b=255 case("46", "deepskyblue") ; newname="deepskyblue" ; r=0 ; g=191 ; b=255 case("47", "skyblue") ; newname="skyblue" ; r=135 ; g=206 ; b=235 case("48", "lightskyblue") ; newname="lightskyblue" ; r=135 ; g=206 ; b=250 case("49", "steelblue") ; newname="steelblue" ; r=70 ; g=130 ; b=180 case("50", "lightsteelblue") ; newname="lightsteelblue" ; r=176 ; g=196 ; b=222 case("51", "lightblue") ; newname="lightblue" ; r=173 ; g=216 ; b=230 case("52", "powderblue") ; newname="powderblue" ; r=176 ; g=224 ; b=230 case("53", "paleturquoise") ; newname="paleturquoise" ; r=175 ; g=238 ; b=238 case("54", "darkturquoise") ; newname="darkturquoise" ; r=0 ; g=206 ; b=209 case("55", "mediumturquoise") ; newname="mediumturquoise" ; r=72 ; g=209 ; b=204 case("56", "turquoise") ; newname="turquoise" ; r=64 ; g=224 ; b=208 case("57", "cyan") ; newname="cyan" ; r=0 ; g=255 ; b=255 case("58", "lightcyan") ; newname="lightcyan" ; r=224 ; g=255 ; b=255 case("59", "cadetblue") ; newname="cadetblue" ; r=95 ; g=158 ; b=160 case("60", "mediumaquamarine") ; newname="mediumaquamarine" ; r=102 ; g=205 ; b=170 case("61", "aquamarine") ; newname="aquamarine" ; r=127 ; g=255 ; b=212 case("62", "darkgreen") ; newname="darkgreen" ; r=0 ; g=100 ; b=0 case("63", "darkolivegreen") ; newname="darkolivegreen" ; r=85 ; g=107 ; b=47 case("64", "darkseagreen") ; newname="darkseagreen" ; r=143 ; g=188 ; b=143 case("65", "seagreen") ; newname="seagreen" ; r=46 ; g=139 ; b=87 case("66", "mediumseagreen") ; newname="mediumseagreen" ; r=60 ; g=179 ; b=113 case("67", "lightseagreen") ; newname="lightseagreen" ; r=32 ; g=178 ; b=170 case("68", "palegreen") ; newname="palegreen" ; r=152 ; g=251 ; b=152 case("69", "springgreen") ; newname="springgreen" ; r=0 ; g=255 ; b=127 case("70", "lawngreen") ; newname="lawngreen" ; r=124 ; g=252 ; b=0 case("71", "green") ; newname="green" ; r=0 ; g=255 ; b=0 case("72", "chartreuse") ; newname="chartreuse" ; r=127 ; g=255 ; b=0 case("73", "mediumspringgreen") ; newname="mediumspringgreen" ; r=0 ; g=250 ; b=154 case("74", "greenyellow") ; newname="greenyellow" ; r=173 ; g=255 ; b=47 case("75", "limegreen") ; newname="limegreen" ; r=50 ; g=205 ; b=50 case("76", "yellowgreen") ; newname="yellowgreen" ; r=154 ; g=205 ; b=50 case("77", "forestgreen") ; newname="forestgreen" ; r=34 ; g=139 ; b=34 case("78", "olivedrab") ; newname="olivedrab" ; r=107 ; g=142 ; b=35 case("79", "darkkhaki") ; newname="darkkhaki" ; r=189 ; g=183 ; b=107 case("80", "khaki") ; newname="khaki" ; r=240 ; g=230 ; b=140 case("81", "palegoldenrod") ; newname="palegoldenrod" ; r=238 ; g=232 ; b=170 case("82", "lightgoldenrodyellow") ; newname="lightgoldenrodyellow" ; r=250 ; g=250 ; b=210 case("83", "lightyellow") ; newname="lightyellow" ; r=255 ; g=255 ; b=224 case("84", "yellow") ; newname="yellow" ; r=255 ; g=255 ; b=0 case("85", "gold") ; newname="gold" ; r=255 ; g=215 ; b=0 case("86", "lightgoldenrod") ; newname="lightgoldenrod" ; r=238 ; g=221 ; b=130 case("87", "goldenrod") ; newname="goldenrod" ; r=218 ; g=165 ; b=32 case("88", "darkgoldenrod") ; newname="darkgoldenrod" ; r=184 ; g=134 ; b=11 case("89", "rosybrown") ; newname="rosybrown" ; r=188 ; g=143 ; b=143 case("90", "indianred") ; newname="indianred" ; r=205 ; g=92 ; b=92 case("91", "saddlebrown") ; newname="saddlebrown" ; r=139 ; g=69 ; b=19 case("92", "sienna") ; newname="sienna" ; r=160 ; g=82 ; b=45 case("93", "peru") ; newname="peru" ; r=205 ; g=133 ; b=63 case("94", "burlywood") ; newname="burlywood" ; r=222 ; g=184 ; b=135 case("95", "beige") ; newname="beige" ; r=245 ; g=245 ; b=220 case("96", "wheat") ; newname="wheat" ; r=245 ; g=222 ; b=179 case("97", "sandybrown") ; newname="sandybrown" ; r=244 ; g=164 ; b=96 case("98", "tan") ; newname="tan" ; r=210 ; g=180 ; b=140 case("99", "chocolate") ; newname="chocolate" ; r=210 ; g=105 ; b=30 case("100", "firebrick") ; newname="firebrick" ; r=178 ; g=34 ; b=34 case("101", "brown") ; newname="brown" ; r=165 ; g=42 ; b=42 case("102", "darksalmon") ; newname="darksalmon" ; r=233 ; g=150 ; b=122 case("103", "salmon") ; newname="salmon" ; r=250 ; g=128 ; b=114 case("104", "lightsalmon") ; newname="lightsalmon" ; r=255 ; g=160 ; b=122 case("105", "orange") ; newname="orange" ; r=255 ; g=165 ; b=0 case("106", "darkorange") ; newname="darkorange" ; r=255 ; g=140 ; b=0 case("107", "coral") ; newname="coral" ; r=255 ; g=127 ; b=80 case("108", "lightcoral") ; newname="lightcoral" ; r=240 ; g=128 ; b=128 case("109", "tomato") ; newname="tomato" ; r=255 ; g=99 ; b=71 case("110", "orangered") ; newname="orangered" ; r=255 ; g=69 ; b=0 case("111", "red") ; newname="red" ; r=255 ; g=0 ; b=0 case("116", "palevioletred") ; newname="palevioletred" ; r=219 ; g=112 ; b=147 case("117", "maroon") ; newname="maroon" ; r=176 ; g=48 ; b=96 case("118", "mediumvioletred") ; newname="mediumvioletred" ; r=199 ; g=21 ; b=133 case("119", "violetred") ; newname="violetred" ; r=208 ; g=32 ; b=144 case("120", "magenta") ; newname="magenta" ; r=255 ; g=0 ; b=255 case("121", "violet") ; newname="violet" ; r=238 ; g=130 ; b=238 case("122", "plum") ; newname="plum" ; r=221 ; g=160 ; b=221 case("123", "orchid") ; newname="orchid" ; r=218 ; g=112 ; b=214 case("124", "mediumorchid") ; newname="mediumorchid" ; r=186 ; g=85 ; b=211 case("125", "darkorchid") ; newname="darkorchid" ; r=153 ; g=50 ; b=204 case("126", "darkviolet") ; newname="darkviolet" ; r=148 ; g=0 ; b=211 case("127", "blueviolet") ; newname="blueviolet" ; r=138 ; g=43 ; b=226 case("128", "purple") ; newname="purple" ; r=160 ; g=32 ; b=240 case("129", "mediumpurple") ; newname="mediumpurple" ; r=147 ; g=112 ; b=219 case("130", "thistle") ; newname="thistle" ; r=216 ; g=191 ; b=216 case("131", "snow1") ; newname="snow1" ; r=255 ; g=250 ; b=250 case("132", "snow2") ; newname="snow2" ; r=238 ; g=233 ; b=233 case("133", "snow3") ; newname="snow3" ; r=205 ; g=201 ; b=201 case("134", "snow4") ; newname="snow4" ; r=139 ; g=137 ; b=137 case("135", "seashell1") ; newname="seashell1" ; r=255 ; g=245 ; b=238 case("136", "seashell2") ; newname="seashell2" ; r=238 ; g=229 ; b=222 case("137", "seashell3") ; newname="seashell3" ; r=205 ; g=197 ; b=191 case("138", "seashell4") ; newname="seashell4" ; r=139 ; g=134 ; b=130 case("139", "antiquewhite1") ; newname="antiquewhite1" ; r=255 ; g=239 ; b=219 case("140", "antiquewhite2") ; newname="antiquewhite2" ; r=238 ; g=223 ; b=204 case("141", "antiquewhite3") ; newname="antiquewhite3" ; r=205 ; g=192 ; b=176 case("142", "antiquewhite4") ; newname="antiquewhite4" ; r=139 ; g=131 ; b=120 case("143", "bisque1") ; newname="bisque1" ; r=255 ; g=228 ; b=196 case("144", "bisque2") ; newname="bisque2" ; r=238 ; g=213 ; b=183 case("145", "bisque3") ; newname="bisque3" ; r=205 ; g=183 ; b=158 case("146", "bisque4") ; newname="bisque4" ; r=139 ; g=125 ; b=107 case("147", "peachpuff1") ; newname="peachpuff1" ; r=255 ; g=218 ; b=185 case("148", "peachpuff2") ; newname="peachpuff2" ; r=238 ; g=203 ; b=173 case("149", "peachpuff3") ; newname="peachpuff3" ; r=205 ; g=175 ; b=149 case("150", "peachpuff4") ; newname="peachpuff4" ; r=139 ; g=119 ; b=101 case("151", "navajowhite1") ; newname="navajowhite1" ; r=255 ; g=222 ; b=173 case("152", "navajowhite2") ; newname="navajowhite2" ; r=238 ; g=207 ; b=161 case("153", "navajowhite3") ; newname="navajowhite3" ; r=205 ; g=179 ; b=139 case("154", "navajowhite4") ; newname="navajowhite4" ; r=139 ; g=121 ; b=94 case("155", "lemonchiffon1") ; newname="lemonchiffon1" ; r=255 ; g=250 ; b=205 case("156", "lemonchiffon2") ; newname="lemonchiffon2" ; r=238 ; g=233 ; b=191 case("157", "lemonchiffon3") ; newname="lemonchiffon3" ; r=205 ; g=201 ; b=165 case("158", "lemonchiffon4") ; newname="lemonchiffon4" ; r=139 ; g=137 ; b=112 case("159", "cornsilk1") ; newname="cornsilk1" ; r=255 ; g=248 ; b=220 case("160", "cornsilk2") ; newname="cornsilk2" ; r=238 ; g=232 ; b=205 case("161", "cornsilk3") ; newname="cornsilk3" ; r=205 ; g=200 ; b=177 case("162", "cornsilk4") ; newname="cornsilk4" ; r=139 ; g=136 ; b=120 case("163", "ivory1") ; newname="ivory1" ; r=255 ; g=255 ; b=240 case("164", "ivory2") ; newname="ivory2" ; r=238 ; g=238 ; b=224 case("165", "ivory3") ; newname="ivory3" ; r=205 ; g=205 ; b=193 case("166", "ivory4") ; newname="ivory4" ; r=139 ; g=139 ; b=131 case("167", "honeydew1") ; newname="honeydew1" ; r=240 ; g=255 ; b=240 case("168", "honeydew2") ; newname="honeydew2" ; r=224 ; g=238 ; b=224 case("169", "honeydew3") ; newname="honeydew3" ; r=193 ; g=205 ; b=193 case("170", "honeydew4") ; newname="honeydew4" ; r=131 ; g=139 ; b=131 case("171", "lavenderblush1") ; newname="lavenderblush1" ; r=255 ; g=240 ; b=245 case("172", "lavenderblush2") ; newname="lavenderblush2" ; r=238 ; g=224 ; b=229 case("173", "lavenderblush3") ; newname="lavenderblush3" ; r=205 ; g=193 ; b=197 case("174", "lavenderblush4") ; newname="lavenderblush4" ; r=139 ; g=131 ; b=134 case("175", "mistyrose1") ; newname="mistyrose1" ; r=255 ; g=228 ; b=225 case("176", "mistyrose2") ; newname="mistyrose2" ; r=238 ; g=213 ; b=210 case("177", "mistyrose3") ; newname="mistyrose3" ; r=205 ; g=183 ; b=181 case("178", "mistyrose4") ; newname="mistyrose4" ; r=139 ; g=125 ; b=123 case("179", "azure1") ; newname="azure1" ; r=240 ; g=255 ; b=255 case("180", "azure2") ; newname="azure2" ; r=224 ; g=238 ; b=238 case("181", "azure3") ; newname="azure3" ; r=193 ; g=205 ; b=205 case("182", "azure4") ; newname="azure4" ; r=131 ; g=139 ; b=139 case("183", "slateblue1") ; newname="slateblue1" ; r=131 ; g=111 ; b=255 case("184", "slateblue2") ; newname="slateblue2" ; r=122 ; g=103 ; b=238 case("185", "slateblue3") ; newname="slateblue3" ; r=105 ; g=89 ; b=205 case("186", "slateblue4") ; newname="slateblue4" ; r=71 ; g=60 ; b=139 case("187", "royalblue1") ; newname="royalblue1" ; r=72 ; g=118 ; b=255 case("188", "royalblue2") ; newname="royalblue2" ; r=67 ; g=110 ; b=238 case("189", "royalblue3") ; newname="royalblue3" ; r=58 ; g=95 ; b=205 case("190", "royalblue4") ; newname="royalblue4" ; r=39 ; g=64 ; b=139 case("191", "blue1") ; newname="blue1" ; r=0 ; g=0 ; b=255 case("192", "blue2") ; newname="blue2" ; r=0 ; g=0 ; b=238 case("193", "blue3") ; newname="blue3" ; r=0 ; g=0 ; b=205 case("194", "blue4") ; newname="blue4" ; r=0 ; g=0 ; b=139 case("195", "dodgerblue1") ; newname="dodgerblue1" ; r=30 ; g=144 ; b=255 case("196", "dodgerblue2") ; newname="dodgerblue2" ; r=28 ; g=134 ; b=238 case("197", "dodgerblue3") ; newname="dodgerblue3" ; r=24 ; g=116 ; b=205 case("198", "dodgerblue4") ; newname="dodgerblue4" ; r=16 ; g=78 ; b=139 case("199", "steelblue1") ; newname="steelblue1" ; r=99 ; g=184 ; b=255 case("200", "steelblue2") ; newname="steelblue2" ; r=92 ; g=172 ; b=238 case("201", "steelblue3") ; newname="steelblue3" ; r=79 ; g=148 ; b=205 case("202", "steelblue4") ; newname="steelblue4" ; r=54 ; g=100 ; b=139 case("203", "deepskyblue1") ; newname="deepskyblue1" ; r=0 ; g=191 ; b=255 case("204", "deepskyblue2") ; newname="deepskyblue2" ; r=0 ; g=178 ; b=238 case("205", "deepskyblue3") ; newname="deepskyblue3" ; r=0 ; g=154 ; b=205 case("206", "deepskyblue4") ; newname="deepskyblue4" ; r=0 ; g=104 ; b=139 case("207", "skyblue1") ; newname="skyblue1" ; r=135 ; g=206 ; b=255 case("208", "skyblue2") ; newname="skyblue2" ; r=126 ; g=192 ; b=238 case("209", "skyblue3") ; newname="skyblue3" ; r=108 ; g=166 ; b=205 case("210", "skyblue4") ; newname="skyblue4" ; r=74 ; g=112 ; b=139 case("211", "lightskyblue1") ; newname="lightskyblue1" ; r=176 ; g=226 ; b=255 case("212", "lightskyblue2") ; newname="lightskyblue2" ; r=164 ; g=211 ; b=238 case("213", "lightskyblue3") ; newname="lightskyblue3" ; r=141 ; g=182 ; b=205 case("214", "lightskyblue4") ; newname="lightskyblue4" ; r=96 ; g=123 ; b=139 case("215", "slategray1") ; newname="slategray1" ; r=198 ; g=226 ; b=255 case("216", "slategray2") ; newname="slategray2" ; r=185 ; g=211 ; b=238 case("217", "slategray3") ; newname="slategray3" ; r=159 ; g=182 ; b=205 case("218", "slategray4") ; newname="slategray4" ; r=108 ; g=123 ; b=139 case("219", "lightsteelblue1") ; newname="lightsteelblue1" ; r=202 ; g=225 ; b=255 case("220", "lightsteelblue2") ; newname="lightsteelblue2" ; r=188 ; g=210 ; b=238 case("221", "lightsteelblue3") ; newname="lightsteelblue3" ; r=162 ; g=181 ; b=205 case("222", "lightsteelblue4") ; newname="lightsteelblue4" ; r=110 ; g=123 ; b=139 case("223", "lightblue1") ; newname="lightblue1" ; r=191 ; g=239 ; b=255 case("224", "lightblue2") ; newname="lightblue2" ; r=178 ; g=223 ; b=238 case("225", "lightblue3") ; newname="lightblue3" ; r=154 ; g=192 ; b=205 case("226", "lightblue4") ; newname="lightblue4" ; r=104 ; g=131 ; b=139 case("227", "lightcyan1") ; newname="lightcyan1" ; r=224 ; g=255 ; b=255 case("228", "lightcyan2") ; newname="lightcyan2" ; r=209 ; g=238 ; b=238 case("229", "lightcyan3") ; newname="lightcyan3" ; r=180 ; g=205 ; b=205 case("230", "lightcyan4") ; newname="lightcyan4" ; r=122 ; g=139 ; b=139 case("231", "paleturquoise1") ; newname="paleturquoise1" ; r=187 ; g=255 ; b=255 case("232", "paleturquoise2") ; newname="paleturquoise2" ; r=174 ; g=238 ; b=238 case("233", "paleturquoise3") ; newname="paleturquoise3" ; r=150 ; g=205 ; b=205 case("234", "paleturquoise4") ; newname="paleturquoise4" ; r=102 ; g=139 ; b=139 case("235", "cadetblue1") ; newname="cadetblue1" ; r=152 ; g=245 ; b=255 case("236", "cadetblue2") ; newname="cadetblue2" ; r=142 ; g=229 ; b=238 case("237", "cadetblue3") ; newname="cadetblue3" ; r=122 ; g=197 ; b=205 case("238", "cadetblue4") ; newname="cadetblue4" ; r=83 ; g=134 ; b=139 case("239", "turquoise1") ; newname="turquoise1" ; r=0 ; g=245 ; b=255 case("240", "turquoise2") ; newname="turquoise2" ; r=0 ; g=229 ; b=238 case("241", "turquoise3") ; newname="turquoise3" ; r=0 ; g=197 ; b=205 case("242", "turquoise4") ; newname="turquoise4" ; r=0 ; g=134 ; b=139 case("243", "cyan1") ; newname="cyan1" ; r=0 ; g=255 ; b=255 case("244", "cyan2") ; newname="cyan2" ; r=0 ; g=238 ; b=238 case("245", "cyan3") ; newname="cyan3" ; r=0 ; g=205 ; b=205 case("246", "cyan4") ; newname="cyan4" ; r=0 ; g=139 ; b=139 case("247", "darkslategray1") ; newname="darkslategray1" ; r=151 ; g=255 ; b=255 case("248", "darkslategray2") ; newname="darkslategray2" ; r=141 ; g=238 ; b=238 case("249", "darkslategray3") ; newname="darkslategray3" ; r=121 ; g=205 ; b=205 case("250", "darkslategray4") ; newname="darkslategray4" ; r=82 ; g=139 ; b=139 case("251", "aquamarine1") ; newname="aquamarine1" ; r=127 ; g=255 ; b=212 case("252", "aquamarine2") ; newname="aquamarine2" ; r=118 ; g=238 ; b=198 case("253", "aquamarine3") ; newname="aquamarine3" ; r=102 ; g=205 ; b=170 case("254", "aquamarine4") ; newname="aquamarine4" ; r=69 ; g=139 ; b=116 case("255", "darkseagreen1") ; newname="darkseagreen1" ; r=193 ; g=255 ; b=193 case("256", "darkseagreen2") ; newname="darkseagreen2" ; r=180 ; g=238 ; b=180 case("257", "darkseagreen3") ; newname="darkseagreen3" ; r=155 ; g=205 ; b=155 case("258", "darkseagreen4") ; newname="darkseagreen4" ; r=105 ; g=139 ; b=105 case("259", "seagreen1") ; newname="seagreen1" ; r=84 ; g=255 ; b=159 case("260", "seagreen2") ; newname="seagreen2" ; r=78 ; g=238 ; b=148 case("261", "seagreen3") ; newname="seagreen3" ; r=67 ; g=205 ; b=128 case("262", "seagreen4") ; newname="seagreen4" ; r=46 ; g=139 ; b=87 case("263", "palegreen1") ; newname="palegreen1" ; r=154 ; g=255 ; b=154 case("264", "palegreen2") ; newname="palegreen2" ; r=144 ; g=238 ; b=144 case("265", "palegreen3") ; newname="palegreen3" ; r=124 ; g=205 ; b=124 case("266", "palegreen4") ; newname="palegreen4" ; r=84 ; g=139 ; b=84 case("267", "springgreen1") ; newname="springgreen1" ; r=0 ; g=255 ; b=127 case("268", "springgreen2") ; newname="springgreen2" ; r=0 ; g=238 ; b=118 case("269", "springgreen3") ; newname="springgreen3" ; r=0 ; g=205 ; b=102 case("270", "springgreen4") ; newname="springgreen4" ; r=0 ; g=139 ; b=69 case("271", "green1") ; newname="green1" ; r=0 ; g=255 ; b=0 case("272", "green2") ; newname="green2" ; r=0 ; g=238 ; b=0 case("273", "green3") ; newname="green3" ; r=0 ; g=205 ; b=0 case("274", "green4") ; newname="green4" ; r=0 ; g=139 ; b=0 case("275", "chartreuse1") ; newname="chartreuse1" ; r=127 ; g=255 ; b=0 case("276", "chartreuse2") ; newname="chartreuse2" ; r=118 ; g=238 ; b=0 case("277", "chartreuse3") ; newname="chartreuse3" ; r=102 ; g=205 ; b=0 case("278", "chartreuse4") ; newname="chartreuse4" ; r=69 ; g=139 ; b=0 case("279", "olivedrab1") ; newname="olivedrab1" ; r=192 ; g=255 ; b=62 case("280", "olivedrab2") ; newname="olivedrab2" ; r=179 ; g=238 ; b=58 case("281", "olivedrab3") ; newname="olivedrab3" ; r=154 ; g=205 ; b=50 case("282", "olivedrab4") ; newname="olivedrab4" ; r=105 ; g=139 ; b=34 case("283", "darkolivegreen1") ; newname="darkolivegreen1" ; r=202 ; g=255 ; b=112 case("284", "darkolivegreen2") ; newname="darkolivegreen2" ; r=188 ; g=238 ; b=104 case("285", "darkolivegreen3") ; newname="darkolivegreen3" ; r=162 ; g=205 ; b=90 case("286", "darkolivegreen4") ; newname="darkolivegreen4" ; r=110 ; g=139 ; b=61 case("287", "khaki1") ; newname="khaki1" ; r=255 ; g=246 ; b=143 case("288", "khaki2") ; newname="khaki2" ; r=238 ; g=230 ; b=133 case("289", "khaki3") ; newname="khaki3" ; r=205 ; g=198 ; b=115 case("290", "khaki4") ; newname="khaki4" ; r=139 ; g=134 ; b=78 case("291", "lightgoldenrod1") ; newname="lightgoldenrod1" ; r=255 ; g=236 ; b=139 case("292", "lightgoldenrod2") ; newname="lightgoldenrod2" ; r=238 ; g=220 ; b=130 case("293", "lightgoldenrod3") ; newname="lightgoldenrod3" ; r=205 ; g=190 ; b=112 case("294", "lightgoldenrod4") ; newname="lightgoldenrod4" ; r=139 ; g=129 ; b=76 case("295", "lightyellow1") ; newname="lightyellow1" ; r=255 ; g=255 ; b=224 case("296", "lightyellow2") ; newname="lightyellow2" ; r=238 ; g=238 ; b=209 case("297", "lightyellow3") ; newname="lightyellow3" ; r=205 ; g=205 ; b=180 case("298", "lightyellow4") ; newname="lightyellow4" ; r=139 ; g=139 ; b=122 case("299", "yellow1") ; newname="yellow1" ; r=255 ; g=255 ; b=0 case("300", "yellow2") ; newname="yellow2" ; r=238 ; g=238 ; b=0 case("301", "yellow3") ; newname="yellow3" ; r=205 ; g=205 ; b=0 case("302", "yellow4") ; newname="yellow4" ; r=139 ; g=139 ; b=0 case("303", "gold1") ; newname="gold1" ; r=255 ; g=215 ; b=0 case("304", "gold2") ; newname="gold2" ; r=238 ; g=201 ; b=0 case("305", "gold3") ; newname="gold3" ; r=205 ; g=173 ; b=0 case("306", "gold4") ; newname="gold4" ; r=139 ; g=117 ; b=0 case("307", "goldenrod1") ; newname="goldenrod1" ; r=255 ; g=193 ; b=37 case("308", "goldenrod2") ; newname="goldenrod2" ; r=238 ; g=180 ; b=34 case("309", "goldenrod3") ; newname="goldenrod3" ; r=205 ; g=155 ; b=29 case("310", "goldenrod4") ; newname="goldenrod4" ; r=139 ; g=105 ; b=20 case("311", "darkgoldenrod1") ; newname="darkgoldenrod1" ; r=255 ; g=185 ; b=15 case("312", "darkgoldenrod2") ; newname="darkgoldenrod2" ; r=238 ; g=173 ; b=14 case("313", "darkgoldenrod3") ; newname="darkgoldenrod3" ; r=205 ; g=149 ; b=12 case("314", "darkgoldenrod4") ; newname="darkgoldenrod4" ; r=139 ; g=101 ; b=8 case("315", "rosybrown1") ; newname="rosybrown1" ; r=255 ; g=193 ; b=193 case("316", "rosybrown2") ; newname="rosybrown2" ; r=238 ; g=180 ; b=180 case("317", "rosybrown3") ; newname="rosybrown3" ; r=205 ; g=155 ; b=155 case("318", "rosybrown4") ; newname="rosybrown4" ; r=139 ; g=105 ; b=105 case("319", "indianred1") ; newname="indianred1" ; r=255 ; g=106 ; b=106 case("320", "indianred2") ; newname="indianred2" ; r=238 ; g=99 ; b=99 case("321", "indianred3") ; newname="indianred3" ; r=205 ; g=85 ; b=85 case("322", "indianred4") ; newname="indianred4" ; r=139 ; g=58 ; b=58 case("323", "sienna1") ; newname="sienna1" ; r=255 ; g=130 ; b=71 case("324", "sienna2") ; newname="sienna2" ; r=238 ; g=121 ; b=66 case("325", "sienna3") ; newname="sienna3" ; r=205 ; g=104 ; b=57 case("326", "sienna4") ; newname="sienna4" ; r=139 ; g=71 ; b=38 case("327", "burlywood1") ; newname="burlywood1" ; r=255 ; g=211 ; b=155 case("328", "burlywood2") ; newname="burlywood2" ; r=238 ; g=197 ; b=145 case("329", "burlywood3") ; newname="burlywood3" ; r=205 ; g=170 ; b=125 case("330", "burlywood4") ; newname="burlywood4" ; r=139 ; g=115 ; b=85 case("331", "wheat1") ; newname="wheat1" ; r=255 ; g=231 ; b=186 case("332", "wheat2") ; newname="wheat2" ; r=238 ; g=216 ; b=174 case("333", "wheat3") ; newname="wheat3" ; r=205 ; g=186 ; b=150 case("334", "wheat4") ; newname="wheat4" ; r=139 ; g=126 ; b=102 case("335", "tan1") ; newname="tan1" ; r=255 ; g=165 ; b=79 case("336", "tan2") ; newname="tan2" ; r=238 ; g=154 ; b=73 case("337", "tan3") ; newname="tan3" ; r=205 ; g=133 ; b=63 case("338", "tan4") ; newname="tan4" ; r=139 ; g=90 ; b=43 case("339", "chocolate1") ; newname="chocolate1" ; r=255 ; g=127 ; b=36 case("340", "chocolate2") ; newname="chocolate2" ; r=238 ; g=118 ; b=33 case("341", "chocolate3") ; newname="chocolate3" ; r=205 ; g=102 ; b=29 case("342", "chocolate4") ; newname="chocolate4" ; r=139 ; g=69 ; b=19 case("343", "firebrick1") ; newname="firebrick1" ; r=255 ; g=48 ; b=48 case("344", "firebrick2") ; newname="firebrick2" ; r=238 ; g=44 ; b=44 case("345", "firebrick3") ; newname="firebrick3" ; r=205 ; g=38 ; b=38 case("346", "firebrick4") ; newname="firebrick4" ; r=139 ; g=26 ; b=26 case("347", "brown1") ; newname="brown1" ; r=255 ; g=64 ; b=64 case("348", "brown2") ; newname="brown2" ; r=238 ; g=59 ; b=59 case("349", "brown3") ; newname="brown3" ; r=205 ; g=51 ; b=51 case("350", "brown4") ; newname="brown4" ; r=139 ; g=35 ; b=35 case("351", "salmon1") ; newname="salmon1" ; r=255 ; g=140 ; b=105 case("352", "salmon2") ; newname="salmon2" ; r=238 ; g=130 ; b=98 case("353", "salmon3") ; newname="salmon3" ; r=205 ; g=112 ; b=84 case("354", "salmon4") ; newname="salmon4" ; r=139 ; g=76 ; b=57 case("355", "lightsalmon1") ; newname="lightsalmon1" ; r=255 ; g=160 ; b=122 case("356", "lightsalmon2") ; newname="lightsalmon2" ; r=238 ; g=149 ; b=114 case("357", "lightsalmon3") ; newname="lightsalmon3" ; r=205 ; g=129 ; b=98 case("358", "lightsalmon4") ; newname="lightsalmon4" ; r=139 ; g=87 ; b=66 case("359", "orange1") ; newname="orange1" ; r=255 ; g=165 ; b=0 case("360", "orange2") ; newname="orange2" ; r=238 ; g=154 ; b=0 case("361", "orange3") ; newname="orange3" ; r=205 ; g=133 ; b=0 case("362", "orange4") ; newname="orange4" ; r=139 ; g=90 ; b=0 case("363", "darkorange1") ; newname="darkorange1" ; r=255 ; g=127 ; b=0 case("364", "darkorange2") ; newname="darkorange2" ; r=238 ; g=118 ; b=0 case("365", "darkorange3") ; newname="darkorange3" ; r=205 ; g=102 ; b=0 case("366", "darkorange4") ; newname="darkorange4" ; r=139 ; g=69 ; b=0 case("367", "coral1") ; newname="coral1" ; r=255 ; g=114 ; b=86 case("368", "coral2") ; newname="coral2" ; r=238 ; g=106 ; b=80 case("369", "coral3") ; newname="coral3" ; r=205 ; g=91 ; b=69 case("370", "coral4") ; newname="coral4" ; r=139 ; g=62 ; b=47 case("371", "tomato1") ; newname="tomato1" ; r=255 ; g=99 ; b=71 case("372", "tomato2") ; newname="tomato2" ; r=238 ; g=92 ; b=66 case("373", "tomato3") ; newname="tomato3" ; r=205 ; g=79 ; b=57 case("374", "tomato4") ; newname="tomato4" ; r=139 ; g=54 ; b=38 case("375", "orangered1") ; newname="orangered1" ; r=255 ; g=69 ; b=0 case("376", "orangered2") ; newname="orangered2" ; r=238 ; g=64 ; b=0 case("377", "orangered3") ; newname="orangered3" ; r=205 ; g=55 ; b=0 case("378", "orangered4") ; newname="orangered4" ; r=139 ; g=37 ; b=0 case("379", "red1") ; newname="red1" ; r=255 ; g=0 ; b=0 case("380", "red2") ; newname="red2" ; r=238 ; g=0 ; b=0 case("381", "red3") ; newname="red3" ; r=205 ; g=0 ; b=0 case("382", "red4") ; newname="red4" ; r=139 ; g=0 ; b=0 case("112", "hotpink") ; newname="hotpink" ; r=255 ; g=105 ; b=180 case("113", "deeppink") ; newname="deeppink" ; r=255 ; g=20 ; b=147 case("115", "lightpink") ; newname="lightpink" ; r=255 ; g=182 ; b=193 case("383", "deeppink1") ; newname="deeppink1" ; r=255 ; g=20 ; b=147 case("384", "deeppink2") ; newname="deeppink2" ; r=238 ; g=18 ; b=137 case("385", "deeppink3") ; newname="deeppink3" ; r=205 ; g=16 ; b=118 case("386", "deeppink4") ; newname="deeppink4" ; r=139 ; g=10 ; b=80 case("387", "hotpink1") ; newname="hotpink1" ; r=255 ; g=110 ; b=180 case("388", "hotpink2") ; newname="hotpink2" ; r=238 ; g=106 ; b=167 case("389", "hotpink3") ; newname="hotpink3" ; r=205 ; g=96 ; b=144 case("390", "hotpink4") ; newname="hotpink4" ; r=139 ; g=58 ; b=98 case("114", "pink") ; newname="pink" ; r=255 ; g=192 ; b=203 case("391", "pink1") ; newname="pink1" ; r=255 ; g=181 ; b=197 case("392", "pink2") ; newname="pink2" ; r=238 ; g=169 ; b=184 case("393", "pink3") ; newname="pink3" ; r=205 ; g=145 ; b=158 case("394", "pink4") ; newname="pink4" ; r=139 ; g=99 ; b=108 case("395", "lightpink1") ; newname="lightpink1" ; r=255 ; g=174 ; b=185 case("396", "lightpink2") ; newname="lightpink2" ; r=238 ; g=162 ; b=173 case("397", "lightpink3") ; newname="lightpink3" ; r=205 ; g=140 ; b=149 case("398", "lightpink4") ; newname="lightpink4" ; r=139 ; g=95 ; b=101 case("399", "palevioletred1") ; newname="palevioletred1" ; r=255 ; g=130 ; b=171 case("400", "palevioletred2") ; newname="palevioletred2" ; r=238 ; g=121 ; b=159 case("401", "palevioletred3") ; newname="palevioletred3" ; r=205 ; g=104 ; b=137 case("402", "palevioletred4") ; newname="palevioletred4" ; r=139 ; g=71 ; b=93 case("403", "maroon1") ; newname="maroon1" ; r=255 ; g=52 ; b=179 case("404", "maroon2") ; newname="maroon2" ; r=238 ; g=48 ; b=167 case("405", "maroon3") ; newname="maroon3" ; r=205 ; g=41 ; b=144 case("406", "maroon4") ; newname="maroon4" ; r=139 ; g=28 ; b=98 case("407", "violetred1") ; newname="violetred1" ; r=255 ; g=62 ; b=150 case("408", "violetred2") ; newname="violetred2" ; r=238 ; g=58 ; b=140 case("409", "violetred3") ; newname="violetred3" ; r=205 ; g=50 ; b=120 case("410", "violetred4") ; newname="violetred4" ; r=139 ; g=34 ; b=82 case("411", "magenta1") ; newname="magenta1" ; r=255 ; g=0 ; b=255 case("412", "magenta2") ; newname="magenta2" ; r=238 ; g=0 ; b=238 case("413", "magenta3") ; newname="magenta3" ; r=205 ; g=0 ; b=205 case("414", "magenta4") ; newname="magenta4" ; r=139 ; g=0 ; b=139 case("415", "orchid1") ; newname="orchid1" ; r=255 ; g=131 ; b=250 case("416", "orchid2") ; newname="orchid2" ; r=238 ; g=122 ; b=233 case("417", "orchid3") ; newname="orchid3" ; r=205 ; g=105 ; b=201 case("418", "orchid4") ; newname="orchid4" ; r=139 ; g=71 ; b=137 case("419", "plum1") ; newname="plum1" ; r=255 ; g=187 ; b=255 case("420", "plum2") ; newname="plum2" ; r=238 ; g=174 ; b=238 case("421", "plum3") ; newname="plum3" ; r=205 ; g=150 ; b=205 case("422", "plum4") ; newname="plum4" ; r=139 ; g=102 ; b=139 case("423", "mediumorchid1") ; newname="mediumorchid1" ; r=224 ; g=102 ; b=255 case("424", "mediumorchid2") ; newname="mediumorchid2" ; r=209 ; g=95 ; b=238 case("425", "mediumorchid3") ; newname="mediumorchid3" ; r=180 ; g=82 ; b=205 case("426", "mediumorchid4") ; newname="mediumorchid4" ; r=122 ; g=55 ; b=139 case("427", "darkorchid1") ; newname="darkorchid1" ; r=191 ; g=62 ; b=255 case("428", "darkorchid2") ; newname="darkorchid2" ; r=178 ; g=58 ; b=238 case("429", "darkorchid3") ; newname="darkorchid3" ; r=154 ; g=50 ; b=205 case("430", "darkorchid4") ; newname="darkorchid4" ; r=104 ; g=34 ; b=139 case("431", "purple1") ; newname="purple1" ; r=155 ; g=48 ; b=255 case("432", "purple2") ; newname="purple2" ; r=145 ; g=44 ; b=238 case("433", "purple3") ; newname="purple3" ; r=125 ; g=38 ; b=205 case("434", "purple4") ; newname="purple4" ; r=85 ; g=26 ; b=139 case("435", "mediumpurple1") ; newname="mediumpurple1" ; r=171 ; g=130 ; b=255 case("436", "mediumpurple2") ; newname="mediumpurple2" ; r=159 ; g=121 ; b=238 case("437", "mediumpurple3") ; newname="mediumpurple3" ; r=137 ; g=104 ; b=205 case("438", "mediumpurple4") ; newname="mediumpurple4" ; r=93 ; g=71 ; b=139 case("439", "thistle1") ; newname="thistle1" ; r=255 ; g=225 ; b=255 case("440", "thistle2") ; newname="thistle2" ; r=238 ; g=210 ; b=238 case("441", "thistle3") ; newname="thistle3" ; r=205 ; g=181 ; b=205 case("442", "thistle4") ; newname="thistle4" ; r=139 ; g=123 ; b=139 case("443", "gray0") ; newname="gray0" ; r=0 ; g=0 ; b=0 case("444", "gray1") ; newname="gray1" ; r=3 ; g=3 ; b=3 case("445", "gray2") ; newname="gray2" ; r=5 ; g=5 ; b=5 case("446", "gray3") ; newname="gray3" ; r=8 ; g=8 ; b=8 case("447", "gray4") ; newname="gray4" ; r=10 ; g=10 ; b=10 case("448", "gray5") ; newname="gray5" ; r=13 ; g=13 ; b=13 case("449", "gray6") ; newname="gray6" ; r=15 ; g=15 ; b=15 case("450", "gray7") ; newname="gray7" ; r=18 ; g=18 ; b=18 case("451", "gray8") ; newname="gray8" ; r=20 ; g=20 ; b=20 case("452", "gray9") ; newname="gray9" ; r=23 ; g=23 ; b=23 case("453", "gray10") ; newname="gray10" ; r=26 ; g=26 ; b=26 case("454", "gray11") ; newname="gray11" ; r=28 ; g=28 ; b=28 case("455", "gray12") ; newname="gray12" ; r=31 ; g=31 ; b=31 case("456", "gray13") ; newname="gray13" ; r=33 ; g=33 ; b=33 case("457", "gray14") ; newname="gray14" ; r=36 ; g=36 ; b=36 case("458", "gray15") ; newname="gray15" ; r=38 ; g=38 ; b=38 case("459", "gray16") ; newname="gray16" ; r=41 ; g=41 ; b=41 case("460", "gray17") ; newname="gray17" ; r=43 ; g=43 ; b=43 case("461", "gray18") ; newname="gray18" ; r=46 ; g=46 ; b=46 case("462", "gray19") ; newname="gray19" ; r=48 ; g=48 ; b=48 case("463", "gray20") ; newname="gray20" ; r=51 ; g=51 ; b=51 case("464", "gray21") ; newname="gray21" ; r=54 ; g=54 ; b=54 case("465", "gray22") ; newname="gray22" ; r=56 ; g=56 ; b=56 case("466", "gray23") ; newname="gray23" ; r=59 ; g=59 ; b=59 case("467", "gray24") ; newname="gray24" ; r=61 ; g=61 ; b=61 case("468", "gray25") ; newname="gray25" ; r=64 ; g=64 ; b=64 case("469", "gray26") ; newname="gray26" ; r=66 ; g=66 ; b=66 case("470", "gray27") ; newname="gray27" ; r=69 ; g=69 ; b=69 case("471", "gray28") ; newname="gray28" ; r=71 ; g=71 ; b=71 case("472", "gray29") ; newname="gray29" ; r=74 ; g=74 ; b=74 case("473", "gray30") ; newname="gray30" ; r=77 ; g=77 ; b=77 case("474", "gray31") ; newname="gray31" ; r=79 ; g=79 ; b=79 case("475", "gray32") ; newname="gray32" ; r=82 ; g=82 ; b=82 case("476", "gray33") ; newname="gray33" ; r=84 ; g=84 ; b=84 case("477", "gray34") ; newname="gray34" ; r=87 ; g=87 ; b=87 case("478", "gray35") ; newname="gray35" ; r=89 ; g=89 ; b=89 case("479", "gray36") ; newname="gray36" ; r=92 ; g=92 ; b=92 case("480", "gray37") ; newname="gray37" ; r=94 ; g=94 ; b=94 case("481", "gray38") ; newname="gray38" ; r=97 ; g=97 ; b=97 case("482", "gray39") ; newname="gray39" ; r=99 ; g=99 ; b=99 case("483", "gray40") ; newname="gray40" ; r=102 ; g=102 ; b=102 case("484", "gray41") ; newname="gray41" ; r=105 ; g=105 ; b=105 case("485", "gray42") ; newname="gray42" ; r=107 ; g=107 ; b=107 case("486", "gray43") ; newname="gray43" ; r=110 ; g=110 ; b=110 case("487", "gray44") ; newname="gray44" ; r=112 ; g=112 ; b=112 case("488", "gray45") ; newname="gray45" ; r=115 ; g=115 ; b=115 case("489", "gray46") ; newname="gray46" ; r=117 ; g=117 ; b=117 case("490", "gray47") ; newname="gray47" ; r=120 ; g=120 ; b=120 case("491", "gray48") ; newname="gray48" ; r=122 ; g=122 ; b=122 case("492", "gray49") ; newname="gray49" ; r=125 ; g=125 ; b=125 case("493", "gray50") ; newname="gray50" ; r=127 ; g=127 ; b=127 case("494", "gray51") ; newname="gray51" ; r=130 ; g=130 ; b=130 case("495", "gray52") ; newname="gray52" ; r=133 ; g=133 ; b=133 case("496", "gray53") ; newname="gray53" ; r=135 ; g=135 ; b=135 case("497", "gray54") ; newname="gray54" ; r=138 ; g=138 ; b=138 case("498", "gray55") ; newname="gray55" ; r=140 ; g=140 ; b=140 case("499", "gray56") ; newname="gray56" ; r=143 ; g=143 ; b=143 case("500", "gray57") ; newname="gray57" ; r=145 ; g=145 ; b=145 case("501", "gray58") ; newname="gray58" ; r=148 ; g=148 ; b=148 case("502", "gray59") ; newname="gray59" ; r=150 ; g=150 ; b=150 case("503", "gray60") ; newname="gray60" ; r=153 ; g=153 ; b=153 case("504", "gray61") ; newname="gray61" ; r=156 ; g=156 ; b=156 case("505", "gray62") ; newname="gray62" ; r=158 ; g=158 ; b=158 case("506", "gray63") ; newname="gray63" ; r=161 ; g=161 ; b=161 case("507", "gray64") ; newname="gray64" ; r=163 ; g=163 ; b=163 case("508", "gray65") ; newname="gray65" ; r=166 ; g=166 ; b=166 case("509", "gray66") ; newname="gray66" ; r=168 ; g=168 ; b=168 case("510", "gray67") ; newname="gray67" ; r=171 ; g=171 ; b=171 case("511", "gray68") ; newname="gray68" ; r=173 ; g=173 ; b=173 case("512", "gray69") ; newname="gray69" ; r=176 ; g=176 ; b=176 case("513", "gray70") ; newname="gray70" ; r=179 ; g=179 ; b=179 case("514", "gray71") ; newname="gray71" ; r=181 ; g=181 ; b=181 case("515", "gray72") ; newname="gray72" ; r=184 ; g=184 ; b=184 case("516", "gray73") ; newname="gray73" ; r=186 ; g=186 ; b=186 case("517", "gray74") ; newname="gray74" ; r=189 ; g=189 ; b=189 case("518", "gray75") ; newname="gray75" ; r=191 ; g=191 ; b=191 case("519", "gray76") ; newname="gray76" ; r=194 ; g=194 ; b=194 case("520", "gray77") ; newname="gray77" ; r=196 ; g=196 ; b=196 case("521", "gray78") ; newname="gray78" ; r=199 ; g=199 ; b=199 case("522", "gray79") ; newname="gray79" ; r=201 ; g=201 ; b=201 case("523", "gray80") ; newname="gray80" ; r=204 ; g=204 ; b=204 case("524", "gray81") ; newname="gray81" ; r=207 ; g=207 ; b=207 case("525", "gray82") ; newname="gray82" ; r=209 ; g=209 ; b=209 case("526", "gray83") ; newname="gray83" ; r=212 ; g=212 ; b=212 case("527", "gray84") ; newname="gray84" ; r=214 ; g=214 ; b=214 case("528", "gray85") ; newname="gray85" ; r=217 ; g=217 ; b=217 case("529", "gray86") ; newname="gray86" ; r=219 ; g=219 ; b=219 case("530", "gray87") ; newname="gray87" ; r=222 ; g=222 ; b=222 case("531", "gray88") ; newname="gray88" ; r=224 ; g=224 ; b=224 case("532", "gray89") ; newname="gray89" ; r=227 ; g=227 ; b=227 case("533", "gray90") ; newname="gray90" ; r=229 ; g=229 ; b=229 case("534", "gray91") ; newname="gray91" ; r=232 ; g=232 ; b=232 case("535", "gray92") ; newname="gray92" ; r=235 ; g=235 ; b=235 case("536", "gray93") ; newname="gray93" ; r=237 ; g=237 ; b=237 case("537", "gray94") ; newname="gray94" ; r=240 ; g=240 ; b=240 case("538", "gray95") ; newname="gray95" ; r=242 ; g=242 ; b=242 case("539", "gray96") ; newname="gray96" ; r=245 ; g=245 ; b=245 case("540", "gray97") ; newname="gray97" ; r=247 ; g=247 ; b=247 case("541", "gray98") ; newname="gray98" ; r=250 ; g=250 ; b=250 case("542", "gray99") ; newname="gray99" ; r=252 ; g=252 ; b=252 case("543", "gray100") ; newname="gray100" ; r=255 ; g=255 ; b=255 case("544", "darkgray") ; newname="darkgray" ; r=169 ; g=169 ; b=169 case("545", "darkblue") ; newname="darkblue" ; r=0 ; g=0 ; b=139 case("546", "darkcyan") ; newname="darkcyan" ; r=0 ; g=139 ; b=139 case("547", "darkmagenta") ; newname="darkmagenta" ; r=139 ; g=0 ; b=139 case("548", "darkred") ; newname="darkred" ; r=139 ; g=0 ; b=0 case("549", "lightgreen") ; newname="lightgreen" ; r=144 ; g=238 ; b=144 case("550", "silver") ; newname="silver" ; r=192 ; g=192 ; b=192 case("551", "teal") ; newname="teal" ; r=0 ; g=128 ; b=128 case("552", "olive") ; newname="olive" ; r=128 ; g=128 ; b=0 case("553", "lime") ; newname="lime" ; r=0 ; g=255 ; b=0 case("554", "aqua") ; newname="aqua" ; r=0 ; g=255 ; b=255 case("555", "fuchsia") ; newname="fuchsia" ; r=255 ; g=0 ; b=255 case default ; newname="Unknown" ; r=255 ; g=255 ; b=255 ! unknown color name end select if(present(echoname)) then echoname = newname endif r=r/2.55; g=g/2.55; b=b/2.55 ! take values from range of 0 to 255 to 0 to 100 end subroutine color_name2rgb !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()= !=================================================================================================================================== elemental pure function lower(str) result (string) ! ident_15="@(#) M_strings lower(3f) Changes a string to lowercase over specified range" character(*), intent(In) :: str character(len(str)) :: string integer :: i string = str do i = 1, len_trim(str) ! step thru each letter in the string select case (str(i:i)) case ('A':'Z') string(i:i) = char(iachar(str(i:i))+32) ! change letter to miniscule case default end select end do end function lower !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== end module M_color