夏休みFortran祭り ３Dアニメーション （キャラクタ文字で）

3D アニメーション

以前グラフィックスをキャラクターでうまくやる方法はないかと web をぶらぶらしていた時に、3Dアニメーションをキャラクター文字でやっている記事を見つけました。

Donut math: how donut.c works

ドーナッツ状の物体（トーラス）が、光の陰影をつけつつグルグル回転している様子をキャラクター文字で表現しています。

元々は、C言語での曲芸をやっていて、短くまとめたソースコードをドーナッツ状に整形してあります。

しかしながら、記事そのものはプログラムの原理の説明がメインです。昔読んだ時は、原理は意外に簡単だと感じました。夏休みなので、本当に理解できたか Fortran で作ってみます。元記事では、プログラムを短くまとめる技法も使っていますが、ここでは原理が分かればいいので適当に冗長に書いていきます。

理解チェックなので、丸パクリですｗ

実行結果

基本は回転行列で、物体の座標と法線ベクトルを回転させるだけです。別に与えた光のベクトルと法線ベクトルの内積から、物体表面の明るさが決定されます。（たぶん物体表面では一様に散乱すると仮定。）トーラスは円の回転体なので、適当な間隔で表面上の座標を求めやすくなっています。

元記事では座標系を回転させていますが、ここでは物体を回転させました。

ソースプログラム

座標と法線のベクトルを束ねて、一括で回転させています。p(:,1) が座標、p(:,2) が法線ベクトルです。

明るさに対応するキャラクタ文字の選び方の秀逸性が一番のキモのような気がします。

    module m_3d
      implicit none
      real, parameter :: pi = 4 * atan(1.0)
      character(*), parameter :: tex = ' .,-~:;=!*#$@'
      character, allocatable :: text(:)
      integer, parameter :: nx = 50, ny = 15 
    contains  
      subroutine wr_torus(theta0, phi0) ! write torus
        real, intent(in) :: theta0, phi0
        real :: theta, phi, x, y, zz
        character ::  win(-nx:nx, -ny:ny)
        real :: p(3, 2), zwin(-nx:nx, -ny:ny), dot
        integer :: i, j, k, l, ix, iy
        real, parameter :: r2 = 250.0, r1 = 50.0, sz = 350.0, f = 1.5
        real, parameter :: vl(3) = [0.0, 1.0, -1.0] ! direction of light
        zwin = 0.0
        win = ''
        do j = 0, 60                     ! rotate circle
          phi  = pi / 180.0 * j * 6
          do i = 0, 120                  ! circle
            theta = pi / 180.0 * i * 3
            p(:, 1) = [r2 / 2, 0.0, 0.0] + r1 * [cos(theta), sin(theta), 0.0] ! surface position
            p(:, 2) =                           [cos(theta), sin(theta), 0.0] ! surface normal 
            p = rz(theta0, rx(phi0, ry(phi, p)))
            x = f * p(1, 1) / (sz + p(3, 1))
            y = f * p(2, 1) / (sz + p(3, 1))
            zz = sz + p(3, 1) 
            ix = int(nx / 2 * x) ! scale to screen size
            iy = int(ny     * y) !
            if (1.0 / zz > zwin(ix, iy)) then  ! z-buffer 
              dot = dot_product(p(:, 2), vl) / sqrt(dot_product(vl, vl))
              k = 1 + nint( (size(text) - 1) * abs(dot) * (sign(0.5, dot) + 0.5) ) ! sign + 0.5 <= step function
              win (ix, iy) = text(k)
              zwin(ix, iy) = 1.0 / zz
            end if  
          end do    
        end do
        do i = ny, -ny, -1     ! write to screen
          print *, win(:, i)
        end do
      end subroutine wr_torus
    
      pure function rx(t, r) result(res)
        real, intent(in) :: t, r(3, 2)
        real :: res(3, 2)
        res(1, :) = r(1, :)
        res(2, :) =  cos(t) * r(2, :) + sin(t) * r(3, :)
        res(3, :) = -sin(t) * r(2, :) + cos(t) * r(3, :)
      end function rx

      pure function ry(t, r) result(res)
        real, intent(in) :: t, r(3, 2)
        real :: res(3, 2)
        res(1, :) =  cos(t) * r(1, :) + sin(t) * r(3, :)
        res(2, :) = r(2, :)
        res(3, :) = -sin(t) * r(1, :) + cos(t) * r(3, :)
      end function ry
      
      pure function rz(t, r) result(res)
        real, intent(in) :: t, r(3, 2)
        real :: res(3, 2)
        res(1, :) =  cos(t) * r(1, :) + sin(t) * r(2, :)
        res(2, :) = -sin(t) * r(1, :) + cos(t) * r(2, :)
        res(3, :) = r(3, :)
      end function rz
    end module m_3d
    
    program torus
      use m_3d
      implicit none
      real :: theta0, phi0
      integer :: m
      text = transfer(tex, ' ', size=len(tex))
      do m = 1, 2000
        phi0   = mod(pi / 180.0 * m * 6, 2 * pi)
        theta0 = mod(pi / 180.0 * m * 3, 2 * pi)
        call execute_command_line("cls")　! bash "clear"     
        call wr_torus(theta0, phi0)
      end do  
    end program torus

あまりチェックしてないのですがｗ