BMP file 生成

Mandelbrot 図形の BMPファイルを生成する。

Windows Bitmap Format を 24bit で生成することを仮定しています。 Intel Fortran の Kind 属性と Little Endian も仮定しています。

OOP的な構成にしようと思ったのですが、構造体に sequence 属性をつけると class 化できないようなのであきらめました。

コンパイル時には Enable F2003 semantics としなければなりません。

ソース・プログラム

    module m_bmp
      implicit none
      type :: t_bmp_file_header
        sequence  
        integer(2) :: bfType = transfer('BM', 0_2, 2) ! BitMap
        integer(4) :: bfSize          ! file size in bytes
        integer(2) :: bfReserved1 = 0 ! always 0
        integer(2) :: bfReserved2 = 0 ! always 0
        integer(4) :: bfOffBits
      end type t_bmp_file_header
      !
      type :: t_bmp_info_header
        sequence
        integer(4) :: biSize     = Z'28' ! size of bmp_info_header ; 40bytes 
        integer(4) :: biWidth
        integer(4) :: biHeight
        integer(2) :: biPlanes   = 1 ! always 1
        integer(2) :: biBitCount
        integer(4) :: biCompression = 0 ! 0:nocompression, 1:8bitRLE, 2:4bitRLE, 3:bitfield
        integer(4) :: biSizeImage
        integer(4) :: biXPelsPerMeter = 3780 ! 96dpi
        integer(4) :: biYPelsPerMeter = 3780 ! 96dpi 
        integer(4) :: biClrUsed      = 0
        integer(4) :: biClrImportant = 0 
      end type t_bmp_info_header
      !
      type :: t_rgb
        sequence
        integer(1) :: ib, ig, ir
      end type t_rgb  
    contains   
      subroutine wr(bmp)
        type(t_rgb), intent(in) :: bmp(:, :)
        type(t_bmp_file_header) :: bmp_file_header
        type(t_bmp_info_header) :: bmp_info_header
        integer :: nx, ny
        nx = size(bmp, 1)
        ny = size(bmp, 2)
        bmp_file_header%bfSize    = 14 + 40 + 0 + nx * ny * 3
        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 = nx * ny * 3
        !  
        open(9, file = 'mandel.bmp', form = 'binary', status = 'unknown')
        write(9) bmp_file_header
        write(9) bmp_info_header
        write(9) bmp
        close(9)
        return
      end subroutine wr  
    end module m_bmp
    
    module m_mandel
      implicit none
      integer, parameter :: maxiter = 255
    contains
      pure elemental integer function mandel(c)
        complex, intent(in) :: c
        complex :: z
        z = c
        do mandel = maxiter, 1, -1
          if (abs(z) > 2.0) exit
          z = z**2 + c
        end do 
        return
      end function mandel
    end module m_mandel
    
    program BMP1
      use m_bmp 
      use m_mandel
      implicit none
      integer :: ix, iy, nx, ny
      complex    , allocatable :: c(:, :)
      type(t_rgb), allocatable :: bmp(:, :)
      real :: xmin, ymin, xmax, ymax
      xmin = -2.0 
      xmax =  2.0 
      ymin = -2.0 
      ymax =  2.0 
      nx = 1280
      ny = 1280
      allocate( c(nx, ny) )
      forall (ix = 1:nx, iy = 1:ny) c(ix, iy) = cmplx(pos(ix, nx, xmin, xmax), pos(iy, ny, ymin, ymax)) 
      bmp = to_rgb( mandel(c) ) 
      call wr(bmp)
      stop
    contains
      pure real function pos(i, n, rmin, rmax) 
        integer, intent(in) :: i, n
        real   , intent(in) :: rmin, rmax
        pos = (rmax - rmin) / (n - 1) * i + rmin
        return
      end function pos
      !
      pure elemental type(t_rgb) function to_rgb(k)
        integer, intent(in) :: k
        to_rgb = t_rgb(10 * k,  k, 5 * k)
        return
      end function to_rgb
    end program BMP1