test_suite_m_color Subroutine

public subroutine test_suite_m_color()

Arguments

None

Contents

Source Code


Subroutines

subroutine test_rgbmono()

Arguments

None

Source Code

subroutine test_suite_m_color
call test_hue()                 ! converts a color's components from one color model to another
call test_closest_color_name()  ! given RGB values, try to find closest named color
call test_color_name2rgb()      ! given a color name, return rgb color values in range 0 to 100
call test_rgbmono()             ! convert RGB colors to a reasonable grayscale
contains
!TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
subroutine test_rgbmono()
real :: gray
integer :: ierr
call unit_check_start('rgbmono')
   call rgbmono(100.0,  0.0,  0.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.30, msg='red     ')
   call rgbmono(  0.0,100.0,  0.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.59, msg='green   ')
   call rgbmono(  0.0,  0.0,100.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.11, msg='blue    ')
   call rgbmono(100.0,100.0,  0.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.89, msg='Yellow  ')
   call rgbmono(  0.0,100.0,100.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.70, msg='Cyan    ')
   call rgbmono(100.0,  0.0,100.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.41, msg='Magenta ')
   call rgbmono(100.0,100.0,100.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.100,msg='White   ')
   call rgbmono( 00.0,  0.0,  0.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.0,  msg='Black   ')
   call rgbmono( 50.0,  0.0,  0.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.15, msg='Maroon  ')
   call rgbmono(100.0, 50.0, 50.0,gray,ierr); call unit_check('rgbmono',int(gray+0.5).eq.65, msg='Pink    ')
call unit_check_done('rgbmono')
end subroutine test_rgbmono
end subroutine test_suite_m_color