M_color(3) - [M_color::INTRO] a Fortran module that lets you convert between common color models (LICENSE:PD)
Synopsis
Description
Example
References
Author
License
use M_color, only : &
& hue, & & closest_color_name, & & color_name2rgb, & & rgbmono
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 colors 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)
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:
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:
o One converts that model to the RGB model o The other converts from RGB to that model
call modelA2rgb(...) call rgb2modelB(...)The resulting internal routines are:
HLSRGB: given hue, lightness, saturation calculate red, green, and blue components
o 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
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) :: echoname real :: red,green,blue real :: gray integer :: ierr ! find the names of colors given RGB values write(*,*)Find names given valuescall 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
The algorithms are based on chapter 17 of "Fundamentals of Interactive Computer Graphics"; J. D. Foley and A. Van Dam.
John S. Urban
Public Domain
Nemo Release 3.1 | M_color (3m_color) | November 11, 2023 |