BMP ファイル I/O その３　点と線

gfortran-9 で parameterized derived type が使えるようになりました。~~そこで gfortran-9 でも動くように微修正しました。~~
すみません、色々手違いがあって parameterized derived type ではないプログラムになっていました。parameterized derived type 版は ifort v.19.0 では動きますが、gfortran-9 ではコンパイルできませんでした。お詫びして訂正します。プログラムは parameterized derived type 版にしておきます。

parameterized derived type とオブジェクト指向の仕組みは相性が悪く、メソッドの定義や extends がうまくゆきません。色々迂回措置が必要になります。parameterized derived type は、ほとんどいいとこなしの機能ですｗ

### gfortran-9 で出るエラー
```
hp8@HP8:~/f2018$ gfortran-9 pbmp.f90
pbmp.f90:40:21:

   40 |             procedure :: wr => wr_bmp
      |                     1
Error: Argument ‘bmp’ of ‘wr_bmp’ with PASS(bmp) at (1) must be of the derived-type ‘t_bmp’
```

#BMP 拡張
以前作った bmp 構造体を extends で拡張して、点を打ったり、直線を引いたり出来るようにしてみました。

とりあえず、直線で出来るものを描いて見ることにしました。円の塗りつぶしは直線で実現しています。

##日輪の輝き！
![SUN.png](https://qiita-image-store.s3.amazonaws.com/0/44522/703d69dc-3057-538f-8d1d-172c6f612f00.png)

##ソース
```fortran
    module m_bmp
        use, intrinsic :: iso_fortran_env
        implicit none
        type :: t_bmp_file_header
            sequence  
            integer(int16) :: bfType = Z'4d42'!transfer('BM', 0_2, 1)!B=42 M=4d little endian 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 = achar(0), g = achar(0), r = achar(0) ! char as uint
        end type t_rgb 

        
        type :: t_bmp(nx, ny)
            integer, len :: nx = 0, ny = 0  
            type (t_rgb) :: rgb(nx, ny) 
        contains 
            procedure :: wr => wr_bmp
        end type  

    contains   
        subroutine wr_bmp(bmp, fn)
            class (t_bmp(*, *)), intent(in) :: bmp
            character (len = *), intent(in) :: fn
            type (t_bmp_file_header) :: bmp_file_header
            type (t_bmp_info_header) :: bmp_info_header
            integer :: i, j, iw
            associate(nx => bmp%nx, ny => bmp%ny)
                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 = fn//'.bmp', access = 'stream', status = 'unknown')
                write(iw) bmp_file_header
                write(iw) bmp_info_header
                write(iw) (bmp%rgb(:, i), (achar(0), j = 1, mod(nx, 4)), i = 1, ny)
                close(iw)
            end associate
        end subroutine wr_bmp

        
        subroutine rd_bmp(bmp, fn)
            type (t_bmp(:, :)) , intent(out), allocatable :: bmp
            character (len = *), intent(in) :: fn
            type (t_bmp_file_header) :: bmp_file_header
            type (t_bmp_info_header) :: bmp_info_header
            integer :: i, j, ir
            character :: dummy
            associate(nx => bmp_info_header%biWidth, ny => bmp_info_header%biHeight)
                open(newunit = ir, file = fn//'.bmp', access = 'stream', status = 'old')
                read(ir) bmp_file_header
                read(ir) bmp_info_header
                allocate(t_bmp(nx, ny)::bmp)
                read(ir) (bmp%rgb(:, i), (dummy, j = 1, mod(nx, 4)), i = 1, ny)
                close(ir)
            end associate
        end subroutine rd_bmp

    end module m_bmp
    
    

    module m_pic
        use m_bmp
        implicit none

        type :: t_pic
            type(t_bmp(:, :)), allocatable :: bmp 
        contains
            procedure :: point, line, rd, wr
        end type t_pic
        

        interface t_pic
            module procedure :: init_pic
        end interface t_pic


    contains    
        type (t_pic) function init_pic(nx, ny) result(pic)
            integer, intent(in) :: nx, ny
            allocate(t_bmp(nx, ny)::pic%bmp)
        end function init_pic
    
          
        subroutine wr(pic, fn)
            class(t_pic), intent(in out) :: pic
            character(*), intent(in) :: fn 
            call pic%bmp%wr(fn)
        end subroutine wr

    
        subroutine rd(pic, fn)
            class(t_pic), intent(in out) :: pic
            character(*), intent(in) :: fn 
            call rd_bmp(pic%bmp, fn)
        end subroutine rd

    
        subroutine point(pic, ix, iy, rgb)
            class (t_pic), intent(in out) :: pic
            integer      , intent(in) :: ix, iy
            type (t_rgb) , intent(in) :: rgb
            pic%bmp%rgb(ix, iy) = rgb
        end subroutine point          

    
        subroutine line(pic, ix0, iy0, ix1, iy1, rgb)
            class (t_pic), intent(in out) :: pic
            integer      , intent(in) :: ix0, iy0, ix1, iy1
            type (t_rgb) , intent(in) :: rgb
            integer :: ix, iy, mx, my
            real :: dx, dy, x, y
            mx = ix1 - ix0
            my = iy1 - iy0
            if (mx == 0 .and. my == 0) return 
            if (abs(mx) > abs(my)) then
                dy = my / real(mx)
                y  = iy0 
                do ix = 0, mx, sign(1, mx)
                    y = dy * ix
                    iy = nint(y)
                    call pic%point(ix0 + ix, iy0 + iy, rgb)
                end do    
            else   
                dx = mx / real(my)
                x  = ix0 
                do iy = 0, my, sign(1, my)
                    x = dx * iy
                    ix = nint(x)
                    call pic%point(ix0 + ix, iy0 + iy, rgb)
                end do    
             end if    
          end subroutine line
      end module m_pic

    
      program The_Sun
          use m_pic
          implicit none
          type (t_rgb), parameter :: White = t_rgb(achar(255), achar(255), achar(255)), &
                                  &  Red   = t_rgb(achar(  0), achar(  0), achar(255))  
          integer, parameter :: nx = 640, ny = 480
          integer :: i, ix, iy, ix0, ix1, iy0, iy1, nr
          real :: x, y
          type (t_pic) :: pic1, pic2
          pic2 = t_pic(nx, ny)
          pic2%bmp%rgb = White
          nr = 110
          do iy = 0, nr
              ix = sqrt(real(nr**2 - iy**2))
              ix0 = nx / 2 - ix
              ix1 = nx / 2 + ix
              iy0 = ny / 2 - iy
              iy1 = ny / 2 + iy
              call pic2%line(ix0, iy0, ix1, iy0, Red)
              call pic2%line(ix0, iy1, ix1, iy1, Red)
          end do    
          do ix = 1, 3 * nx / 18
              ix0 =  0 + ix
              ix1 = nx - ix
              iy0 = ny
              iy1 = 1
              call pic2%line(ix0, iy0, ix1, iy1, Red)
              call pic2%line(ix1, iy0, ix0, iy1, Red)
          end do    
          do ix = nx / 4, 6 * nx / 17
              ix0 =  0 + ix
              ix1 = nx - ix
              iy0 = ny
              iy1 = 1
              call pic2%line(ix0, iy0, ix1, iy1, Red) 
              call pic2%line(ix1, iy0, ix0, iy1, Red)
          end do    
          do ix = 7 * nx / 16, nx / 2
              ix0 =  0 + ix
              ix1 = nx - ix
              iy0 = ny
              iy1 = 1
              call pic2%line(ix0, iy0, ix1, iy1, Red) 
              call pic2%line(ix1, iy0, ix0, iy1, Red)
          end do    
          do iy = ny / 7, 5 * ny / 17
              ix0 =  1
              ix1 = nx
              iy0 =  1 + iy
              iy1 = ny - iy
              call pic2%line(ix0, iy0, ix1, iy1, Red) 
              call pic2%line(ix1, iy0, ix0, iy1, Red)
          end do    
          do iy = 8 * ny / 19, ny / 2
              ix0 =  1
              ix1 = nx
              iy0 =  1 + iy
              iy1 = ny - iy
              call pic2%line(ix0, iy0, ix1, iy1, Red) 
              call pic2%line(ix1, iy0, ix0, iy1, Red)
          end do    
        
          call pic2%wr('SUN')

      end program The_Sun
```