save Subroutine

private impure elemental subroutine save(this, file_name, height, width)

Type Bound

color

Arguments

Type IntentOptional Attributes Name
class(color), intent(inout) :: this
character(len=*), intent(in), optional :: file_name
integer, intent(in), optional :: height
integer, intent(in), optional :: width

Calls

proc~~save~~CallsGraph proc~save color%save proc~export_pnm format_pnm%export_pnm proc~save->proc~export_pnm proc~set_pnm format_pnm%set_pnm proc~save->proc~set_pnm proc~set_format format_pnm%set_format proc~export_pnm->proc~set_format proc~write_header write_header proc~export_pnm->proc~write_header proc~allocate_pixels format_pnm%allocate_pixels proc~set_pnm->proc~allocate_pixels proc~set_file_format format_pnm%set_file_format proc~set_pnm->proc~set_file_format proc~set_pnm->proc~set_format proc~set_header format_pnm%set_header proc~set_pnm->proc~set_header proc~set_pixels format_pnm%set_pixels proc~set_pnm->proc~set_pixels proc~set_comment format_pnm%set_comment proc~set_header->proc~set_comment proc~set_height format_pnm%set_height proc~set_header->proc~set_height proc~set_magicnumber format_pnm%set_magicnumber proc~set_header->proc~set_magicnumber proc~set_max_color format_pnm%set_max_color proc~set_header->proc~set_max_color proc~set_width format_pnm%set_width proc~set_header->proc~set_width proc~check_pixel_range format_pnm%check_pixel_range proc~set_pixels->proc~check_pixel_range

Source Code

   elemental impure subroutine save(this, file_name, height, width)
      class(color), intent(inout) :: this
      character(len=*), intent(in), optional :: file_name
      integer, intent(in), optional :: height, width
      type(format_pnm) :: image
      integer :: height_, width_
      integer(ik), dimension(:,:), allocatable :: px

      if (present(height)) then
         height_ = height
      else
         height_ = 50
      end if
      if (present(width)) then
         width_ = width
      else
         width_ = 50
      end if

      allocate(px(height_, 3*width_))

      px(:,1:3*width_-2:3) = this%r
      px(:,2:3*width_-1:3) = this%g
      px(:,3:3*width_-0:3) = this%b

      call image%set_pnm(&
         encoding    = 'binary', &
         file_format = 'ppm', &
         width       = width_, &
         height      = height_, &
         max_color   = 255, &
         comment     = trim(this%color_name), &
         pixels      = px &
         )

      if (present(file_name)) then
         call image%export_pnm(trim(file_name))
      else
         call image%export_pnm('pnm_files/colors/'//trim(this%color_name))
      end if

   end subroutine save