challenge Tiny MML

文字列の入力をとり、音を鳴らすプログラムを作ってください。

入力はcがド、dがレ、eがミ、fがファ、gがソ、aがラ、bがシ、rが休符とします。この8文字以外の文字は入力に含まれていないと仮定して構いません。おのおのの音符・休符は八分音符・八分休符とします。

オクターブや音の長さの変更、同時発音などの機能は不要です。

サンプル入力(カエルの歌)

cdefedcrefgagfercrcrcrcrcdefedcr

Posted feedbacks - Nested

Flatten Hidden
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
using System;
using System.Runtime.InteropServices;
using System.Threading;

class Program
{
  [DllImport("kernel32.dll")]
  extern static bool Beep(uint f, uint d);
  static void Main()
  {
    Play("cdefedcrefgagfercrcrcrcrcdefedcr");
  }
  static void Play(string s)
  {
    uint[] dt = {440, 494, 262, 294, 330, 349, 392};
    foreach (char c in s)
    {
      if (c == 'r') Thread.Sleep(500);
      else Beep(dt[c - 'a'], 500);
    }
  }
}
とりあえずbeepで。win専用。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
import winsound
import time

def play(mmf):
  toi = lambda x: int(ord(x))
  for n in mmf:
    if n == 'r': time.sleep(0.5)
    else : winsound.Beep(play.fq[toi(n)-toi('a')], 500)
play.fq = [440, 494, 262, 294, 330, 349, 392]

play("cdefedcrefgagfercrcrcrcrcdefedcr")
ordの返り値は元からintなのでtoiを定義する必要はないですね。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
import winsound
import time

PLAY_FQ = [440, 494, 262, 294, 330, 349, 392]

def play(mmf):
    for n in mmf:
        if n == 'r':
            time.sleep(0.5)
        else:
            winsound.Beep(
                PLAY_FQ[ord(n) - ord('a')], 500)

