fortran66のブログ

fortran について書きます。

OOPの練習

Intel Fortran v.11.1は、まだ完全にFortran2003に対応していないのですが、ある程度オブジェクト指向がらみの機能が実装されているので、練習してみます。

ここでは、WAVファイルのヘッダー情報を読むことを考えます。特に、WAVファイルのうちでもCDをリップして出来るものを念頭におきます。

まずWAVファイルのフォーマットを知らなければなりませんが、詳細はググッてもらうことにして、概略だけ述べます。いわゆるWAVファイルは、Microsoft社とIBM社の策定したマルチメディア・ファイル形式であるMS-RIFFフォーマットの一種になっています。ファイルは、チャンク構造をとってます。

チャンク(chunk)というのは、原義は厚切りの塊を表しており、基本的構造は

  1. 4バイトのASCII文字列によるチャンクID
  2. 4バイト(32bit)Little Endian形式の整数で表されるチャンクサイズ
  3. そのチャンクサイズのバイト数を持つチャンクの内容

からなります。チャンクサイズは、チャンク全体のサイズではなく、チャンク本体の内容のサイズです。WAVファイル中の整数は、すべてLittle Endian形式になっています。

WAVファイルは、WAVEフォーマットをもつMS-RIFF形式の単一のチャンクです。(但し、末尾に別のチャンクがくっついても構わないようです。)MS-RIFF形式のチャンクの場合、

  1. チャンクIDは4バイトASCII大文字'RIFF'
  2. チャンクサイズはファイルサイズ−8(byte)の整数(末尾に別のチャンクがくっついていない場合)
  3. チャンクの本体(WAVEフォーマット)
  • 4バイトのASCII大文字'WAVE'
  • 'fmt 'チャンク
  • 任意のチャンク(無くてもよい。一般的には無い。)
  • 'data'チャンク

のようになっています。つまり、チャンクの中に複数のチャンクが入っている構造になっています。(MS-RIFF WAVEフォーマットの規格による厳密な定義を見たことが無いので、fmt/data/その他のチャンクの順序については保障できません。しかし、見たことがある範囲ではこのようになっていました。以下のプログラムでも、この順番を仮定しています。)

'fmt 'チャンクは、

  1. チャンクIDは、3バイトのASCII小文字および1バイトのASCII空白で'fmt '
  2. チャンクサイズは16 
  3. チャンク本体
  • 2バイト整数2つ
  • 4バイト整数2つ
  • 2バイト整数2つ

からなっています。チャンクの本体はチャンクサイズが示すように合計16バイトからなります。その詳細は、今は触れないことにします。

'data'チャンクは、

  1. チャンクIDは、4バイトASCII小文字で'data'
  2. チャンクサイズ、すなわち以下に続くPCM(pulse code modulation)データのバイト数
  3. チャンク本体
  • 16ビット符号付整数によるPCMデータ。ステレオの場合LR,LR・・・順のデータ並び

からなっています。

■実行結果

ファイルをオープンし、エラーが無ければ

  • MS-RIFF WAVE形式のファイルであれば.TRUE.を返す。
  • fmt チャンクがあれば.TRUE.を返す。
  • 余計なチャンクを読み飛ばしつつ、dataチャンクが見つかったら.TRUE.を返す。

ということを実行しています。

■ソース・プログラム

試行錯誤中なので、妙なところは大目に見てください。IntelのプロセッサはLittle endianなので、ここでは数値のフォーマットがLittle endianであることを仮定しています。

