test26.f90 Source File


This file depends on

sourcefile~~test26.f90~~EfferentGraph sourcefile~test26.f90 test26.f90 sourcefile~forimage.f90 forimage.f90 sourcefile~test26.f90->sourcefile~forimage.f90 sourcefile~forcolor.f90 forcolor.f90 sourcefile~forimage.f90->sourcefile~forcolor.f90 sourcefile~forimage_parameters.f90 forimage_parameters.f90 sourcefile~forimage.f90->sourcefile~forimage_parameters.f90 sourcefile~lut.f90 lut.f90 sourcefile~forimage.f90->sourcefile~lut.f90 sourcefile~pnm.f90 pnm.f90 sourcefile~forimage.f90->sourcefile~pnm.f90 sourcefile~forcolor.f90->sourcefile~forimage_parameters.f90 sourcefile~forcolor.f90->sourcefile~pnm.f90 sourcefile~pnm.f90->sourcefile~forimage_parameters.f90

Source Code

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