play("cdefedcrefgagfercrcrcrcrcdefedcr")
ありゃ、そのとおり。夜に適当に書いたので頭がボーっとしていたのかもしれません(^^; ご指摘ありがとうございます。
MIDIマッパーを使って再生。Windows専用。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
#include <windows.h>
#include <mmsystem.h>

#include <iostream>
#include <stdexcept>
#include <string>

#define MIDIMSG(status, channel, data1, data2) ((DWORD)((status<<4) | channel | (data1<<8) | (data2<<16)))

void check(MMRESULT result)
{
    if (result != MMSYSERR_NOERROR)
    {
        throw std::runtime_error("mmsystem error");
    }
}

class midi
{
public:
    midi()
    {
        check(::midiOutOpen(&_h, MIDI_MAPPER, 0, 0, CALLBACK_NULL));
    }

    ~midi()
    {
        check(::midiOutClose(_h));
    }

    void play(DWORD note)
    {
        check(::midiOutShortMsg(_h, MIDIMSG(0x9, 0, note, 100)));
        wait();
        check(::midiOutReset(_h));
    }

    void wait()
    {
        ::Sleep(500);
    }

private:
    HMIDIOUT _h;
};

void play(const char* s)
{
    midi m;

    for (; *s; ++s)
    {
        switch (*s)
        {
            case 'c': m.play(60); break;
            case 'd': m.play(62); break;
            case 'e': m.play(64); break;
            case 'f': m.play(65); break;
            case 'g': m.play(67); break;
            case 'a': m.play(69); break;
            case 'b': m.play(71); break;
            case 'r': m.wait(); break;
            default:
                throw std::runtime_error("invalid note");
        }
    }
}

int main(int argc, char* argv[])
{
    try
    {
        if (argc != 2)
        {
            play("cdefedcrefgagfercrcrcrcrcdefedcr");
        }
        else
        {
            play(argv[1]);
        }
    }
    catch (std::exception& e)
    {
        std::cout << e.what() << std::endl;
    }
}
上のと同じコードをPython+ctypesを使って記述。音の長さは他の人のコードを参考にして0.25秒に変更しました。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
import ctypes
import time
import sys

MIDI_MAPPER = -1
MMSYSERR_NOERROR = 0
CALLBACK_NULL = 0

class Midi:
    def __init__(self):
        self._dll = ctypes.windll.winmm
        self._h = ctypes.c_void_p()
        self._call("midiOutOpen", ctypes.byref(self._h), MIDI_MAPPER, 0, 0, CALLBACK_NULL)

    def __del__(self):
        self._call("midiOutClose", self._h)

    def play(self, note):
        self._call("midiOutShortMsg", self._h, self._msg(0x9, 0, note, 100))
        self.wait()
        self._call("midiOutReset", self._h)

    def wait(self):
        time.sleep(0.25)

    def _call(self, name, *args):
        ret = getattr(self._dll, name)(*args)
        if ret != MMSYSERR_NOERROR:
            raise RuntimeError("mmsystem error (%s)" % hex(ret))

    def _msg(self, status, channel, data1, data2):
        return (status<<4) | channel | (data1<<8) | (data2<<16)

def play(s):
    m = Midi()
    notes = {'c': 60, 'd': 62, 'e': 64, 'f': 65,
             'g': 67, 'a': 69, 'b': 71}
    for c in s:
        if c == 'r':
            m.wait()
        else:
            m.play(notes[c])

def main():
    if len(sys.argv) == 2:
        play(sys.argv[1])
    else:
        play("cdefedcrefgagfercrcrcrcrcdefedcr")

if __name__ == '__main__':
    main()
テンポの基準を120:八分音符は0.25秒と仮定しています。

> MML("cdefedcrefgagfercrcrcrcrcdefedcr")
1
2
3
4
5
6
require("sound")
MML <- function(score){
    freq  <- c(c=262, d=294, e=330, f=349, g=392, a=440, b=494, r=0)
    play(appendSample(as.Sample(unlist(sapply(unlist(strsplit(score, "")), 
         function(s){return(Sine(freq[s], 0.25))})))))
}
Audio::Beep は CPAN で。 MML は引数にして下さい。
1
2
3
4
5
use Audio::Beep;

my $music = $ARGV[0];
$music =~ s/(.)/\1 /g;
Audio::Beep->new()->play($music);
適当に。なぜかオルゴール音色。
そういえばMIDI検定という謎な検定持ってます。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
import javax.sound.midi.spi._
import javax.sound.midi._

def play_mmf(mmf:String):unit = {
  val noteMap = Map('c' -> 60, 'd' -> 62, 'e' -> 64, 'f' -> 65,
                    'g' -> 67, 'a' -> 69, 'b' -> 71)
  val crotchet = 24
  val channel = 0
  val inst    = 11
  val velocity= 127
  var current = 0
  val sequence = new Sequence(Sequence.PPQ, crotchet)
  val track = sequence.createTrack

  var m = new ShortMessage
  m.setMessage(ShortMessage.PROGRAM_CHANGE,channel, inst, 0)
  track.add(new MidiEvent(m,0))

  def addEvent(t:int, pitch:int, pos:int):unit = {
    var m = new ShortMessage
    m.setMessage(t, channel, pitch, velocity)
    track.add(new MidiEvent(m, pos))
  }
  def interval = current = current + crotchet/2
  def addNote(pitch:int):unit = {
    addEvent(ShortMessage.NOTE_ON, pitch, current)
    interval
    addEvent(ShortMessage.NOTE_OFF, pitch, current)
  }

  mmf.foreach(n => n match{
    case 'r' => interval
    case x   => addNote(noteMap(x))
  })

  val sequencer = MidiSystem.getSequencer
  sequencer.addMetaEventListener(new MetaEventListener(){
     def meta(meta:MetaMessage):unit = meta.getType match {
          case 47 => sequencer.close()
                     System.exit(0);
          case _  => ()
      }
  });
  sequencer.open
  sequencer.setSequence(sequence)
  sequencer.start
}
play_mmf("cdefedcrefgagfercrcrcrcrcdefedcr")
Squeak Smalltalk で。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
| score pitches duration loudness sequence sound |
score := 'cdefedcrefgagfercrcrcrcrcdefedcr'.
duration := 1/8 * 2.
loudness := 500.
pitches := FMSound chromaticPitchesFrom: #c4.
sequence := score asArray collect: [:pName |
   pName = $r
      ifTrue: [{#rest. duration}]
      ifFalse: [{pitches at: ('c d ef g a b' indexOf: pName). duration. loudness}]].
sound := AbstractSound noteSequenceOn: FMSound default from: sequence.
sound play
one linerで。

FreeBSDで動きます(*BSDかも)。
ちなみにFreeBSDにはデフォルトでbeepコマンドがない(はず)です。
1
ruby -e 'open("/dev/speaker", "w"){|d| d.print "l8"+ARGV.shift.gsub("r","n")}' cdefedcrefgagfercrcrcrcrcdefedcr
標準の命令を使わずにWindowsAPIを呼んでます。
コード自体はいたって普通です。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
●ビープ(x, y) = DLL("kernel32", "BOOL Beep(DWORD, DWORD)")

音階@「c」は262
音階@「d」は294
音階@「e」は330
音階@「f」は349
音階@「g」は392
音階@「a」は440
音階@「b」は494

「cdefedcrefgagfercrcrcrcrcdefedcr」を鳴らす

*鳴らす(楽譜を)
 楽譜を文字列分解して反復
  もしそれが「r」ならば
   0.5秒待つ
  違えば
   ビープ(音階@それ, 500)
#1433をヒントにして、自前で正弦波を生成しました。
式は適当ですが、一応それっぽい音はします。

利用パッケージの都合で、Linuxと*BSD(?)のみ対応です。

8分音符は0.5秒にしました。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
import math
import struct
import ossaudiodev

def sw(r, f, t):
  return struct.pack('h', int(math.sin((t/(float(r)/f))*2*math.pi)*0x7fff))

wav = {
  'c': ''.join([sw(8000, 262, i) for i in range(4000)]),
  'd': ''.join([sw(8000, 294, i) for i in range(4000)]),
  'e': ''.join([sw(8000, 330, i) for i in range(4000)]),
  'f': ''.join([sw(8000, 349, i) for i in range(4000)]),
  'g': ''.join([sw(8000, 392, i) for i in range(4000)]),
  'a': ''.join([sw(8000, 440, i) for i in range(4000)]),
  'b': ''.join([sw(8000, 494, i) for i in range(4000)]),
  'r': '\x00\x00' * 4000
}

dsp = ossaudiodev.open('w')
dsp.setparameters(ossaudiodev.AFMT_S16_LE, 1, 8000)
dsp.writeall(''.join([wav[c] for c in 'cdefedcrefgagfercrcrcrcrcdefedcr']))
dsp.flush()
dsp.close()
Mathematicaも数式処理ソフトですが,サウンド用の機能があります.
Mathematica6で強化されて,いろいろな音色で音階を奏でることが可能になっています.

Mathematicaでは,音を出さない場合 None を指定するので,MMLのrをNoneにマップしています.

http://reference.wolfram.com/mathematica/ref/SoundNote.ja.html

音階がグラフっぽく出るので見た目がきれいです.
1
2
3
4
5
len = 0.25; (* sec *)
tone = "Organ";
mml = "cdefedcrefgagfercrcrcrcrcdefedcr";
mathmml = StringSplit[mml, ""] /. {"r" -> None};
Sound[{tone, SoundNote[#, len] & /@ mathmml}]
javax.soud.midiパッケージを使用しています。初めてなので改善点などご指摘いただけましたら幸いです(音がちゃんと消えていないような)…… タイミングの制御をちゃんとやっていないのでたどたどしい演奏になります(苦笑)
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
import javax.sound.midi.MidiSystem;
import javax.sound.midi.Receiver;
import javax.sound.midi.ShortMessage;
import javax.sound.midi.InvalidMidiDataException;
import javax.sound.midi.MidiUnavailableException;

public class TinyMML {
    private final static int[] code = {69, 71, 60, 62, 64, 65, 67};
    private final static int TONE = 120;

    public static void play(String mml) throws InvalidMidiDataException,
                                               MidiUnavailableException, 
                                               InterruptedException {
        ShortMessage mes = new ShortMessage();
        Receiver rcvr = MidiSystem.getReceiver();
        for (int i = 0; i < mml.length(); i++) {
            char c = mml.charAt(i);
            if (c >= 'a' && c <= 'g') {
                int co = code[c - 'a'];
                mes.setMessage(ShortMessage.NOTE_ON, 0, co, TONE);
                rcvr.send(mes, -1);
                Thread.sleep(500);
                mes.setMessage(ShortMessage.NOTE_OFF, 0, co);
                rcvr.send(mes, -1);
            } else {
                Thread.sleep(500);
            }
        }
        rcvr.close();
    }

    public static void main(String[] args) throws Exception {
        play(args[0]);
        System.exit(0);
    }
}
音がちゃんと消えていない理由がわかりました。
23行目に間違いがあります。正しくは
mes.setMessage(ShortMessage.NOTE_OFF, 0, co, 0);
でした。
こんにちわ。
上のかたの、音消しは
mes.setMessage(ShortMessage.NOTE_OFF, 0, co);
ではなく
mes.setMessage(ShortMessage.NOTE_OFF, 0, co, 0);
または
mes.setMessage(ShortMessage.NOTE_OFF | 0, co, 0);
ではないでしょうか?
サンプリングレート: 8000
PCMフォーマット: 8bit
% gcc sound.c -lm
でコンパイル出来ます、linux で鳴るはずです。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
include <stdio.h>
#include <string.h>
#include <math.h>
#include <unistd.h>
#include <sys/ioctl.h>
#include <fcntl.h>
#include <linux/soundcard.h>

#define RATE 8000

double sol_fa[] = {880.0, 987.0, 523.0, 587.0, 659.0, 698.0, 784.0};

void play(int fd, const char *str){
    int i, j;
    unsigned char buf[RATE];
    double freq;
    int len = strlen(str);
    for(i=0; i<len; i++){
        if('a' <= str[i] && str[i] <= 'g')
            freq = sol_fa[str[i] - 'a'];
        else
            freq = 0;
        for (j = 0;j < RATE; j++)
            buf[j] = 255 * sin(2.0 * M_PI * freq * j / RATE);
        write(fd, buf, RATE);
    }
}

int main( void )
{
    int fd;
    int fmt = AFMT_U8;
    int channels = 1;
    int rate = RATE;

    fd = open("/dev/dsp", O_WRONLY);
    ioctl(fd, SOUND_PCM_SETFMT, &fmt);
    ioctl(fd, SOUND_PCM_WRITE_CHANNELS, &channels);
    ioctl(fd, SOUND_PCM_WRITE_RATE, &rate);
    play(fd, "cdefedcrefgagfercrcrcrcrcdefedcr");
    close(fd);
    return 0;
}
解説ブログ記事があったのでリンクしときます。
OpenAL使用。カエルの歌はあんまり好きじゃないので、曲は自分で作った。

拡張仕様:
* 0-9 でオクターブ変更、デフォルト5。
* C, D, F, G, A でそれぞれ元の音から半音上げる。
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
import Control.Concurrent
import Data.Char
import Data.Map (Map)
import qualified Data.Map as M
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Sound.OpenAL

freqForNote :: Char -> Double
freqForNote 'c' = 261.626
freqForNote 'C' = 277.183 -- C# (拡張仕様、互換性有)
freqForNote 'd' = 293.628
freqForNote 'D' = 311.127 -- D# (以下同様)
freqForNote 'e' = 329.628
freqForNote 'f' = 349.228
freqForNote 'F' = 369.994 -- F#
freqForNote 'g' = 391.995
freqForNote 'G' = 415.305 -- G#
freqForNote 'a' = 440
freqForNote 'A' = 466.164 -- A#
freqForNote 'b' = 493.883
freqForNote 'r' = 0

scoreToFreqs :: String -> [Double]
scoreToFreqs = scoreToFreqs' 5 -- 5 が中心
    where
      scoreToFreqs' :: Int -> String -> [Double]
      scoreToFreqs' _      []     = []
      scoreToFreqs' octave (x:xs)
          | isDigit x
              -- オクターブ変更 (拡張仕様、互換性有)
              = scoreToFreqs' (fromEnum x - fromEnum '0') xs
          | otherwise
              = (freqForNote x) * (2 ^^ (octave - 5))
                : scoreToFreqs' octave xs

mkNote :: Int -> Double -> Double -> IO Buffer
mkNote samplFreq sec noteFreq
    = let nSamples = round $ (realToFrac samplFreq) * sec
          bufSize  = nSamples
      in 
        allocaBytes bufSize $ \ mem ->
        do renderToMemBuf mem bufSize
           let memRegion = MemoryRegion mem (fromIntegral bufSize)
               bufData   = BufferData memRegion Mono8 (realToFrac samplFreq)
           [buf] <- genObjectNames 1
           bufferData buf $= bufData
           return buf
    where
      renderToArray :: Int -> [ALubyte]
      renderToArray len = map calcFrame [0 .. len - 1]

      calcFrame :: Int -> ALubyte
      calcFrame n = let frame = sin $
                                2
                                * pi
                                * noteFreq
                                * (realToFrac n / realToFrac samplFreq)
                    in
                      -- -1.0 <= frame <= 1.0
                      floor $ 127 * frame + 128

      renderToMemBuf :: Ptr ALubyte -> Int -> IO ()
      renderToMemBuf mem len = pokeArray mem (renderToArray len)

mkEachBuffers :: Int -> Double -> [Double] -> IO (Map Double Buffer)
mkEachBuffers sampleFreq sec = updateMap M.empty
    where
      updateMap m []     = return m
      updateMap m (x:xs)
          | M.member x m
              = updateMap m xs
          | otherwise
              = do buf <- mkNote sampleFreq sec x
                   updateMap (M.insert x buf m) xs

main = do deviceM <- openDevice Nothing
          case deviceM of
            Nothing
                -> fail "failed to open audio device"
            Just dev
                -> do ctxM <- createContext dev []
                      case ctxM of
                        Nothing
                            -> fail "failed to create context"
                        Just ctx
                            -> do currentContext $= Just ctx
                                  putStrLn "creating buffers..."

                                  let freqs = scoreToFreqs score
                                  buffers <- mkEachBuffers 8000 0.2 freqs
                                  notes   <- mapM (flip M.lookup buffers) freqs

                                  putStrLn "ok. playing..."

                                  [src] <- genObjectNames 1
                                  -- 手抜き。全部の音符を一気にキューに
                                  -- 入れるのは本当は良くない。
                                  queueBuffers src notes
                                  play [src]
                        
                                  waitTillDone src
                                  putStrLn "done."
    where
      waitTillDone :: Source -> IO ()
      waitTillDone src
          = do state <- get (sourceState src)
               case state of
                 Playing -> threadDelay (50 * 1000) >> waitTillDone src
                 _       -> return ()

score :: String
-- score = "cdefedcrefgagfercrcrcrcrcdefedcr"
score = "5daagabaFed4ba" ++ "5daagabaFeFer"   ++
        "5daagabaFedeF"  ++ "5gabFede4b5eFer" ++
        "5daagabaFed4ba" ++ "5daagabaFeFer"   ++
        "5daagabaFedeF"  ++ "5gabFede4b5eFer" ++

        "5babaFabaFeFr"  ++ "5eFaFed4bab5CdF" ++
        "5babaFabaFeFr"  ++ "5eFedFabbbr6dC"  ++
        "5babaFabaFeFr"  ++ "5eFaFed4bab5CdF" ++
        "5babaFabaFeFr"  ++ "5eFedFabbbrFF"   ++

        "5ebeFgFeged4b5d" ++ "5ebeFgebagbar"  ++
        "5ebeFgFeded4br"  ++ "5cdebagFFered"  ++
        "5ebeFgFeged4b5d" ++ "5ebeFgebagbar"  ++
        "5ebeFgFeded4br"  ++ "5cdebagFFerer"  ++

        "5daagabaFed4ba" ++ "5daagabaFeFer"   ++
        "5daagabaFedeF"  ++ "5gabFede4b5eFer" ++
        "5daagabaFed4ba" ++ "5daagabaFeFer"   ++
        "5daagabaFedeF"  ++ "5gabFedeFed4b5d" ++
        "5eee"

	
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
import javax.sound.midi.*
import static javax.sound.midi.ShortMessage.*
code = [69, 71, 60, 62, 64, 65, 67]
TONE = 120
function play(mml){
  mes = new ShortMessage()
  rcvr = MidiSystem.getReceiver()
  for (c: mml) {
      if (c >= 'a' && c <= 'g') {
          co = code[c - 'a']
          mes.setMessage(NOTE_ON, 0, co, TONE)
          rcvr.send(mes, -1)
          sleep(500)
          mes.setMessage(NOTE_OFF, 0, co)
          rcvr.send(mes, -1)
      } else {
          sleep(500)
      }
  }
  rcvr.close()
}
play("cdefedcrefgagfercrcrcrcrcdefedcr")
Snack という Tcl/Python 向けの音声ライブラリを使用しました。Snack は ActiveTcl のディストリビューションにも含まれています。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
package require snack

set C     262
set dur   4000
set beat  5000
set amp   30000
set score cdefedcrefgagfercrcrcrcrcdefedcr

set freq $C
foreach note {c _ d _ e f _ g _ a _ b} {
  set freq [expr {$freq * pow(2, 1. / 12.)}]
  set osc  [snack::filter generator $freq $amp 0.0 sine $dur]
  snack::sound $note
  $note filter $osc
  $note length $beat
}
snack::sound r; r length $beat

snack::sound snd
foreach note [split $score {}] {
  snd concatenate $note
}
snd play -blocking yes
# snd write kaeru.wav -fileformat WAV 
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
#light
open System
open System.Runtime.InteropServices
open System.Threading

[<DllImport("kernel32.dll")>]

let Beep (dwFreq:int) (dwDuration:int) :bool = failwith ""
let toNum = function
    | 'c' -> 262
    | 'd' -> 294
    | 'e' -> 330
    | 'f' -> 349
    | 'g' -> 392
    | 'a' -> 440
    | 'b' -> 494
    | _ -> 0

let play (s:string) =
    for c in s do
        if (toNum c) = 0 then Thread.Sleep( 500 )
        else Beep (toNum c) 500 |> (fun b -> ())
    done

do play "cdefedcrefgagfercrcrcrcrcdefedcr"
MML からAIFFファイルを生成し(※単純な正弦波です)iTunes等のプレイヤーに渡します。
とりあえず OS X での動作しか考えていませんが... 

A音の周波数設定 / テンポ / サンプリング周波数 / 純正律・平均律 / サンプルサイズ(8bit・16bit) / ステレオ・モノラル設定とか・・・無駄にこだわってみました。

Gauche 0.8.10 以降でないと動きません。
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
(use srfi-1) ;first,second,...,seventh
(use srfi-4) ;uvector
(use binary.io) ;default-endianの設定とか
(default-endian 'big-endian)

;;
;; コンフィギュレーション
;;
(define tempo 120)
;(define frequency-A 440.0)
(define frequency-A 442.0)
(define use-just-intonation #f) ;純正律を用いる。#fなら平均律
(define sample-rate (* frequency-A 4)) ; 1.768KHzでサンプリング
;(define sample-rate 44100) ; 44.1KHzでサンプリングとか
;(define sample-size 8) ; sampling size (bit)
(define sample-size 16)
;(define stereo-mode #f)
(define stereo-mode #t)

;
; 内部で使用する値
;
(define volume-maximum (floor->exact (* 0.707 (if (= sample-size 16) 32767 127)))) ; 0.707は適当な音量
(define note-duration (/ 60 tempo 2))
(define note-sample-count (floor->exact (* sample-rate note-duration)))
(define sample-bytes (ash sample-size -3))

;;
;; 自前の出力系関数
;;
; 80 bit IEEE Standard 754 floating point number
(define (write-f80 value)
  (let ((vec (make-u8vector 10 0))
		(sign-mask 0)
		(exp 16383))
	(when (< value 0) 
		  (set! sign-mask 0x8000)
		  (set! value (- value)))
	(let* ((log (/ (log value) (log 2)))
		   (exp (floor->exact log))
		   (body (/ value (expt 2 exp)))
		   (first16 (logior sign-mask (+ 16383 exp))) )
	  (u8vector-set! vec 0 (ash first16 -8))
	  (u8vector-set! vec 1 (logand first16 255))
	  (let loop ((body (* body 128))
				 (i 2))
		(when (< i 10)
			  (let1 b (floor body)
					(u8vector-set! vec i b)
					(loop (* (- body b) 256) (+ i 1))) ))
	  (write-block vec) ; u8vector
	  )))

(define (write-u32-idstr idstr)
  (let write-id ((chars (string->list idstr))
				 (n 4))
	(when (< 0 n)
		  (write-char (car chars))
		  (write-id (cdr chars) (- n 1)))))
  
(define (write-chunk-head chunk-idstr chunk-size)
  (write-u32-idstr chunk-idstr)
  (write-u32 chunk-size))

(define (write-block-s16-bigendian vec)
  (do ((i 0 (+ i 1)))
	  ((= i (s16vector-length vec)) vec)
	(write-s16 (s16vector-ref vec i))
	(when stereo-mode
		  (write-s16 (s16vector-ref vec i))) ))
;  (lambda (vec) (write-block vec (current-output-port) 0 -1 'big-endian)))

(define (write-block-s8 vec)
  (do ((i 0 (+ i 1)))
	  ((= i (s8vector-length vec)) vec)
	(write-s8 (s8vector-ref vec i))
	(when stereo-mode
		  (write-s8 (s8vector-ref vec i))) ))

(define (save-as-aiff-file file-name sound-vecs)
  (let* ((num-sample-frames (apply + (map (if (= sample-size 16) s16vector-length s8vector-length) sound-vecs)))
		 (sound-chunk-size (+ 8 (* sample-bytes num-sample-frames (if stereo-mode 2 1)))))
	(with-output-to-file file-name
	  (lambda ()
		(write-chunk-head "FORM" (+ 4 26 8 sound-chunk-size))
		(write-u32-idstr "AIFF")

		(write-chunk-head "COMM" 18)
		(write-u16 (if stereo-mode 2 1)) ; numChannels
		(write-u32 num-sample-frames) ; numSampleFrames
		(write-u16 sample-size)
		(write-f80 sample-rate)

		(write-chunk-head "SSND" sound-chunk-size)
		(write-u32 0) ; offset
		(write-u32 0) ; blocksize
		(if (= sample-size 16)
			(for-each write-block-s16-bigendian sound-vecs) ; write-block だとうまく行かなかった
			(for-each write-block-s8 sound-vecs))
		))))

;;
;; 簡易(というか正弦波)サウンドジェネレータ
;;
; 8分休符のサウンドデータを生成
(define (make-pause sample-count)
  ((if (= sample-size 16) make-s16vector make-s8vector) sample-count 0))

; 指定した周波数で8分音符のサウンドデータを生成
(define (make-note freq sample-count)
  (do ((vec (make-pause sample-count)) ;(make-s8vector sample-count))
	   (i 0 (+ i 1)))
	  ((= i sample-count) vec)
	((if (= sample-size 16) s16vector-set! s8vector-set!) vec i
	 (* volume-maximum (sin (/ (* freq 3.14159265358979323846 2 i) sample-rate))) )))

(define (make-sound-table)
  (let* ((note-frequencies (map (lambda (mag) (* frequency-A mag))
								(if use-just-intonation
									(list 3/5 27/40 3/4 4/5 9/10 1 9/8)
									(map (lambda (x) (expt 2.0 x)) (list -3/4 -7/12 -5/12 -1/3 -1/6 0 1/6)))))
		 (notes (map (lambda (freq) (make-note freq note-sample-count)) note-frequencies))
		 (pause (make-pause note-sample-count)))
	(let ((c (first notes))
		  (d (second notes))
		  (e (third notes))
		  (f (fourth notes))
		  (g (fifth notes))
		  (a (sixth notes))
		  (b (seventh notes))
		  (r pause))
	  (define (sound-data-for-note note-char)
		(case note-char
		  ((#¥r #¥R) r)
		  ((#¥c #¥C) c)
		  ((#¥d #¥D) d)
		  ((#¥e #¥E) e)
		  ((#¥f #¥F) f)
		  ((#¥g #¥G) g)
		  ((#¥a #¥A) a)
		  ((#¥b #¥B) b)
		  (else r)))
	  (define (dispatch m)
		(case m
		  ((sound-for-note) sound-data-for-note)
		  (else (print "not defined."))))
	  dispatch)))

(define sound-table (make-sound-table))

(define (play-mml mml-string)
  (let ((aiff-file-name (string-append mml-string ".aiff"))
		(notes (string->list mml-string)))
	(save-as-aiff-file aiff-file-name (map [sound-table'sound-for-note] notes))
	(sys-exec "open" (list "open" aiff-file-name)) ))

; REPL
(define (input-loop)
  (let ((line (read-line)))
	(cond ((eof-object? line) 'eof)
		  ((string=? "" line) 'quit)
		  (else (play-mml line)
				(input-loop) ))))

(input-loop)
言語間違えてる
 誤:awk
 正:scheme
どうやって直したらいいの?
こういう、高レベル言語でバイナリをいじくるコード好きです。

write-f80は組込みで持ってても良いように思い始めました。

write-u32-idstrはdisplayじゃだめなのかな。

write-block-s16-bigendianとwrite-block-s8は
(use gauche.sequence)してuvectorに直接for-eachを適用すると
シンプルになるかもしれません。 

make-noteでs16vector-set!とs8vector-set!を切り替えてるところですが、
(set! (ref vec i) ...) のようにすればジェネリックに書けます。速度は遅くなりますが。
さらに、(map-to <s8vector> (lambda (i) (* volume-maximum ...)) (iota sample-count))
のようにするとdoループも不要です。

make-sound-tableの(let ((c (first notes)) (d (second notes)) ...) のところは
util.matchを使って (let-match1 (c d e f g a b) notes ...) のようにも書けます。

shiroさん直々にご指導ありがとうございます。 write-f80 は今回は1回(ヘッダ部分にサンプリング周波数を書き込む為だけに)しか呼び出していませんが、組み込みで用意されていたら嬉しい場面ももしかしたらあるかもしれません。 ライブラリモジュールをもっと活用できるよう、今後使い込んで行きたいと思います。
周波数は計算で出したかったのですけど複雑なので諦めました☆
その代わりきらきら星をつけました☆
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
#include<windows.h>
void play(char *p){
  for(int f[]={494,261,294,329,349,392,440};*p;p++)
    if(*p=='r')
      Sleep(400);
    else
      Beep(f[*p%7],400);
}
int main(void){
  play("cdefedcrefgagfercrcrcrcrcdefedcr");
  play("ccggaagrffeeddcrggffeedrggffeedrccggaagrffeeddcr");
  return 0;
}
これはなかなか素晴らしいツール。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
(function playbeep(scr, quaver, beep){
	if(!beep) (beep = WSH.CreateObject("SfcMini.DynaCall")).Declare("kernel32", "Beep");
	if(!quaver) quaver = 250;
	var S = { c:262, d:294, e:330, f:349, g:392, a:440, b:494, r:0 };
	with(Math) scr.replace(/([a-grA-G])(\d?)(\+*)(-*)(\.?)/g, function($, s, t, p, m, d){
		var hz = s.charCodeAt(0) > 96 ? S[s] : round(S[s.toLowerCase()] * 1.06);
		var dr = round(quaver * pow(2, p.length) * pow(2, -m.length) * (d ? 1.5 : 1));
		if(hz) beep(t ? hz * pow(2, t - 3) : hz, dr);
		else WSH.Sleep(dr);
	});
})("e+g+c4++g+a+g++r.c-e.g-c4+b.a-g++.r++");
// 大文字は半音上,0~9で高さ指定(省略で3),+-.で長さ調整(伸び|縮み|付点)。
quicktimeのapi使ってますが、ただしく使えているか自信ないです...
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
import quicktime.QTSession
import quicktime.std.music.ToneDescription
import quicktime.std.music.NoteChannel
import quicktime.std.music.NoteRequest

// kaeru_song_player
// cがド、dがレ、eがミ、fがファ、gがソ、aがラ、bがシ、rが休符
def tbl = ['c':60, 'd':62, 'e':64, 'f':65, 'g':67, 'a':69, 'b':71, r:-1]
def song = "cdefedcrefgagfercrcrcrcrcdefedcr"

QTSession.open()
NoteChannel noteChannel = new NoteChannel(new NoteRequest(new ToneDescription(1)))

for(c in song){
    noteChannel.playNoteRaw(tbl[c] as int, 60)
    sleep(300)
}

QTSession.close()
Mac OSX 10.4.10(Intel)で動作確認しています。Objective-CというよりAudio Unitの使い方ですね。
永野さんのページを参考にさせていただきました。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
//コンパイルオプション:-std=gnu99 -fobjc-exceptions

#import <Foundation/Foundation.h>
#import <AppKit/AppKit.h>
#import <Audiounit/AudioUnit.h>

OSStatus callbackProc( void* inRefCon, AudioUnitRenderActionFlags* ioActionFlags,
		const AudioTimeStamp* inTimeStamp, UInt32 inBusNumber,
		UInt32 inNumberFrames, AudioBufferList* ioData ) {
	static const char notes[] = "cdefedcrefgagfercrcrcrcrcdefedcr";	//かえるの歌
	static const unsigned int length = sizeof notes - 1;	//音符の数
	static const float scale[] = { 440, 495, 264, 297, 330, 352, 396 };	//純正律音階
    static const float samplingRate = 44100;
	
	static unsigned int tempo = 160;	//テンポ:八分音符/分
	static unsigned int consumedFrames = 0;	//現在の音符の発音済みフレーム数。1分間だとsamplingRate*60
	static unsigned int index = 0;	//音符のインデックス
	static float phase = 0;
	
	char note = notes[index];
    float frequency = ( note >= 'a' && note <= 'g' ) ? scale[note - 'a'] : 0;
    frequency *= 2 * M_PI / samplingRate;

    float* outL = ioData->mBuffers[0].mData;
    float* outR = ioData->mBuffers[1].mData;

    for ( int i = 0; i < inNumberFrames; i++ ) {
        float wave = sin( phase );
        *outL++ = wave;
        *outR++ = wave;
        phase += frequency;
    }
	
	consumedFrames += inNumberFrames;
	//規定の時間が過ぎたら次の音符へ
	if ( consumedFrames >= samplingRate * 60 / tempo ) {
		consumedFrames = 0;
		//曲を最後まで演奏したら終了
		if ( ++index >= length )
			[NSApp terminate:nil];
	}
	
    return noErr;
}

BOOL initAudioUnit() {
	@try {
		ComponentDescription description = {
			kAudioUnitType_Output, kAudioUnitSubType_DefaultOutput, 
			kAudioUnitManufacturer_Apple, 0, 0
		};
		
		Component component = FindNextComponent( NULL, &description );
		if ( component == 0 )
			@throw @"Faild to find component.";
		
		AudioUnit audioUnit;
		if ( OpenAComponent( component, &audioUnit ) != noErr )
			@throw @"Faild to open component.";
		
		AURenderCallbackStruct callbackStruct = { callbackProc, NULL };
		if ( AudioUnitSetProperty( audioUnit, kAudioUnitProperty_SetRenderCallback,
				kAudioUnitScope_Input, 0, &callbackStruct, sizeof callbackStruct ) != noErr )
			@throw @"Faild to set property values for audio unit.";
		
		if ( AudioUnitInitialize( audioUnit ) != noErr )
			@throw @"Faild to initialize audio unit.";
		
		if ( AudioOutputUnitStart( audioUnit ) != noErr )
			@throw @"Faild to start audio unit.";
	} @catch ( id error ) {
		NSLog( error );
		return NO;
	}
	
	return YES;
}

int main( int argc, const char** argv ) {
    NSAutoreleasePool * pool = [[NSAutoreleasePool alloc] init];
	
	[NSApplication sharedApplication];
	if ( initAudioUnit() )
		[NSApp run];
	
    [pool release];
    return 0;
}
C#の移植。Windowsのみ
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
extern(Windows) uint Beep(uint, uint);
extern(Windows) void Sleep(uint);
void main() {
    play("cdefedcrefgagfercrcrcrcrcdefedcr");
}
void play(string s) {
    uint[] dt = [440, 494, 262, 294, 330, 349, 392];
    foreach (char c ; s) {
        if (c == 'r') Sleep(500);
        else Beep(dt[c - 'a'], 500);
    }
}
ADODB.Streamでsmfを吐いて、関連付けされたプレイヤーで再生。「音を鳴らすプログラム」・・・ではない。

-----------------------------------
C:\temp>cscript /nologo tinymml.js cdefedcrefgagfercrcrcrcrcdefedcr
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
function arrayToFile(filename, array){
  var stream = WScript.CreateObject('ADODB.Stream');
  stream.Charset = 'iso-8859-1';
  stream.Open();
  for (var i=0; i < array.length; i++)
    stream.WriteText(String.fromCharCode(array[i]));
  stream.SaveToFile(filename, 2);
  stream.Close();
}

var note = {r:0,c:60,d:62,e:64,f:65,g:67,a:69,b:71};
var body = [];
WScript.Arguments.Item(0).toLowerCase().replace(/([a-gr])/g, function(n){
  body = body.concat([0,144,note[n],n=='r'?0:90,24,144,note[n],0]);});
var size = body.length + 4;
head = [77,84,104,100,0,0,0,6,0,0,0,1,0,48,77,84,114,107,
        size>>24&0xff, size>>16&0xff, size>>8&0xff, size&0xff];
arrayToFile('sample.mid', head.concat(body.concat([0,255,47,0])));
WScript.CreateObject('WScript.Shell').run('sample.mid');

Index

Feed

Other

Link

Pathtraq

loading...