屈辱の画像変換ｗ
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)
integer(int32) :: bfSize
integer(int16) :: bfReserved1 = 0
integer(int16) :: bfReserved2 = 0
integer(int32) :: bfOffBits
end type t_bmp_file_header
type :: t_bmp_info_header
sequence
integer(int32) :: biSize = Z'28'
integer(int32) :: biWidth
integer(int32) :: biHeight
integer(int16) :: biPlanes = 1
integer(int16) :: biBitCount
integer(int32) :: biCompression = 0
integer(int32) :: biSizeImage
integer(int32) :: biXPelsPerMeter = 3780
integer(int32) :: biYPelsPerMeter = 3780
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
R2-10-2 微修正 delete_file 追加
R2-10-3 微修正 tmp file 名 parameter 化
最近オライリー本が白くなってマイケル・ジャクソンみたい。中の紙も漂白紙になって目が痛い。ホワイトウォッシュだなｗ
![世界征服~謀略のズヴィズダー~ (完全生産限定版) 全6巻セット [マーケットプレイス Blu-rayセット]](https://m.media-amazon.com/images/I/51eNqU0ER3L._SL160_.jpg "世界征服~謀略のズヴィズダー~ (完全生産限定版) 全6巻セット [マーケットプレイス Blu-rayセット]")
