subroutine hue(modei,clr1i,clr2i,clr3i,modeo,clr1o,clr2o,clr3o,status)
character(len=*),intent(in) :: modei ! name of color model of input values
character(len=*),intent(in) :: modeo ! name of color model of output values
real,intent(in) :: clr1i,clr2i,clr3i
real,intent(out) :: clr1o,clr2o,clr3o
integer,intent(out) :: status
valid values for modei and modeo as well as the corresponding meanings for clr1*, clr2*, and clr3* are: model 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 chrominance purple-green chrominance
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
Sample program
program demo_hue
use M_color, only : hue
implicit none
! NAME RGB(0-255) HLS(0-100)
call check_name('hls', 'red', [ 100, 0, 0 ], [ 0, 50, 100 ])
call check_name('hls', 'orange', [ 100, 65, 0 ], [ 39, 50, 100 ])
call check_name('hls', 'yellow', [ 100, 100, 0 ], [ 60, 50, 100 ])
call check_name('hls', 'green', [ 0, 100, 0 ], [ 120, 50, 100 ])
call check_name('hls', 'cyan', [ 0, 100, 100 ], [ 180, 50, 100 ])
call check_name('hls', 'blue', [ 0, 0, 100 ], [ 240, 50, 100 ])
call check_name('hls', 'magenta', [ 100, 0, 100 ], [ 300, 50, 100 ])
call check_name('hls', 'black', [ 0, 0, 0 ], [ 0, 0, 0 ])
call check_name('hls', 'white', [ 100, 100, 100 ], [ 0, 100, 0 ])
call check_name('hsv', 'black', [ 0, 0, 0 ], [ 0, 0, 0 ])
! NAME RGB(0-255) HSV(0-100)
call check_name('hsv', 'gray50', [ 50, 50, 50 ], [ 0, 0, 50 ])
call check_name('hsv', 'silver', [ 75, 75, 75 ], [ 0, 0, 75 ])
call check_name('hsv', 'white', [ 100, 100, 100 ], [ 0, 0, 100 ])
call check_name('hsv', 'red4', [ 55, 0, 0 ], [ 0, 100, 55 ])
call check_name('hsv', 'red', [ 100, 0, 0 ], [ 0, 100, 100 ])
call check_name('hsv', 'olive', [ 50, 50, 0 ], [ 60, 100, 50 ])
call check_name('hsv', 'yellow', [ 100, 100, 0 ], [ 60, 100, 100 ])
call check_name('hsv', 'green', [ 0, 100, 0 ], [ 120, 100, 100 ])
call check_name('hsv', 'lime', [ 0, 100, 0 ], [ 120, 100, 100 ])
call check_name('hsv', 'teal', [ 0, 50, 50 ], [ 180, 100, 50 ])
call check_name('hsv', 'cyan', [ 0, 100, 100 ], [ 180, 100, 100 ])
call check_name('hsv', 'navy', [ 0, 0, 50 ], [ 240, 100, 50 ])
call check_name('hsv', 'blue', [ 0, 0, 100 ], [ 240, 100, 100 ])
call check_name('hsv', 'purple', [ 63, 13, 94 ], [ 277, 87, 94 ])
call check_name('hsv', 'magenta4', [ 55, 0, 55 ], [ 300, 100, 55 ])
call check_name('hsv', 'magenta', [ 100, 0, 100 ], [ 300, 100, 100 ])
call check_name('hsv', 'maroon', [ 69, 19, 38 ], [ 338, 73, 69 ])
contains
subroutine check_name(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)
write(*,*)'COLOR '//trim(name)
write(*,*)'EXPECTED '//modelout//' ====>',other
write(*,*)'RETURNED '//modelout//' ====>',int([val1+0.5,val2+0.5,val3+0.5])
write(*,*)'STATUS ==========>',status
end subroutine check_name
end program demo_hue
Results:
COLOR red
EXPECTED hls ====> 0 50 100
RETURNED hls ====> 0 50 100
STATUS ==========> 0
COLOR orange
EXPECTED hls ====> 39 50 100
RETURNED hls ====> 39 50 100
STATUS ==========> 0
COLOR yellow
EXPECTED hls ====> 60 50 100
RETURNED hls ====> 60 50 100
STATUS ==========> 0
COLOR green
EXPECTED hls ====> 120 50 100
RETURNED hls ====> 120 50 100
STATUS ==========> 0
COLOR cyan
EXPECTED hls ====> 180 50 100
RETURNED hls ====> 180 50 100
STATUS ==========> 0
COLOR blue
EXPECTED hls ====> 240 50 100
RETURNED hls ====> 240 50 100
STATUS ==========> 0
COLOR magenta
EXPECTED hls ====> 300 50 100
RETURNED hls ====> 300 50 100
STATUS ==========> 0
COLOR black
EXPECTED hls ====> 0 0 0
RETURNED hls ====> 0 0 0
STATUS ==========> 0
COLOR white
EXPECTED hls ====> 0 100 0
RETURNED hls ====> 0 100 0
STATUS ==========> 0
COLOR black
EXPECTED hsv ====> 0 0 0
RETURNED hsv ====> 0 0 0
STATUS ==========> 0
COLOR gray50
EXPECTED hsv ====> 0 0 50
RETURNED hsv ====> 0 0 50
STATUS ==========> 0
COLOR silver
EXPECTED hsv ====> 0 0 75
RETURNED hsv ====> 0 0 75
STATUS ==========> 0
COLOR white
EXPECTED hsv ====> 0 0 100
RETURNED hsv ====> 0 0 100
STATUS ==========> 0
COLOR red4
EXPECTED hsv ====> 0 100 55
RETURNED hsv ====> 0 100 55
STATUS ==========> 0
COLOR red
EXPECTED hsv ====> 0 100 100
RETURNED hsv ====> 0 100 100
STATUS ==========> 0
COLOR olive
EXPECTED hsv ====> 60 100 50
RETURNED hsv ====> 60 100 50
STATUS ==========> 0
COLOR yellow
EXPECTED hsv ====> 60 100 100
RETURNED hsv ====> 60 100 100
STATUS ==========> 0
COLOR green
EXPECTED hsv ====> 120 100 100
RETURNED hsv ====> 120 100 100
STATUS ==========> 0
COLOR lime
EXPECTED hsv ====> 120 100 100
RETURNED hsv ====> 120 100 100
STATUS ==========> 0
COLOR teal
EXPECTED hsv ====> 180 100 50
RETURNED hsv ====> 180 100 50
STATUS ==========> 0
COLOR cyan
EXPECTED hsv ====> 180 100 100
RETURNED hsv ====> 180 100 100
STATUS ==========> 0
COLOR navy
EXPECTED hsv ====> 240 100 50
RETURNED hsv ====> 240 100 50
STATUS ==========> 0
COLOR blue
EXPECTED hsv ====> 240 100 100
RETURNED hsv ====> 240 100 100
STATUS ==========> 0
COLOR purple
EXPECTED hsv ====> 277 87 94
RETURNED hsv ====> 277 86 94
STATUS ==========> 0
COLOR magenta4
EXPECTED hsv ====> 300 100 55
RETURNED hsv ====> 300 100 55
STATUS ==========> 0
COLOR magenta
EXPECTED hsv ====> 300 100 100
RETURNED hsv ====> 300 100 100
STATUS ==========> 0
COLOR maroon
EXPECTED hsv ====> 338 73 69
RETURNED hsv ====> 337 72 69
STATUS ==========> 0