find_nearest Subroutine

private pure elemental subroutine find_nearest(this, nearest_color)

Type Bound

color

Arguments

Type IntentOptional Attributes Name
class(color), intent(inout) :: this
type(color), intent(out) :: nearest_color

Calls

proc~~find_nearest~~CallsGraph proc~find_nearest color%find_nearest proc~get_rgb color%get_rgb proc~find_nearest->proc~get_rgb proc~initialize_colors initialize_colors proc~find_nearest->proc~initialize_colors proc~convert color%convert proc~initialize_colors->proc~convert proc~set color%set proc~initialize_colors->proc~set proc~cmyk_to_rgb cmyk_to_rgb proc~convert->proc~cmyk_to_rgb proc~decimal_to_rgb decimal_to_rgb proc~convert->proc~decimal_to_rgb proc~hex_to_rgb hex_to_rgb proc~convert->proc~hex_to_rgb proc~hsl_to_rgb hsl_to_rgb proc~convert->proc~hsl_to_rgb proc~hsv_to_rgb hsv_to_rgb proc~convert->proc~hsv_to_rgb proc~rgb_to_cmyk rgb_to_cmyk proc~convert->proc~rgb_to_cmyk proc~rgb_to_decimal rgb_to_decimal proc~convert->proc~rgb_to_decimal proc~rgb_to_hex rgb_to_hex proc~convert->proc~rgb_to_hex proc~rgb_to_hsl rgb_to_hsl proc~convert->proc~rgb_to_hsl proc~rgb_to_hsv rgb_to_hsv proc~convert->proc~rgb_to_hsv proc~rgb_to_xyz rgb_to_xyz proc~convert->proc~rgb_to_xyz proc~xyz_to_rgb xyz_to_rgb proc~convert->proc~xyz_to_rgb proc~set_by_name color%set_by_name proc~set->proc~set_by_name proc~set_cmyk color%set_cmyk proc~set->proc~set_cmyk proc~set_decimal color%set_decimal proc~set->proc~set_decimal proc~set_hex color%set_hex proc~set->proc~set_hex proc~set_hsl color%set_hsl proc~set->proc~set_hsl proc~set_hsv color%set_hsv proc~set->proc~set_hsv proc~set_name color%set_name proc~set->proc~set_name proc~set_rgb color%set_rgb proc~set->proc~set_rgb proc~set_xyz color%set_xyz proc~set->proc~set_xyz proc~set_by_name->proc~initialize_colors

Called by

proc~~find_nearest~~CalledByGraph proc~find_nearest color%find_nearest program~demo_color demo_color program~demo_color->proc~find_nearest program~example27 example27 program~example27->proc~find_nearest

Source Code

   elemental pure subroutine find_nearest(this, nearest_color)
      class(color), intent(inout) :: this
      type(color),  intent(out)   :: nearest_color
      integer(ik) :: i, closestColorIndex, ri, gi, bi
      real(rk)    :: dist, min_dist
      type(color), dimension(:), allocatable :: colors

      call initialize_colors(colors)

      min_dist = huge(min_dist)
      closestColorIndex = 0

      do concurrent (i = 1: size(colors))
         call colors(i)%get_rgb(ri, gi, bi)
         dist = sqrt(&
            (real((ri-this%r), kind=rk)/255.0_rk)**2&
            + (real((gi-this%g), kind=rk)/255.0_rk)**2&
            + (real((bi-this%b), kind=rk)/255.0_rk)**2&
            )
         if (dist < min_dist) then
            min_dist = dist
            closestColorIndex = i
         end if
      end do

      if (closestColorIndex == 0) then
         error stop 'error: no color found'
      else
         nearest_color = colors(closestColorIndex)
      end if

   end subroutine find_nearest