M_color Module

M_color(3) - [M_color::INTRO] a Fortran module that lets you
convert between common color models (LICENSE:PD)

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 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

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

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