program example26
use forimage, only: rk, ik, color
implicit none
type(color) :: custom_color
integer(ik) :: r, g, b
character(len=7) :: hex
integer(ik) :: decimal
integer(ik) :: c, m, y, k
real(rk) :: h, s, v
real(rk) :: hl, sl, vl
real(rk) :: xyz_x, xyz_y, xyz_z
character(len=30) :: name
real(rk), parameter :: tol = 1e-4_rk
! Set the color using RGB values
call custom_color%set(name='custom_color', r=245_ik, g=127_ik, b=64_ik)
! Convert the color to other color spaces
call custom_color%convert('rgb2all')
! Get the name of the color
call custom_color%get(name)
! Get the values of the color in other color spaces
call custom_color%get(r=r, g=g, b=b)
call custom_color%get(hex=hex)
call custom_color%get(decimal=decimal)
call custom_color%get(c=c, m=m, y=y, k=k)
call custom_color%get(h=h, s=s, v=v)
call custom_color%get(hl=hl, sl=sl, vl=vl)
call custom_color%get(xyz_x=xyz_x, xyz_y=xyz_y, xyz_z=xyz_z)
!
call custom_color%print()
! Check the values
call check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
! Set the color using a hex value
call custom_color%set(name='custom_color', hex='#F57F40')
! Convert the color to other color spaces
call custom_color%convert('hex2all')
! Get the values of the color in other color spaces
call custom_color%get(r=r, g=g, b=b)
call custom_color%get(hex=hex)
call custom_color%get(decimal=decimal)
call custom_color%get(c=c, m=m, y=y, k=k)
call custom_color%get(h=h, s=s, v=v)
call custom_color%get(hl=hl, sl=sl, vl=vl)
call custom_color%get(xyz_x=xyz_x, xyz_y=xyz_y, xyz_z=xyz_z)
!
call custom_color%print()
! Check the values
call check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
! Set the color using a decimal value
call custom_color%set(name='custom_color', decimal=16088896_ik)
! Convert the color to other color spaces
call custom_color%convert('decimal2all')
! Get the values of the color in other color spaces
call custom_color%get(r=r, g=g, b=b)
call custom_color%get(hex=hex)
call custom_color%get(decimal=decimal)
call custom_color%get(c=c, m=m, y=y, k=k)
call custom_color%get(h=h, s=s, v=v)
call custom_color%get(hl=hl, sl=sl, vl=vl)
call custom_color%get(xyz_x=xyz_x, xyz_y=xyz_y, xyz_z=xyz_z)
!
call custom_color%print()
! Check the values
call check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
! Set the color using a decimal value
call custom_color%set(name='custom_color', c=0_ik, m=48_ik, y=74_ik, k=4_ik)
! Convert the color to other color spaces
call custom_color%convert('cmyk2all')
! Get the values of the color in other color spaces
call custom_color%get(r=r, g=g, b=b)
call custom_color%get(hex=hex)
call custom_color%get(decimal=decimal)
call custom_color%get(c=c, m=m, y=y, k=k)
call custom_color%get(h=h, s=s, v=v)
call custom_color%get(hl=hl, sl=sl, vl=vl)
call custom_color%get(xyz_x=xyz_x, xyz_y=xyz_y, xyz_z=xyz_z)
!
call custom_color%print()
! Check the values
call check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
! Set the color using a hsv value
call custom_color%set(name='custom_color', h=20.8840_rk, s=73.8776_rk, v=96.0784_rk)
! Convert the color to other color spaces
call custom_color%convert('hsv2all')
! Get the values of the color in other color spaces
call custom_color%get(r=r, g=g, b=b)
call custom_color%get(hex=hex)
call custom_color%get(decimal=decimal)
call custom_color%get(c=c, m=m, y=y, k=k)
call custom_color%get(h=h, s=s, v=v)
call custom_color%get(hl=hl, sl=sl, vl=vl)
call custom_color%get(xyz_x=xyz_x, xyz_y=xyz_y, xyz_z=xyz_z)
!
call custom_color%print()
! Check the values
call check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
! Set the color using a hsv value
call custom_color%set(name='custom_color', hl=20.8840_rk, sl=90.0498_rk, vl=60.5882_rk)
! Convert the color to other color spaces
call custom_color%convert('hsl2all')
! Get the values of the color in other color spaces
call custom_color%get(r=r, g=g, b=b)
call custom_color%get(hex=hex)
call custom_color%get(decimal=decimal)
call custom_color%get(c=c, m=m, y=y, k=k)
call custom_color%get(h=h, s=s, v=v)
call custom_color%get(hl=hl, sl=sl, vl=vl)
call custom_color%get(xyz_x=xyz_x, xyz_y=xyz_y, xyz_z=xyz_z)
!
call custom_color%print()
! Check the values
call check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
! Set the color using a hsv value
call custom_color%set(name='custom_color', xyz_x=46.1753_rk, xyz_y=34.9669_rk, xyz_z=9.1672_rk)
! Convert the color to other color spaces
call custom_color%convert('xyz2all')
! Get the values of the color in other color spaces
call custom_color%get(r=r, g=g, b=b)
call custom_color%get(hex=hex)
call custom_color%get(decimal=decimal)
call custom_color%get(c=c, m=m, y=y, k=k)
call custom_color%get(h=h, s=s, v=v)
call custom_color%get(hl=hl, sl=sl, vl=vl)
call custom_color%get(xyz_x=xyz_x, xyz_y=xyz_y, xyz_z=xyz_z)
!
call custom_color%print()
! Check the values
call check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
contains
subroutine check(tol, name, r, g, b, hex, decimal, c, m, y, k, h, s, v, hl, sl, vl, xyz_x, xyz_y, xyz_z)
character(len=*), intent(in) :: name
integer(ik), intent(in) :: r, g, b
character(len=*), intent(in) :: hex
integer(ik), intent(in) :: decimal
integer(ik), intent(in) :: c, m, y, k
real(rk), intent(in) :: h, s, v
real(rk), intent(in) :: hl, sl, vl
real(rk), intent(in) :: xyz_x, xyz_y, xyz_z
real(rk), intent(in) :: tol
! check output:
if (name /= 'custom_color') print *, 'ERROR: name /= ''custom_color'''
if (r /= 245_ik) print *, 'ERROR: r /= 245'
if (g /= 127_ik) print *, 'ERROR: g /= 127'
if (b /= 64_ik) print *, 'ERROR: b /= 64'
if (hex /= '#F57F40') print *, 'ERROR: hex /= ''#F57F40'''
if (decimal /= 16088896_ik) print *, 'ERROR: decimal /= 16088896'
if (c /= 0_ik) print *, 'ERROR: c /= 0'
if (m /= 48_ik) print *, 'ERROR: m /= 48'
if (y /= 74_ik) print *, 'ERROR: y /= 74'
if (k /= 4_ik) print *, 'ERROR: k /= 4'
if (abs(h - 20.883977900552487_rk) > tol ) print *, 'ERROR: h /= 20.8840'
if (abs(s - 73.877551020408163_rk) > tol ) print *, 'ERROR: s /= 73.8776'
if (abs(v - 96.078431372549019_rk) > tol ) print *, 'ERROR: v /= 96.0784'
if (abs(hl - 20.883977900552487_rk) > tol ) print *, 'ERROR: hl /= 20.8840'
if (abs(sl - 90.049751243781117_rk) > tol ) print *, 'ERROR: sl /= 90.0498'
if (abs(vl - 60.588235294117652_rk) > tol ) print *, 'ERROR: vl /= 60.5882'
if (abs(xyz_x - 46.175296219509761_rk) > tol ) print *, 'ERROR: xyz_x /= 46.1753'
if (abs(xyz_y - 34.966900449347115_rk) > tol ) print *, 'ERROR: xyz_y /= 34.9669'
if (abs(xyz_z - 9.1671542959237478_rk) > tol ) print *, 'ERROR: xyz_z /= 9.1672'
end subroutine check
end program example26