端末にクリスマスツリーを飾ろう by Fortran

そろそろクリスマスも近づいてきましたので、クリスマスツリーを用意しましょう。

# できたもの

いずれも普通のTerminal emulator（Konsole）の標準出力です。

![test1.gif](https://qiita-image-store.s3.amazonaws.com/0/258019/5d7c512f-343f-bdc4-954c-5891618a460c.gif)

![test2.gif](https://qiita-image-store.s3.amazonaws.com/0/258019/09e5e8cb-77e5-6dff-abdd-c690e4d8ad15.gif)


# 今回勉強になったもの

* `ioctl`：システムとのやりとり
* ANSIエスケープシーケンス
* イベントハンドラ

テーマ的にFortranのFORMAT芸もできたかもしれませんが、時間がなかった。

# 環境

LinuxはUbuntu16.04とCentOS 7.6で確認しました。
CygwinとMacOS(Mojave)は`ioctl`でこけました。（追記：こけるというか、コンパイルと実行はできるのですが、結果が「０」でちゃんとした値が得られませんでした。）
Bash On Windowsは基本大丈夫でしたが、ウィンドウサイズを変えた時にイベントハンドラでエラーが起きました。

gfortranは5.4.0です。

# ターミナルにツリーを飾ろう

せっかく飾るのですから、窓いっぱいに見えた方が良いかなと思います。遠慮して小さいツリー、例えば「A」を端末に出力させても寂しすぎます。かといってツリーが大きすぎると改行が起こって崩れたり、全体が見えなかったりします。なので、表示させるところがどれくらいの広さかを調べ、ジャストサイズのツリーを飾ってみましょう。

ここで使うのが`ioctl`です。
https://linuxjm.osdn.jp/html/LDP_man-pages/man2/ioctl.2.html
http://man7.org/linux/man-pages/man2/ioctl.2.html

要は端末の描画を管理しているのはシステム側なので、その情報を得るには相応のレイヤーの関数を使う必要があるということです。
矩形配列演算特化のFortranには厳しいので、何でも屋のCの助けを借ります。

# 端末サイズ取得

デバイスにコマンドを送るシステム関数の

```C:sys/ioctl.h
extern int ioctl (int __fd, unsigned long int __request, ...) __THROW;
```

がキモとなります[^1]。端末サイズを取得する場合、C言語では

```C:asm-generic/ioctls.h
#define TIOCGWINSZ      0x5413
```

```C:unistd.h
#define STDOUT_FILENO   1
```

```C:bits/ioctl-types.h
struct winsize
  {
    unsigned short int ws_row;
    unsigned short int ws_col;
    unsigned short int ws_xpixel;
    unsigned short int ws_ypixel;
  };
```

というものが定義されている状態で、

```C
winsize ws;
ioctl(STDOUT_FILENO, TIOCGWINSZ, &ws);
```

とすれば`ws`に現在の端末のサイズが格納されます。これをいつものようにFortranのinterfaceに書き下してやります。

```fortran
module sys_ioctl
    use iso_c_binding
    implicit none
    type, bind(C) :: winsize
        integer(c_short) :: ws_row
        integer(c_short) :: ws_col
        integer(c_short) :: ws_xpixel
        integer(c_short) :: ws_ypixel
    end type winsize

    integer(c_int), parameter :: TIOCGWINSZ = Z'5413'
    integer(c_int), parameter :: STDOUT_FILENO = 1

    interface 
        function ioctl(fd, cmd, arg) result(r) bind(C, name="ioctl")
            import :: c_int, c_ptr
            integer(c_int) :: r
            integer(c_int), value :: fd, cmd
            type(c_ptr), value :: arg
        end function ioctl
    end interface
end module sys_ioctl
```

モジュール名は適当です。こうやってFortranでも`ioctl`を呼び出せるようになりました。
たとえばこうやって使います。

```fortran
module hoge
    use sys_ioctl
    implicit none
    integer :: width, height
    integer :: h_half, w_half 

contains
    subroutine get_windowsize()
        integer(c_int) :: ret
        type(winsize), target :: ws
        ret = ioctl(STDOUT_FILENO, TIOCGWINSZ, c_loc(ws))
        width = iand(256*256 - 1, ws%ws_col) - 1 ! write文は最初にスペースを1つ付けるのでその分減らします。
        height = iand(256*256 - 1, ws%ws_row) - 2 ! 次のシェル入力行の分減らします。 
        w_half = width / 2
        h_half = height / 2
    end subroutine get_windowsize
end module hoge
```

`width = iand(256*256 - 1, ws%ws_col)`と`iand`を使っている件ですが、例により符号なし整数を符号あり整数に変える処理です。`ws`の成分は`unsigned short`ですので、多分端末行数・列数が`32767`を超えたあたりから普通の代入では問題が出てくるかなと。

得られた`width`と`height`を半分にし、画面の中央線が何行目、何列目かを得ておきます。これに沿って線を引けば端末のサイズにぴったりあった十字線が引けるはずです。

補足に書きましたが、「write文は最初にスペースを1つ付けるのでその分減らします。」はformatを適切に指定すると回避できます。

そこで以下の2つの関数を`hoge`モジュールに追加します。

```fortran
    pure elemental function line_at(nline) result(s)
        integer, intent(in) :: nline
        character(len=width) :: s
        if ( nline == h_half )then
            s = repeat("-", w_half - mod(w_half, 2)) // "+" // repeat("-", w_half)
        else
            s = repeat(" ", w_half - mod(w_half, 2)) // "|"
        endif
    end function line_at

    subroutine draw_cross()
        integer :: i
        call get_windowsize()
        do i = 1, height
            write(*, *) line_at(i)
        enddo
    end subroutine draw_cross
```

あとは呼び出すプログラムを用意。

```fortran
program main
    use hoge, only: draw_cross
    implicit none
    call draw_cross()
    stop
end program main   
```

なお、`ioctl`はシステムコールになりますので、GCCのgfortranであれば特にリンクするものはありません。つまり、これまで書いたプログラムは

```
gfortran hoge.f90
./a.out
```

で実行できます。

以上の内容で、端末のウィンドウサイズを40x16とした時に以下の出力を得ました。

```
                   |                    
                   |                    
                   |                    
                   |                    
                   |                    
                   |                    
 ------------------+------------------- 
                   |                    
                   |                    
                   |                    
                   |                    
                   |                    
                   |                    
                   |  
```


# まずは概形

ツリーを飾るところのサイズを取得できました。続いて、これに合わせたツリーを用意します。

今回は、クリスマスツリーを

* 一番上の☆
* 土台の植木鉢
* 真ん中の葉

の3つにわけました。このなかで真ん中の葉の部分を伸縮させ、サイズを調整しようと思います。

これらのクリスマスツリーを描写するサブルーチンを備える`xmastree`をこれから実装していきます。

## ☆

```fortran
    subroutine draw_star()
        write(*, *) repeat(" ", w_half - 1) //  "|" 
        write(*, *) repeat(" ", w_half - 2) // "\|/" 
        write(*, *) repeat(" ", w_half - 5) // "----*----"
        write(*, *) repeat(" ", w_half - 2) // "/ \"
    end subroutine draw_star
```

最終行は木の一部では、という意見もあります。

## 植木鉢

```fortran
    subroutine draw_base()
        write(*, *) repeat(" ", w_half - 3) // "|:::|" 
        write(*, *) repeat(" ", w_half - 6) // "[[_______]]" 
        write(*, *) repeat(" ", w_half - 5) // "|XXXXXXX|" 
        write(*, *) repeat(" ", w_half - 5) // "|XXXXXXX|"
    end subroutine draw_base
```

## 真ん中の木の葉

```fortran
    subroutine draw_leaf()
        integer :: i, j
        integer :: n1, n2
        n1 = w_half - 1
        do i = 5, height - 5
            if (mod(i, 4) == 0) n1 = n1 + 1
            n1 = n1 - 1
            n2 = w_half*2 - 2*n1 - 1
            if (n1 == 0) exit
            write(*, '(a)') repeat(" ", n1) // "/" // repeat(" ", n2) // "\"
        enddo
        write(*, '(a)') repeat(" ", n1) // repeat("-", n2 + 2)
    end subroutine draw_leaf
```

これらでは、` /     \ ` を`height - 9`行出力し、木を演出します。
`n1 = n1 - 1`により、木の左側（`/`）に置くスペースを１行ごとに１文字減らします。
また、`n2 = w_half*2 - 2*n1 - 1` は`/`と`\`の間におくスペースの数です。
`n1`が減れば`n2`が増えます。これにより、三角形のような木のシルエットを再現します。

`if (mod(i, 4) == 0) n1 = n1 + 1`は、4行に1回1文字分のスペースを木の左側に増やし、もみの木らしい葉っぱの段差を出してみます。

`if (n1 == 0) exit` は葉が左端についたらそれ以上伸ばさないようにしたものです。`width`は実際の端末の幅から`-1`しているので右端がつくことは無いかなと。

## 以上をまとめて呼び出す関数

```fortran
    subroutine draw_tree()
        call get_windowsize()
        if (height < 8 .or. width < 20 )then
            write(*, *) "Merry X'mas!"
            return
        endif
        call draw_star()
        call draw_leaf()
        call draw_base()
    end subroutine draw_tree
```

なお、あまりにウィンドウサイズが小さく、☆と植木鉢も入らなさそうだと`Merry X'mas!'とだけ表示してお茶を濁します。

以上が`xmastree`モジュールに含まれる関数となります。あ、`xmastree`に先に紹介した`get_windowsize`とモジュール変数を追加するのを忘れずに。

あとは`use xmastree`して`call draw_tree()`するだけのプログラムを書いて終わりです。

```fortran
program main
    use xmastree, only: draw_tree
    implicit none
    call draw_tree()
    stop
end program main
```

32x20の縦長ウィンドウで以下の出力が得られます。

```
               |
              \|/
           ----*----
              / \
             /   \
            /     \
           /       \
           /       \
          /         \
         /           \
        /             \
        /             \
       /               \
       -----------------
             |:::|
          [[_______]]
           |XXXXXXX|
           |XXXXXXX|
```

Qiitaのpre出力、行間が広すぎるんですよね・・・

# オーナメント

もみの木だけでは寂しいので飾り付けします。

`xmastree`モジュールのうち、`draw_leaf`を書き換えます。

```fortran
    subroutine draw_leaf()
        integer :: i, j
        integer :: n1, n2
        n1 = w_half - 1
        do i = 5, height - 5
            if (mod(i, 4) == 0) n1 = n1 + 1
            n1 = n1 - 1
            n2 = w_half*2 - 2*n1 - 1
            if (n1 == 0) exit
            write(*, '(a)', advance="no") repeat(" ", n1) // "/" 
            do j = 1, n2
                write(*, '(a)', advance="no") add_ornament(0.12d0)
            enddo
            write(*, '(a)') "\" 
        enddo
        write(*, '(A)') repeat(" ", n1) // repeat("-", n2 + 2) 
    end subroutine draw_leaf
```
葉の中のスペースを`repeat`でまとめて出すのではなく、1文字1文字乱数でスペースにするかオーナメントにするかを決定して　`write(*, '(a)', advance="no") add_ornament(0.12d0)` と出力します。この関数は以下のような感じ。

```fortran
    function add_ornament(rate) result(s)
        character(:), allocatable :: s
        real(REAL64), intent(in) :: rate
        real(REAL64) :: x
        call random_number(x)
        if(x < rate/2.0) then
            s = "O"
        elseif( x < rate) then
            s = "*"
        else
            s = " "
        endif
    end function add_ornament
```

`O`と`*`の2種類の飾りを出すようにしました。結果の`s`が可変長なのは今後の拡張性のためです。

他の部分は全く同じです。この出力は以下のようになります。

```
               |
              \|/
           ----*----
              / \
             /   \
            /   *O\
           /       \
           / O     \
          /      *  \
         /           \
        /          *  \
        /          *  \
       /    *          \
       -----------------
             |:::|
          [[_______]]
           |XXXXXXX|
           |XXXXXXX|
```

# カラー

Linuxの`ls`とかで文字に色がついていることがあるかと思いますが、あれは決してLinux組み込みコマンドの特権ではなく、端末に文字を出力できるならANSIエスケープシーケンスを活用することで誰でもできます。

https://www.mm2d.net/main/prog/c/console-02.html

応用例：https://qiita.com/tu-kun/items/d38452161bfb9da54bcd

* 文字色
* 背景色
* 文字スタイル
* カーソル位置

などを操作することができます。
そのために必要になるのは、ANSIエスケープシーケンス `\x1b` とそれに続く数文字、これだけです。

`\x1b`はFortranだと`character(len=1) :: ESC = char(27)`として取り扱いできるかと思います。

## 今回の実装

まず、以下のようなパラメータを用意しました。

```fortran
    character(len=5) :: STAR_COLOR = char(27) // "[33m"
    character(len=5) :: TREE_COLOR = char(27) // "[32m"
    character(len=5) :: BASE_COLOR = char(27) // "[31m"
    character(len=5) :: ORNAMENT_COLOR = char(27) // "[34m"
    character(len=4) :: RESET_COLOR = char(27) // "[0m"
```

これで、すべての出力の前後に`XXX_COLOR`と`RESET_COLOR`をつけます。こんな感じ。

```fortran
    subroutine draw_star()
        write(*, *) repeat(" ", w_half - 1) // STAR_COLOR // "|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 2) // STAR_COLOR // "\|/" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // STAR_COLOR // "----*----" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 2) // STAR_COLOR // "/ \" // RESET_COLOR
    end subroutine draw_star

    function add_ornament(rate) result(s)
        character(:), allocatable :: s
        real(REAL64), intent(in) :: rate
        real(REAL64) :: x
        call random_number(x)
        if(x < rate/2.0) then
            s = ORNAMENT_COLOR // "O" // RESET_COLOR
        elseif( x < rate) then
            s = "*"
        else
            s = " "
        endif
    end function add_ornament

    subroutine draw_leaf()
        integer :: i, j
        integer :: n1, n2
        n1 = w_half - 1
        do i = 5, height - 5
            if (mod(i, 4) == 0) n1 = n1 + 1
            n1 = n1 - 1
            n2 = w_half*2 - 2*n1 - 1
            if (n1 == 0) exit          
            write(*, '(a)', advance="no") repeat(" ", n1) // TREE_COLOR // "/" // RESET_COLOR
            do j = 1, n2
                write(*, '(a)', advance="no") add_ornament(0.12d0)
            enddo
            write(*, '(a)') TREE_COLOR // "\" // RESET_COLOR
        enddo
        write(*, '(A)') repeat(" ", n1) // TREE_COLOR // repeat("-", n2 + 2)  // RESET_COLOR
    end subroutine draw_leaf

    subroutine draw_base()
        write(*, *) repeat(" ", w_half - 3) // BASE_COLOR // "|:::|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 6) // BASE_COLOR // "[[_______]]" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // BASE_COLOR // "|XXXXXXX|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // BASE_COLOR // "|XXXXXXX|" // RESET_COLOR
    end subroutine draw_base
```

オーナメントの`*`はデフォルトの色にしてみました。
`add_ornament`の戻り変数型を`character(:)`と可変長にしているのは、このエスケープシーケンスに対応するためでした。エスケープシーケンスは端末上では表示されませんが、データとしてはしっかり持っていますので、その分の長さを確保する必要があります。

これで端末出力では色が付くはずです。

# 動き回るオーナメント、ではなく点滅するランプのイメージで

この節でANSIエスケープシーケンスのうち、カーソル移動を実験します。

「できたもの」1つ目のような動きをつけてみます。これはプログラム的には毎秒書きなおしています。
この時端末の出力を次々流しては芸がないので、カーソルを戻して画面を再利用することにします。

```fortran
    subroutine draw_tree(overwrite)
        logical, intent(in) :: overwrite
        integer :: i
        call get_windowsize()
        if (overwrite) call clean_disp()
        if (height < 8 .or. width < 20 )then
            write(*, *) "Merry X'mas!"
            return
        endif
        call draw_star()
        call draw_leaf()
        call draw_base()
    end subroutine draw_tree
```

ここで新しく追加したのが、端末描写をリセットする`clean_disp`。エスケープシーケンスを1つ追加します。これはカーソル位置を1行１列目に移動させる効果を持ちます。

```fortran
    character(len=6) :: RESET_TERMINAL = char(27) // "[1;1H"
```

```fortran
    subroutine clean_disp()
        integer :: i
        write(*, '(A)', advance="no") RESET_TERMINAL
        do i = 1, height
            write(*, *) repeat(" ", width)
        enddo
        write(*, '(A)', advance="no") RESET_TERMINAL
    end subroutine clean_disp
```

やっていることは、端末画面左上にカーソルを動かし、画面いっぱいにスペースで埋め、再びカーソルを左上に持って行っています。

また、`draw_tree`関数にも新しくフラグ引数を導入したので、呼び出すプログラムも以下のようになります。

```fortran

program main
    use xmastree, only: draw_tree
    implicit none
    integer :: N

    call draw_tree(.false.)
    do N = 1, 100
        call sleep(1)
        call draw_tree(.true.)
    enddo
   
    stop
end program main
```

これで以下の出力が得られます。

![test1.gif](https://qiita-image-store.s3.amazonaws.com/0/258019/5d7c512f-343f-bdc4-954c-5891618a460c.gif)

<details>
<summary>ソースコード</summary><div>

```fortran:glitter.f90
module sys_ioctl
    use iso_c_binding
    implicit none
    type, bind(C) :: winsize
        integer(c_short) :: ws_row
        integer(c_short) :: ws_col
        integer(c_short) :: ws_xpixel
        integer(c_short) :: ws_ypixel
    end type winsize
    integer(c_int), parameter :: TIOCGWINSZ = Z'5413'
    integer(c_int), parameter :: STDOUT_FILENO = 1

    interface 
        function ioctl(fd, cmd, arg) result(r) bind(C, name="ioctl")
            import :: c_int, c_ptr
            integer(c_int) :: r
            integer(c_int), value :: fd, cmd
            type(c_ptr), value :: arg
        end function ioctl
    end interface
end module sys_ioctl

module xmastree
    use iso_fortran_env
    use sys_ioctl
    implicit none
    integer :: width, height
    integer :: h_half, w_half 
    character(len=5) :: STAR_COLOR = char(27) // "[33m"
    character(len=5) :: TREE_COLOR = char(27) // "[32m"
    character(len=5) :: BASE_COLOR = char(27) // "[31m"
    character(len=5) :: ORNAMENT_COLOR = char(27) // "[34m"
    character(len=4) :: RESET_COLOR = char(27) // "[0m"
    character(len=6) :: RESET_TERMINAL = char(27) // "[1;1H"

contains
    subroutine get_windowsize()
        integer(c_int) :: ret
        type(winsize), target :: ws
        ret = ioctl(STDOUT_FILENO, TIOCGWINSZ, c_loc(ws))
        width = iand(256*256 - 1, ws%ws_col) - 1
        height = iand(256*256 - 1, ws%ws_row) - 1
        w_half = width / 2
        h_half = height / 2
    end subroutine get_windowsize
    
    subroutine clean_disp()
        integer :: i
        write(*, '(A)', advance="no") RESET_TERMINAL
        do i = 1, height
            write(*, *) repeat(" ", width)
        enddo
        write(*, '(A)', advance="no") RESET_TERMINAL
    end subroutine clean_disp

    subroutine draw_star()
        write(*, *) repeat(" ", w_half - 1) // STAR_COLOR // "|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 2) // STAR_COLOR // "\|/" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // STAR_COLOR // "----*----" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 2) // STAR_COLOR // "/ \" // RESET_COLOR
    end subroutine draw_star

    function add_ornament(rate) result(s)
        character(:), allocatable :: s
        real(REAL64), intent(in) :: rate
        real(REAL64) :: x
        call random_number(x)
        if(x < rate/2.0) then
            s = ORNAMENT_COLOR // "O" // RESET_COLOR
        elseif( x < rate) then
            s = "*"
        else
            s = " "
        endif
    end function add_ornament

    subroutine draw_leaf()
        integer :: i, j
        integer :: n1, n2
        n1 = w_half - 1
        do i = 5, height - 5
            if (mod(i, 4) == 0) n1 = n1 + 1
            n1 = n1 - 1
            n2 = w_half*2 - 2*n1 - 1
            if (n1 == 0) exit
            write(*, '(a)', advance="no") repeat(" ", n1) // TREE_COLOR // "/" // RESET_COLOR
            do j = 1, n2
                write(*, '(a)', advance="no") add_ornament(0.12d0)
            enddo
            write(*, '(a)') TREE_COLOR // "\" // RESET_COLOR
        enddo
        write(*, '(a)') repeat(" ", n1) // TREE_COLOR // repeat("-", n2 + 2)  // RESET_COLOR
    end subroutine draw_leaf

    subroutine draw_base()
        write(*, *) repeat(" ", w_half - 3) // BASE_COLOR // "|:::|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 6) // BASE_COLOR // "[[_______]]" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // BASE_COLOR // "|XXXXXXX|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // BASE_COLOR // "|XXXXXXX|" // RESET_COLOR
    end subroutine draw_base

    subroutine draw_tree(overwrite)
        logical, intent(in) :: overwrite
        integer :: i
        call get_windowsize()
        ! if (overwrite) write(*, '(A)', advance="no") RESET_TERMINAL
        if (overwrite) call clean_disp()
        if (height < 8 .or. width < 20 )then
            write(*, *) "Merry X'mas!"
            return
        endif
        call draw_star()
        call draw_leaf()
        call draw_base()
    end subroutine draw_tree

end module xmastree

program main
    use xmastree, only: draw_tree
    implicit none
    integer :: N

    call draw_tree(.false.)
    do N = 1, 100
        call sleep(1)
        call draw_tree(.true.)
    enddo
   
    stop
end program main
```

</div></details>

# ウィンドウサイズ変更に追従

クリスマスツリーを表示中に窓の大きさを変更するかもしれません。このときにいつ変更が起こってもいいように1秒おきに再描画を行うプログラムでは芸がないし、Fortranの`sleep`が秒単位なので反応が遅いです。

実はウィンドウサイズを変更すると`SIGWINCH`シグナルが投げられます。これを拾ってやり、ウィンドウサイズ変更時にだけ再描画するプログラムにしてみます。

## シグナル処理

メインプログラム部分の変更のみで対応できます。

```fortran
program main
    use xmastree, only: draw_tree
    implicit none
    integer :: N

    call draw_tree(.false.)
    call signal(28, tree_rewrite) ! SIGWINCH
    do while(.true.)
        call sleep(1)
    enddo
    stop
contains
    subroutine tree_rewrite
        call draw_tree(.true.)
    end subroutine 
end program main
```

## オーナメントの部分の変更

今度はオーナメントは固定で、`*`が点滅するLEDだとして描写します。ANSIエスケープシーケンスのブリンクを使ってみたかったので。

```fortran
    character(len=7) :: LED_COLOR = char(27) // "[35;5m"
```

```fortran
   !     function add_ornament(rate) result(s) の中ほど
        elseif( x < rate) then
            s = LED_COLOR // "*" // RESET_COLOR
        else
```

同じ種類のコマンドだとまとめることができるようです。（`ESC[35mESC[5m` → `ESC[35;5m`）

続いてオーナメント位置の固定のため、乱数の`seed`を指定してからオーナメントを描写するようにします。

```fortran
   subroutine draw_leaf()

            ! 中略

            write(*, '(a)', advance="no") repeat(" ", n1) // TREE_COLOR // "/" // RESET_COLOR
            seed(:) = i
            call random_seed(put=seed(:))
            do j = 1, n2
                write(*, '(a)', advance="no") add_ornament(0.12d0)
            enddo
            write(*, *) TREE_COLOR // "\" // RESET_COLOR

            ! 中略

    end subroutine draw_leaf
```

種指定用の配列を`xmastree`モジュール変数に追加。

```fortran
    integer, allocatable :: seed(:)
```

これを`draw_tree`初回呼び出し時に準備するようにします。

```fortran
    subroutine draw_tree(overwrite)
        logical, intent(in) :: overwrite
        integer :: i, seedsize

        if ( .not. allocated(seed) )then
            call random_seed(size=seedsize)
            allocate(seed(seedsize))
        endif
以下略
```

以上で、「できたもの」2つ目の絵ができます。

![test2.gif](https://qiita-image-store.s3.amazonaws.com/0/258019/09e5e8cb-77e5-6dff-abdd-c690e4d8ad15.gif)


<details>
<summary>ソースコード</summary><div>

```fortran:winsize_flexible.f90
module sys_ioctl
    use iso_c_binding
    implicit none
    type, bind(C) :: winsize
        integer(c_short) :: ws_row
        integer(c_short) :: ws_col
        integer(c_short) :: ws_xpixel
        integer(c_short) :: ws_ypixel
    end type winsize
    integer(c_int), parameter :: TIOCGWINSZ = Z'5413'
    integer(c_int), parameter :: STDOUT_FILENO = 1

    interface 
        function ioctl(fd, cmd, arg) result(r) bind(C, name="ioctl")
            import :: c_int, c_ptr
            integer(c_int) :: r
            integer(c_int), value :: fd, cmd
            type(c_ptr), value :: arg
        end function ioctl
    end interface
end module sys_ioctl

module xmastree
    use iso_fortran_env
    use sys_ioctl
    implicit none
    integer :: width, height
    integer :: h_half, w_half 
    integer, allocatable :: seed(:)
    character(len=5) :: STAR_COLOR = char(27) // "[33m"
    character(len=5) :: TREE_COLOR = char(27) // "[32m"
    character(len=5) :: BASE_COLOR = char(27) // "[31m"
    character(len=5) :: ORNAMENT_COLOR = char(27) // "[34m"
    character(len=7) :: LED_COLOR = char(27) // "[35;5m"
    character(len=4) :: RESET_COLOR = char(27) // "[0m"
    character(len=6) :: RESET_TERMINAL = char(27) // "[1;1H"

contains
    subroutine get_windowsize()
        integer(c_int) :: ret
        type(winsize), target :: ws
        ret = ioctl(STDOUT_FILENO, TIOCGWINSZ, c_loc(ws))
        width = iand(256*256 - 1, ws%ws_col) - 1
        height = iand(256*256 - 1, ws%ws_row) - 1
        w_half = width / 2
        h_half = height / 2
    end subroutine get_windowsize
    
    subroutine clean_disp()
        integer :: i
        write(*, '(A)', advance="no") RESET_TERMINAL
        do i = 1, height
            write(*, *) repeat(" ", width)
        enddo
        write(*, '(A)', advance="no") RESET_TERMINAL
    end subroutine clean_disp

    subroutine draw_star()
        write(*, *) repeat(" ", w_half - 1) // STAR_COLOR // "|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 2) // STAR_COLOR // "\|/" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // STAR_COLOR // "----*----" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 2) // STAR_COLOR // "/ \" // RESET_COLOR
    end subroutine draw_star

    function add_ornament(rate) result(s)
        character(:), allocatable :: s
        real(REAL64), intent(in) :: rate
        real(REAL64) :: x
        call random_number(x)
        if(x < rate/2.0) then
            s = ORNAMENT_COLOR // "O" // RESET_COLOR
        elseif( x < rate) then
            s = LED_COLOR // "*" // RESET_COLOR
        else
            s = " "
        endif
    end function add_ornament

    subroutine draw_leaf()
        integer :: i, j
        integer :: n1, n2
        n1 = w_half - 1
        do i = 5, height - 5
            if (mod(i, 4) == 0) n1 = n1 + 1
            n1 = n1 - 1
            n2 = w_half*2 - 2*n1 - 1
            if (n1 == 0) exit
            write(*, '(a)', advance="no") repeat(" ", n1) // TREE_COLOR // "/" // RESET_COLOR
            seed(:) = i
            call random_seed(put=seed(:))
            do j = 1, n2
                write(*, '(a)', advance="no") add_ornament(0.12d0)
            enddo
            write(*, '(a)') TREE_COLOR // "\" // RESET_COLOR
        enddo
        write(*, '(a)') repeat(" ", n1) // TREE_COLOR // repeat("-", n2 + 2)  // RESET_COLOR
    end subroutine draw_leaf

    subroutine draw_base()
        write(*, *) repeat(" ", w_half - 3) // BASE_COLOR // "|:::|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 6) // BASE_COLOR // "[[_______]]" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // BASE_COLOR // "|XXXXXXX|" // RESET_COLOR
        write(*, *) repeat(" ", w_half - 5) // BASE_COLOR // "|XXXXXXX|" // RESET_COLOR
    end subroutine draw_base

    subroutine draw_tree(overwrite)
        logical, intent(in) :: overwrite
        integer :: i, seedsize

        if ( .not. allocated(seed) )then
            call random_seed(size=seedsize)
            allocate(seed(seedsize))
        endif

        call get_windowsize()
        ! if (overwrite) write(*, '(A)', advance="no") RESET_TERMINAL
        if (overwrite) call clean_disp()
        if (height < 8 .or. width < 20 )then
            write(*, *) "Merry X'mas!"
            return
        endif
        call draw_star()
        call draw_leaf()
        call draw_base()
    end subroutine draw_tree
end module xmastree

program main
    use xmastree, only: draw_tree
    implicit none
    integer :: N

    call draw_tree(.false.)
    call signal(28, tree_rewrite) ! SIGWINCH
    do while(.true.)
        call sleep(1)
    enddo
    stop
contains
    subroutine tree_rewrite
        call draw_tree(.true.)
    end subroutine 
end program main
```

</div></details>

# 補足

「write文は最初にスペースを1つ付けるのでその分減らします」と言いましたが、`write(*, *)`がつけるのであって、`write(*,'(a)')`はつけません。

```fortran
    write(*, *) "hoge"
    write(*, '(a)') "hoge"
```

```:出力
 hoge
hoge
```

これに記事を書く途中で気づいたので、記事中で`write`文のFormatに乱れがあり、結果`n1`などスペース数の定義が節によって違うことがあります。

# その他

クリスマスプレゼントにNintendo Switch買おうかな。

# 追記

2020年7月末にざっと自分のgithubのリポジトリを見ていたら、この記事の内容をリポジトリにした

https://github.com/sage-git/fortran_xmastree

が2020 GitHub Archive Program（Arctic Code Vault）に選ばれていました。

[^1]: `__THROW`はC++などの一部環境で`throw()`をつけるためのもので、今回は無視して大丈夫です。sys/cdefs.h参照。