Моцарт из внутреннего динамика. Сороковая симфония и delphi. Часть 1.

Привет!

Ты наверняка уже видел сороковую симфонию внутреннего динамика на моём скромном блоге. Может быть, ты даже и есть тот человек, который попросил выложить исходный код в комментарии. И если ты подписался на rss, то ты дождался и читаешь эту статью.

Идею программы я честно свистнул у друга. Скачать можно вот здесь — это полноценный проигрыватель моно-форматов через внутренний динамик (второй в списке). Написанный при этом на visual basic.
И вот я и задался идеей сделать простой аналог на delphi. Даже не аналог, а просто реализовать идею.

[вкратце]

Сороковая симфония Моцарта для телефонов nokia:

  s:='8a2 16#g2 16- 8#g2 8- 8a2 16#g2 16- 8#g2 8- 8a2 16#g2 16- 4#g2 '+
  '8.e3 4- 16- 8e3 16#d3 16- 8#c3 8- 8#c3 16b2 16- 8a2 8- 16.a2 32- 16#g2 '+
  '16- 8#f2 8- 8#f2 4- 8- 16.#g2 32- 16.#f2 32- 8#f2 8- 8#g2 16#f2 16- 8#f2'+
  ' 8- 8#g2 16#f2 16- 4#f2 8#d3 4- 8- 8#d3 8#c3 8c3 8- 8c3 8a2 16.#g2 8-'+
  ' 32- 8#g2 8#f2 8e2 8- 8e2 4- 8- 8e3 16#d3 16- 4#d3 4#f3 4c3 4#d3 4#c3 '+
  '4#g2 4- 16.e3 32- 16#d3 16- 4#d3 4#f3 4c3 4#d3 4#c3 4e3 8#d3 8#c3 8b2 8a2 '+
  '1#g2 1g2 2#g2 4- 16#g1 16-'+
  ' 16#g1 16- 2#g1 4- 16#g1 16- 16#g1 16- 2#g1 4- 16#g1 16- 16#g1 16- 8#g1 '+
  '8- 16#g1 16- 16#g1 16- 8#g1 8- 16#g1 16- 16#g1 16- 2#g1';

Это я её уже записал в переменную s.

Между begin и end в коде проекта всего четыре строки. И это была первая ;)
А вот и остальные:

  a:=FillInTAOS(s);
  for i:=0 to length(a)-1 do
    PlaySound(ParseSound(a[i]));

Интересно? А вот. Все эти процедуры я разместил в отдельном модуле. Так красивее :)
Ах да, переменные:

var
  a:taos;
  i:integer;
  s:string;

[типы]

Ты уже заметил тип taos, это я так сократил array of string, а конкретнее:

type taos = array of string[6];

Зачем мне массив из шести строк? Сам уже не помню, значит позже выясним ;)

И еще пара типов:

type
  TNote = record
    a: real;
    b: real;
  end;

  TSound = record
    n: TNote;
    l: integer;
    t: boolean;
    d: boolean;
  end;

Итак, TNote — нота, ты уже понял это, правда? Зачем же нам запись из двух чисел? (И вправду, зачем?)
А, вот. Мы задаём константы:

const
  ndo: TNote = (a: 261.63; b: 277.18);
  nre: TNote = (a: 293.67; b: 311.13);
  nmi: TNote = (a: 329.63; b: 349.22);
  nfa: TNote = (a: 349.22; b: 369.99);
  nso: TNote = (a: 391.99; b: 415.30);
  nla: TNote = (a: 440.00; b: 466.16);
  nsi: TNote = (a: 493.88; b: 	523.25);
  nsl: TNote = (a:      0; b:      0);

Так вот, a это основная нота, а b это диез, то есть сдвиг на полутон. Эти числа — частота в герцах ноты в первой октаве. Эти цифры можно запросто найти в гугле. Также можно сдвинуть значения на несколько нот, тогда результат будет в другой гамме. В общем, есть над чем экспериментировать. К примеру, попробуй другую октаву использовать.
Еще кое-что забыл, странная нота nsl — просто пауза. Да-да! Самая обычная пауза, смотри двадцатью строками ниже.

[звучим!]

А для других октав не грех пересчитать:

function oct(n: TNote; oct: integer): TNote;
begin
  Result.a:= n.a * IntPower(2, oct - 1);
  Result.b:= n.b * IntPower(2, oct - 1);
end;

Ну всё ясненько, да? Мы передаем образец ноты из наших констант и октаву, которую желаем, и получаем результат в виде ноты. Функцию IntPower, находящуюся в модуле math, дорогой друг, мы тупо скопируем оттуда за ненадобностью всего остального модуля. В исходнике увидишь.

Теперь давай извлечем звук:

procedure notebeep(n:TNote; d:boolean; ms:integer);
begin
  if n.a = nsl.a then begin
    Sleep(ms);
    Exit;
  end;
  if d then
    Beep(Round(n.b), ms)
  else
    Beep(Round(n.a), ms);
end;

Если мы с тобой получили nsl (паузу), то засыпаем на полученное время. Так как у нас нет окна, я позволил себе использовать простой Sleep — api функция, находится в kernel32.dll, но нас это не заботит, так как она импортирована в модуле windows.pas, который мы используем. Единственный кстати, если не учитывать собственный модуль программы.
Если мы получили d — то звучим со сдвигом на пол тона (диез) (b в TNote), иначе просто указанной нотой (a в TNote). ms — длина, это же очевидно.

Далее стоит определиться с временем звучания. Разберемся с нашим типом TSound. Он включает в себя запись n: TNote, число l: integer — длину, но относительно темпа, об этом дальше. И логические значения t и d. d в случае минора, а t указывает на то, что звучание ноты надо продлить на 50% — обязательно прочти следующие параграфы, и поймёшь, зачем оно.

И да, играем типом TSound:

procedure PlaySound(s: TSound);
var
  len: integer;
begin
  len:=notlen(s.l, 225);
  if s.t then
    len:=len + len div 2;
  notebeep(s.n, s.d, len);
end;

Итак… Не, лень взяла своё. Параграф [парсим], а также ответы на насущные вопросы жди во второй части статьи. Она на подходе. В ней мы допишем эту программу, от звучания которой можно забраться на потолок (подробнее про потолки и отбеливание смотри на http://www.f-c-g.ru/)

(c) crystalbit, http://parsers.info

UPD Часть 2