hue – M

public subroutine hue(modei, clr1i, clr2i, clr3i, modeo, clr1o, clr2o, clr3o, status)

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

Arguments

Type	Intent		Name
character(len=*),	intent(in)	::	modei
real,	intent(in)	::	clr1i
real,	intent(in)	::	clr2i
real,	intent(in)	::	clr3i
character(len=*),	intent(in)	::	modeo
real,	intent(out)	::	clr1o
real,	intent(out)	::	clr2o
real,	intent(out)	::	clr3o
integer,	intent(out)	::	status

Source Code

hue

Source Code

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

hue Subroutine

Contents

Source Code

public subroutine hue(modei, clr1i, clr2i, clr3i, modeo, clr1o, clr2o, clr3o, status)

NAME

SYNOPSIS

DESCRIPTION

EXAMPLE

AUTHOR

LICENSE

Arguments

Contents

Source Code

Source Code