main.f90

module ppm
    implicit none
    public loadppm, saveppm, blurppm

    type ppmfile
        integer              :: depth, width, height
        integer, allocatable :: data( :, :, : )

        contains
            procedure, public :: load  => loadppm
            procedure, public :: save  => saveppm
            procedure, public :: blur  => blurppm
            procedure, public :: print => printppm
    end type ppmfile

    contains
        subroutine printppm( this )
            class( ppmfile ), intent( in ) :: this

            integer :: x, y

            do y = 1, this%width
                do x = 1, this%height
                    print *, this%data( 1, y, x ), this%data( 2, y, x ), this%data( 3, y, x )
                end do
            end do
        end subroutine printppm

        subroutine loadppm( this, filename )
            class( ppmfile )                   :: this
            character( len = * ), intent( in ) :: filename

            integer              :: funit, cdepth, cwidth, cheight, x, y, cr, cg, cb, reason
            character( 2 )       :: header

            open( newunit = funit, file = filename, status = 'old', action = 'read', access = 'stream', form = 'formatted' )

            read( funit, '(a2)' ) header
            if ( header /= 'P3' ) then
                print *, "Invalid file type detected."
                stop
            end if

            read( funit, * ) cwidth, cheight
            read( funit, * ) cdepth

            print *, 'cwidth  = ', cwidth
            print *, 'cheight = ', cheight
            print *, 'cdepth  = ', cdepth

            if ( cdepth /= 255 ) then
                print *, "Invalid colour depth detected."
                stop
            end if

            this%width  = cwidth
            this%height = cheight
            this%depth  = cdepth

            print *, 'Width, height, and depth assigned, reading in colour values...'

            allocate( this%data( 3, this%width, this%height ) )

            do y = 1, this%width
                do x = 1, this%height
                    read( funit, *, IOSTAT = reason ) cr, cg, cb

                    if ( reason < 0 ) then
                        ! EOF reached
                        exit
                        exit
                    end if

                    this%data( 1, y, x ) = cr
                    this%data( 2, y, x ) = cg
                    this%data( 3, y, x ) = cb
                end do
            end do

            close( funit )
        end subroutine loadppm

        subroutine saveppm( this, filename )
            class( ppmfile ),     intent( in ) :: this
            character( len = * ), intent( in ) :: filename

            integer :: funit, x, y, r, g, b, w, h

            open( newunit = funit, file = filename, status = 'replace', action = 'write', access = 'stream', form = 'formatted' )

            write( funit, '(a2)'        ) "P3"
            write( funit, '(i0, a, i0)' ) this%width, ' ', this%height
            write( funit, '(i0)'        ) this%depth

            w = this%width
            h = this%height

            print *, 'Width  = ', w
            print *, 'Height = ', h

            do y = 1, w
                do x = 1, h
                    r = this%data( 1, y, x )
                    g = this%data( 2, y, x )
                    b = this%data( 3, y, x )

                    if ( r > 255 .or. g > 255 .or. b > 255 ) then
                        print *, "There's incorrect values in the data!"
                        print *, r, g, b
                        call exit( -1 )
                    end if

                    write( funit, '(i0, a, i0, a, i0, a)', advance = 'no' ) r, ' ', g, ' ', b, ' '
                end do
            end do

            flush( funit )
            close( funit )
        end subroutine saveppm

        subroutine blurppm( this )
            class( ppmfile ), intent( in ) :: this
        end subroutine blurppm
end module ppm

program main
    use ppm
    implicit none
    type( ppmfile ) :: ppmf

    print *, 'Testing ppm reading...'

    call ppmf%load( filename = "tiny.ppm" )

    print *, 'PPM file read in.'
    print *, ' Width  = ', ppmf%width
    print *, ' Height = ', ppmf%height
    print *, ' Depth  = ', ppmf%depth

    print *, 'Testing saving...'

    call ppmf%print()

    call ppmf%save( filename = "tiny-new.ppm" )
end program main