屈辱の画像変換ｗ

（追記 R6 夏：AIの力を借りて Windows での Fortran only jpg, png etc. I/O ができました。） fortran66.hatenablog.com

Fortran で jpg や png を読み書きするのに、Python スクリプトを内部生成してテンポラリな bmp ファイルを経由して I/O するという屈辱的な方法を使ってみます。まぁどうせどんなファイルも読み込めば BMP になるんだし～手段をえらばず。

python script を生成して実行。bmp ファイルに/から変換する

        subroutine conv_bmp(fn_in, fn_out)
            character(*), intent(in) :: fn_in, fn_out
            character(*), parameter :: fn_tmp = 'my_python_tmp.py'
            integer :: iw
            open(newunit = iw, file = fn_tmp)
            write(iw, '(a)') 'from PIL import Image'
            write(iw, '(*(a))') 'img = Image.open("', trim(fn_in), '").convert("RGB")'
            write(iw, '(*(a))') 'img.save("', trim(fn_out), '")'
            close(iw)
            call execute_command_line('python3 '//fn_tmp)
            call delete_file(fn_tmp)
        end subroutine conv_bmp

実行例

 image size         535         210

入力 1966.png

出力 1966_without_red.jpg

赤色を消します。符号なし 8 bit 整数の代用として文字を使っています。

bmp%rgb(:,:)%r = achar(0)

open(iw, fn)
close(iw, status = 'delete')

でテンポラリファイルを消しています。

write(iw, '(*(a))') 'img = Image.open("', trim(fn_in), '").convert("RGB")'

Python の pillow を使っています。Fortran 側の BMP I/O が 24 bit RGB 専用なので、読み込む時に .convert("RGB") をつけておく必要があるようです。

    module m_bmp
        use, intrinsic :: iso_fortran_env
        implicit none
        type :: t_bmp_file_header
            sequence  
            integer(int16) :: bfType = transfer('BM', 0_int16) ! BitMap
            integer(int32) :: bfSize          ! file size in bytes
            integer(int16) :: bfReserved1 = 0 ! always 0
            integer(int16) :: bfReserved2 = 0 ! always 0
            integer(int32) :: bfOffBits
        end type t_bmp_file_header
        !
        type :: t_bmp_info_header
            sequence
            integer(int32) :: biSize     = Z'28' ! size of bmp_info_header ; 40bytes 
            integer(int32) :: biWidth
            integer(int32) :: biHeight
            integer(int16) :: biPlanes   = 1 ! always 1
            integer(int16) :: biBitCount
            integer(int32) :: biCompression = 0 ! 0:nocompression, 1:8bitRLE, 2:4bitRLE, 3:bitfield
            integer(int32) :: biSizeImage
            integer(int32) :: biXPelsPerMeter = 3780 ! 96dpi
            integer(int32) :: biYPelsPerMeter = 3780 ! 96dpi 
            integer(int32) :: biClrUsed       = 0
            integer(int32) :: biClrImportant  = 0 
        end type t_bmp_info_header
      !
        type :: t_rgb
            sequence
            character :: b, g, r
        end type t_rgb  
      !
        type :: t_bmp
            type(t_bmp_file_header) :: file_header
            type(t_bmp_info_header) :: info_header
            type(t_rgb), allocatable :: rgb(:, :)
        contains
            procedure :: rd => rd_py      
            procedure :: wr => wr_py
            procedure :: rd_bmp      
            procedure :: wr_bmp
        end type t_bmp    
    contains   
        subroutine rd_py(bmp, fn)
            class(t_bmp), intent(out) :: bmp
            character(len = *), intent(in) :: fn
            character(*), parameter :: fn_tmp = 'my_bmp_rd_tmp'
            call conv_bmp(fn, fn_tmp//'.bmp')
            call bmp%rd_bmp(fn_tmp)
            call delete_file(fn_tmp//'.bmp')
        end subroutine rd_py
        
        
        subroutine wr_py(bmp, fn)
            class(t_bmp), intent(in out) :: bmp
            character(len = *), intent(in) :: fn
            character(*), parameter :: fn_tmp = 'my_bmp_wr_tmp'
            call bmp%wr_bmp(fn_tmp)
            call conv_bmp(fn_tmp//'.bmp', fn)
            call delete_file(fn_tmp//'.bmp')
        end subroutine wr_py
        
        
        subroutine rd_bmp(bmp, fn)
            class(t_bmp), intent(out) :: bmp
            character(len = *), intent(in) :: fn
            type(t_bmp_file_header) :: bmp_file_header 
            type(t_bmp_info_header) :: bmp_info_header
            integer :: ix, iy, nx, ny, ir
            character :: dummy
            open(newunit = ir, file = fn//'.bmp', access = 'stream', status = 'unknown')
            read(ir) bmp_file_header, bmp_info_header
            nx = bmp_info_header%biWidth
            ny = bmp_info_header%biHeight
            allocate( bmp%rgb(nx, ny) )
            read(ir) (bmp%rgb(:, iy), (dummy, ix = 1, mod(nx, 4)), iy = 1, ny)
            close(ir)
        end subroutine rd_bmp  
        
    
        subroutine wr_bmp(bmp, fn)
            class(t_bmp), intent(in out) :: bmp
            character(len = *) :: fn
            integer :: ix, iy, nx, ny, iw
            nx = size(bmp%rgb, 1)
            ny = size(bmp%rgb, 2)
            bmp%file_header%bfSize      = 14 + 40 + 0 + (3 * nx + mod(nx, 4)) * ny
            bmp%file_header%bfOffBits   = 14 + 40
            bmp%info_header%biWidth     = nx
            bmp%info_header%biHeight    = ny
            bmp%info_header%biBitCount  = 24 
            bmp%info_header%biSizeImage = (3 * nx + mod(nx, 4)) * ny
            open(newunit = iw, file = trim(fn)//'.bmp', access = 'stream', status = 'unknown')
            write(iw) bmp%file_header, bmp%info_header
            write(iw) (bmp%rgb(:, iy), (achar(0), ix = 1, mod(nx, 4)), iy = 1, ny)
            close(iw)
        end subroutine wr_bmp  

        
        subroutine conv_bmp(fn_in, fn_out)
            character(*), intent(in) :: fn_in, fn_out
            character(*), parameter :: fn_tmp = 'my_python_tmp.py'
            integer :: iw
            open(newunit = iw, file = fn_tmp)
            write(iw, '(a)') 'from PIL import Image'
            write(iw, '(*(a))') 'img = Image.open("', trim(fn_in), '").convert("RGB")'
            write(iw, '(*(a))') 'img.save("', trim(fn_out), '")'
            close(iw)
            call execute_command_line('python3 '//fn_tmp)
            call delete_file(fn_tmp)
        end subroutine conv_bmp
        

        subroutine delete_file(fn)
            character(*), intent(in) :: fn
            integer :: iw
            open(newunit = iw, file = fn)
            close(iw, status = 'delete')
        end subroutine delete_file
    end module m_bmp
    

    program imgage
        use, intrinsic :: iso_fortran_env
        use :: m_bmp
        implicit none
        type(t_bmp) :: bmp
        call bmp%rd('1966.png')
        print *, 'image size', shape(bmp%rgb)
        bmp%rgb(:, :)%r = achar(0)
        call bmp%wr('1966_without_red.jpg')
    end program imgage