Fortran で ASCII ART

Fortran で BMP -> ASCII 変換のプログラムを作ります。

基本的な原理は、フォントのビットマップを（非直行、非完全、非独立）基底ベクトルとして、画像をフォントのサイズごとに細切れにして、その小さなビットマップをベクトルとみなして、各フォント基底とユークリッド距離をとり、距離最小のフォントを選択するものです。

ユークリッド距離を他の距離やエントロピー風に変えてもあんまり結果は変わらない感じです。

RGB三原色に分けて出力し、色を付けて再合成した例を以下に示します。

モノクロのコンソール出力

大きいフォントでの拡大図

プログラムは、BMPファイル読み書き用のモジュールと、メインのプログラムからなります。Fortran95 で導入された elemental 属性のスカラー関数を定義すれば、ループを明示的に書かなくて済むので、３０行程度で実現できました。

このほかに、フォントデータを生成する別のプログラムが必要です。これが一番面倒かもしれません。BMPファイルはｙ軸方向の座標がひっくり返っているので少し混乱しました。また、Fortran には符号なし整数がないため、RGB データの１バイト整数が見かけ上負数になったりして混乱しました。

なお、Fortran2003 の配列自動再割り付けを使っていますので、適切なコンパイラ・オプションが必要となります。

メイン・プログラム　

    module m_bmp
      implicit none
      type :: t_bmp_file_header
        sequence  
        integer(2) :: bfType = transfer('BM', 0_2, 1) ! 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 rd_bmp(fn, bmp)
        character(len = *), intent(in) :: fn
        type(t_rgb), allocatable, intent(out) :: bmp(:, :)
        type(t_bmp_file_header) :: bmp_file_header
        type(t_bmp_info_header) :: bmp_info_header
        open(9, file = fn//'.bmp', form = 'binary', status = 'unknown')
        read(9) bmp_file_header
        read(9) bmp_info_header
        allocate( bmp(bmp_info_header%biWidth, bmp_info_header%biHeight) )
        read(9) bmp
        close(9)
        return
      end subroutine rd_bmp  
    end module m_bmp

    program BMP_data
      use m_bmp 
      implicit none
      integer, parameter :: mx = 4, my = 8
      type :: t_cha_bmp
        type(t_rgb) :: m(mx, my)  
      end type t_cha_bmp
      integer, parameter :: ncol = 48, nrow = 2
      type (t_cha_bmp) :: aa(ncol * nrow), tmp ! 20H..AEH
      type(t_rgb), allocatable :: bmp(:, :)
      integer :: ix, iy, nx, ny, ipos
!
      open(13, file = 'font'//'.dat', status = 'unknown', form = 'unformatted')
      read(13) aa
      call rd_bmp('tktt', bmp) ! call rd_bmp('font4x8', bmp)
      nx = size(bmp, 1) 
      ny = size(bmp, 2) 
      do iy = 1, ny / my
        do ix = 1, nx / mx
          associate( kx => mx * (ix - 1) + 1, ky => ny - my * (iy - 1) )
            tmp%m = bmp(kx:kx + mx - 1, ky:ky - my + 1:-1)  
            ipos = minloc( distance(tmp, aa), 1 ) + z'1F'
            write(*, '(g0)', advance = 'no') achar(ipos)
          end associate    
        end do
        write(*, *)
      end do  
      stop
    contains  
      pure elemental integer function distance(cha1, cha2)
        type(t_cha_bmp), intent(in) :: cha1, cha2
        real, parameter :: f = 6.5 / 3.0
        distance = sum( ( (int1to4(cha1%m%ir) - f * int1to4(cha2%m%ir)) &
                        + (int1to4(cha1%m%ig) - f * int1to4(cha2%m%ig)) &
                        + (int1to4(cha1%m%ib) - f * int1to4(cha2%m%ib)) )**2 ) 
      end function distance
      
      pure elemental integer function int1to4(i)
        integer(1), intent(in) :: i
        int1to4 = transfer(i, 0)
      end function int1to4  
    end program BMP_data

ここで、距離を求める関数 distance 中の係数 f は経験的なパラメータで、画像の露光量にあたるものを変化させるために導入しました。微妙に変えてやると見栄えが良くなります。

フォントのビットマップデータ作成プログラム。フォントとしては日本語DOS窓のMSゴシック　４ｘ８ドットを用いました。たまたま試してみただけで、深い理由はありません。フォントの使用範囲はASCIIの 20H から 7FH までの９６個を用いました。　

    program BMP_data
      use m_bmp 
      implicit none
      integer, parameter :: mx = 4, my = 8
      type(t_rgb), allocatable :: bmp(:, :)
      type :: t_cha_bmp
        type(t_rgb) :: m(mx, my)  
      end type t_cha_bmp
      integer, parameter :: ncol = 48, nrow = 2
      integer :: ix, iy
      type (t_cha_bmp) :: aa(ncol, nrow) ! 20H..AEH
!      
      call rd_bmp('font4x8', bmp)  
      do ix = 1, ncol
        do iy = 1, nrow
          associate( kx => mx * (ix - 1) + 1, ky => my * iy )
            aa(ix, nrow - iy)%m = bmp(kx:kx + mx - 1, ky:ky - my + 1:-1)  
          end associate
        end do
      end do
      open(13, file = 'font.dat', status = 'unknown', form = 'unformatted')
      write(13) aa
      stop
    end program BMP_data

フォント表示プログラム

    program abc
      implicit none
      integer, parameter :: n = 16 * 6
      character :: cha(n)
      integer :: i
      print *, n
      do i = 1, n
        cha(i) = achar(32 - 1 + i)
      end do  
      print '(48g0)', cha
    end program abc

DOS窓を ALT + PrintScreen でキャプチャーし、ペイントで必要な二行分のフォント画像を切り取って 24bit BMP 形式で保存します。

これをフォント生成プログラムの入力とします。出力された font.dat は、 ASCII ART 生成プログラムの入力となります、