Intel Fortran v.11.1は、まだ完全にFortran2003に対応していないのですが、ある程度オブジェクト指向がらみの機能が実装されているので、練習してみます。
ここでは、WAVファイルのヘッダー情報を読むことを考えます。特に、WAVファイルのうちでもCDをリップして出来るものを念頭におきます。
まずWAVファイルのフォーマットを知らなければなりませんが、詳細はググッてもらうことにして、概略だけ述べます。いわゆるWAVファイルは、Microsoft社とIBM社の策定したマルチメディア・ファイル形式であるMS-RIFFフォーマットの一種になっています。ファイルは、チャンク構造をとってます。
チャンク（chunk)というのは、原義は厚切りの塊を表しており、基本的構造は
- ４バイトのASCII文字列によるチャンクID
- ４バイト（32bit）Little Endian形式の整数で表されるチャンクサイズ
- そのチャンクサイズのバイト数を持つチャンクの内容
からなります。チャンクサイズは、チャンク全体のサイズではなく、チャンク本体の内容のサイズです。WAVファイル中の整数は、すべてLittle Endian形式になっています。
WAVファイルは、WAVEフォーマットをもつMS-RIFF形式の単一のチャンクです。（但し、末尾に別のチャンクがくっついても構わないようです。）MS-RIFF形式のチャンクの場合、
- チャンクIDは４バイトASCII大文字'RIFF'
- チャンクサイズはファイルサイズ−８(byte)の整数（末尾に別のチャンクがくっついていない場合）
- チャンクの本体（WAVEフォーマット）
- ４バイトのASCII大文字'WAVE'
- 'fmt 'チャンク
- 任意のチャンク（無くてもよい。一般的には無い。）
- 'data'チャンク
のようになっています。つまり、チャンクの中に複数のチャンクが入っている構造になっています。（MS-RIFF WAVEフォーマットの規格による厳密な定義を見たことが無いので、fmt/data/その他のチャンクの順序については保障できません。しかし、見たことがある範囲ではこのようになっていました。以下のプログラムでも、この順番を仮定しています。）
'fmt 'チャンクは、
- チャンクIDは、３バイトのASCII小文字および1バイトのASCII空白で'fmt '
- チャンクサイズは１６
- チャンク本体
- ２バイト整数２つ
- ４バイト整数２つ
- ２バイト整数２つ
からなっています。チャンクの本体はチャンクサイズが示すように合計１６バイトからなります。その詳細は、今は触れないことにします。
'data'チャンクは、
- チャンクIDは、４バイトASCII小文字で'data'
- チャンクサイズ、すなわち以下に続くPCM(pulse code modulation)データのバイト数
- チャンク本体
- １６ビット符号付整数による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
