HUE(3f) - [M_pixel:COLOR] converts color components from one color
model to another
(LICENSE:PD)
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
Basic color models:
+----------------------------------------------------------+
| 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 |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
Sample program
program demo_hue
use M_pixel, 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
John S. Urban
Public Domain
| Type | Intent | Optional | Attributes | 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 |
subroutine hue(modei,clr1i,clr2i,clr3i,modeo,clr1o,clr2o,clr3o,status)
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 .eq. 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.eq.'hls' .and. output_color_model.eq.'hsl' &
& .or.input_color_model.eq.'hsl' .and. output_color_model.eq.'hls' &
& .or.input_color_model.eq.'hvs' .and. output_color_model.eq.'hsv' &
& .or.input_color_model.eq.'hsv' .and. output_color_model.eq.'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 .ne. 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 .ne. 0 )then
return
endif
!-----------------------------------------------------------------------------------------------------------------------------------
end subroutine hue