pgmio.f90

! *************************************************
!
! Module for reading/writing compressed pgm files.
! Author: Plyusch Gregory
! Use this module only for compressed pgm files with 255 maximum value per pixel.
!
! *************************************************

module pgmio

implicit none

integer, parameter, private :: iounit = 10

public :: pgmsize, pgmread, pgmwriteheader, pgmappendbytes

contains

subroutine pgmsize(filename, nx, ny, offset)
  implicit none
  character(len=:), allocatable :: width, height, maxval, total, comments
  character*(*), intent(in) :: filename
  character(1) :: onechar
  character(2) :: type
  integer :: mypos
  integer, intent(out) :: nx, ny, offset

  width = ''
  height = ''
  maxval = ''
  total = ''
  comments = ''

  open(unit=iounit, file=filename, status='old',form='unformatted',access='stream')

  ! reading pgm type
  read(iounit) type
  read(iounit) onechar
  total = total//type//onechar
  call skipcomments(comments) !skipping comments
  inquire(iounit, pos=mypos)

  ! reading image width
  read(iounit, pos=mypos-1) onechar
  do while (onechar /= ' ')
    width = width//onechar
    read(iounit) onechar
    total = total//onechar
  end do
  call skipcomments(comments)
  inquire(iounit, pos=mypos)

  ! reading image height
  read(iounit, pos=mypos-1) onechar
  do while (ichar(onechar) /= 10)
    height = height//onechar
    read(iounit) onechar
    total = total//onechar
  end do
  call skipcomments(comments)
  inquire(iounit, pos=mypos)

  ! reading image value for white color
  read(iounit, pos=mypos-1) onechar
  do while (ichar(onechar) /= 10)
    maxval = maxval//onechar
    read(iounit) onechar
    total = total//onechar
  end do
  read(width,'(i4)') nx
  read(height,'(i4)') ny

  total = total//comments
  offset = len(total)+1

  close(unit=iounit)

end subroutine pgmsize

subroutine pgmread(filename, offset, w, h, imgmatrix, startX, startY)
  implicit none
  character*(*), intent(in) :: filename
  integer, intent(in) :: startX, startY
  double precision, intent(inout) :: imgmatrix(startX:,startY:)
  character(1), allocatable :: bitmap(:,:)
  integer, intent(in) :: offset, w, h

  open(unit=iounit, file=filename, status='old',form='unformatted',access='stream')

  
  allocate (bitmap(w,h))
  !allocate (imgmatrix(-left+1:nxt+right,-top+1:nyt+bottom))
  read(iounit, pos=offset) bitmap
  close(unit=iounit)

  ! converting signed int to unsigned value in double precision type

  !imgmatrix(1:nxt,1:nyt) = bitmap(:,:)+256
  ! Where(bitmap(1:w,1:h) < 0)
  !   imgmatrix(1:w,1:h) = bitmap(1:w,1:h)+256
  ! ElseWhere
  !   imgmatrix(1:w,1:h) = bitmap(1:w,1:h)
  ! End Where

  imgmatrix(1:w,1:h) = ichar(bitmap)
  deallocate(bitmap)
  !imgmatrix = imgmatrix

end subroutine pgmread

subroutine pgmwriteheader(filename, width, height)

  implicit none

  character*(*), intent(in) :: filename
  character(2) :: type = 'P5'

  integer, intent(in) :: width, height
  character(len=10) :: swidth, sheight

  write(swidth, '(i10)') width
  write(sheight, '(i10)') height

  open(unit=iounit, file=filename, status='new',form='unformatted',access='stream')

  write(iounit) type
  write(iounit) char(10)
  write(iounit) trim(adjustl(swidth))//' '//trim(adjustl(sheight))
  write(iounit) char(10)
  write(iounit) '255'
  write(iounit) char(10)

  close(unit=iounit)

end subroutine pgmwriteheader

subroutine pgmappendbytes(filename, x, startX, startY)

  implicit none

  character*(*), intent(in) :: filename

  integer :: width, height
  integer, intent(in) :: startX, startY
  double precision, intent(inout) :: x(startX:,startY:)
  character(len=10) :: swidth, sheight

  width = size(x,1)
  height = size(x,2)

  write(swidth, '(i10)') width
  write(sheight, '(i10)') height

  open(unit=iounit, file=filename, status='old', position='append', action='write', form='unformatted', access='stream')

  write(iounit) int(x, kind=1)

  close(unit=iounit)

end subroutine pgmappendbytes

  recursive subroutine skipcomments(comments)
    implicit none
    character(len=:), allocatable, intent(inout) :: comments
    character(1) :: c
    read(iounit) c
    comments = comments//c
    if (c == "#") then
      !comment section
      do while (ichar(c) /= 10)
        read(iounit) c
        comments = comments//c
      end do
      call skipcomments(comments)
    end if
  end subroutine skipcomments


end module pgmio