MODULE m_wavio
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: t_wavfile

  TYPE :: t_chunk
     CHARACTER(4) :: chunkid
     INTEGER(4) :: chunksize
  END TYPE t_chunk

  TYPE, EXTENDS(t_chunk) :: t_fmt
     INTEGER(2) :: format_id, channel
     INTEGER(4) :: sampling_rate
     INTEGER(4) :: bytes_per_sec
     INTEGER(2) :: block_size, bits_per_sample
  END TYPE t_fmt

  TYPE, EXTENDS(t_chunk) :: t_data
     ! PCM data 16bit L R
  END TYPE t_data

  TYPE, EXTENDS(t_chunk) :: t_riffwav
     CHARACTER(4) :: formattag = 'WAVE'
     TYPE (t_fmt ) :: fmt
     TYPE (t_data) :: dat
  END TYPE t_riffwav



  TYPE, EXTENDS(t_riffwav) :: t_wavfile
     INTEGER :: unit = 10
     INTEGER :: ipos
     CHARACTER(:), ALLOCATABLE :: fn
   CONTAINS
     PROCEDURE :: openfile
     PROCEDURE :: closefile
     PROCEDURE :: chk_riffwav
     PROCEDURE :: chk_fmt_chunk
     PROCEDURE :: chk_data_chunk
  END TYPE t_wavfile

 CONTAINS

  LOGICAL FUNCTION openfile(this, fn)
    CLASS(t_wavfile), INTENT(IN OUT) :: this
    CHARACTER(*), INTENT(IN) :: fn
    INTEGER :: io

    this%fn = fn
    OPEN(this%unit, FILE = this%fn, ACCESS = 'STREAM', IOSTAT = io, STATUS = 'OLD', FORM = 'UNFORMATTED')
    IF (io /= 0) THEN
     openfile = .FALSE.
    ELSE
     openfile = .TRUE.
    END IF

    RETURN
  END FUNCTION openfile

!   finalization
  SUBROUTINE closefile(this)
    CLASS(t_wavfile), INTENT(IN) :: this

    CLOSE(this%unit)

    RETURN
  END SUBROUTINE closefile



  LOGICAL FUNCTION chk_riffwav(this)
    CLASS(t_wavfile), INTENT(IN OUT) :: this

    READ(this%unit) this%t_chunk 
    IF (this%chunkid == 'RIFF') THEN
      READ(this%unit) this%formattag
      IF (this%formattag == 'WAVE') THEN
        chk_riffwav = .TRUE.
      ELSE
        chk_riffwav = .FALSE.
      END IF
    ELSE
      chk_riffwav = .FALSE.
    END IF

    RETURN
  END FUNCTION chk_riffwav



  LOGICAL FUNCTION chk_fmt_chunk(this)
    CLASS(t_wavfile), INTENT(IN OUT) :: this
    TYPE :: t_fmt_sequence
      SEQUENCE
      CHARACTER(4) :: chunkid
      INTEGER(4) :: chunksize
      INTEGER(2) :: format_id, channel
      INTEGER(4) :: sampling_rate
      INTEGER(4) :: bytes_per_sec
      INTEGER(2) :: block_size, bits_per_sample
    END TYPE t_fmt_sequence
    TYPE (t_fmt_sequence) :: fmt

    READ(this%unit) fmt
    IF (fmt%chunkid == 'fmt ') THEN
      this%fmt%chunkid         = fmt%chunkid
      this%fmt%chunksize       = fmt%chunksize
      print *, fmt%chunksize
      this%fmt%format_id       = fmt%format_id
      this%fmt%channel         = fmt%channel
      this%fmt%sampling_rate   = fmt%sampling_rate
      this%fmt%bytes_per_sec   = fmt%bytes_per_sec
      this%fmt%block_size      = fmt%block_size
      this%fmt%bits_per_sample = fmt%bits_per_sample
      chk_fmt_chunk = .TRUE.
    ELSE
      chk_fmt_chunk = .FALSE.
    END IF

    RETURN
  END FUNCTION chk_fmt_chunk



  LOGICAL FUNCTION chk_data_chunk(this)
    CLASS(t_wavfile), INTENT(IN OUT) :: this
    TYPE (t_chunk) :: chunk

    INQUIRE(this%unit, POS = this%ipos)
    DO
      READ(this%unit, POS = this%ipos) chunk
      IF (chunk%chunkid == 'data') THEN
        chk_data_chunk = .TRUE.
        EXIT
      ELSE
        this%ipos = this%ipos + 8 + chunk%chunksize
      END IF
    END DO

    RETURN
  END FUNCTION chk_data_chunk

END MODULE m_wavio

!====================

PROGRAM test
  USE m_wavio
  IMPLICIT NONE
  TYPE (t_wavfile), ALLOCATABLE :: wavfile
  LOGICAL :: dummy
  
  ALLOCATE( wavfile )
  IF ( wavfile%openfile('lyra.wav') ) THEN
    PRINT *, wavfile%chk_riffwav()
    PRINT *, wavfile%chk_fmt_chunk()
    PRINT *, wavfile%chk_data_chunk()
    CALL wavfile%closefile()
  ELSE
    STOP 'open error: wav file not found'
  END IF

  STOP
END PROGRAM test