Синтез Midi инструментов

В программе Rene Werner'а для проигрыванмя миди есть такой код

asm
  mov dx,StatusPort
  @1:
  in  al,dx
  and al,DRR
  jnz @1
  mov al,[b]
  dec dx    {DataPort = StatusPort - 1}
  out dx,al
end;
 
if il>=2 then begin {Event mit 2 oder 3 Bytes}
b:=bp^; { Byte holen }
 
(*
  while port[StatusPort] and DRR <> 0 do;
  port[Dataport] := bp^;
*)
 
asm
  mov dx,StatusPort
  @2:
  in  al,dx
  and al,DRR
  jnz @2
  mov al,[b]
  dec dx
  out dx,al
end;
 
inc(bp);
if il=3 then begin { 3. Byte ?? }
b:=bp^; { Byte holen }
 
(*
  while port[StatusPort] and DRR<>0 do;
  port[Dataport] := bp^;
*)
 
asm
  mov dx,StatusPort
  @2:
  in  al,dx
  and al,DRR
  jnz @2
  mov al,[b]
  dec dx
  out dx,al
end;
 
inc(bp);

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

Откуда взят код? Дай ссылку или прикрепи модуль.

Вот
Прикреплённый файлrw_mid.zip (16.6 Кбайт, скачиваний: 1267)

Цитата Ash @ 20.05.05, 18:10

Мне вобще нужно что бы при нажатии на клавишу воспроизводился звук определённой ноты и инструмента. Как установить для миди звук и инстр.

Модуль тут совсем ни причём. Муз.редактором собираешь MIDI файл, а этот модуль должен его проиграть.
А если тебе нужно именно по нажатию клавиши, то это уже гораздо сложнее. Я не имею представления как это делать. В модуле сосем не имеет смысла разбираться, т.к.

1. работает только под ДОС
2. не на всех звуковухах
3. комментарии на немецком и документации нет

Если тебе необязательно звучание инструмента, а просто пищание PC-speaker, то вполне сойдёт Sound()

Кто чем может помогите. Нужно звук нормальный идать(PC-speaker не канает, fm тоже).

В DOS'е возможности звука и графики.. ну ОЧЕНЬ ограничены... Пробуй для Windows. Можно в Борланд Паскале 7.0 (16-битные приложения), хотя лучше взглянуть на Free Pascal (раздел 32-битные компиляторы). В особенности предлагаю библиотеку BASS.DLL. Полагаю, с ней легче разобраться, чем с ассемблером.
К тому же вывод звука с помощью DirectX.

Добавлено 22.05.05, 20:33
Вот код с применением библиотеки BASS:

program fpctest;
 
uses
   Crt,
   Windows,
   BassFPC;
 
var
   Stream      :  HStream;
   totallength :  integer;
 
const
   // Enter the name & path of an MP3 or other streamed music file here!
   MUSIC_FILE  =  'D:\MUSIC\test.mp3';
  
 
function    seconds_to_minutes (v: integer): string;
var
   temp1,temp2  :  string;
begin
   str(v div 60,temp1);
   str(v mod 60,temp2);
   if length(temp2) = 1 then temp2 := '0' + temp2;
   result := temp1 + ':' + temp2;  
end;
 
procedure   error(msg: string);
begin
   writeln(msg + '  (Error code: ',BASS_ErrorGetCode,')');
end;
 
procedure   init_stuff;
begin
   stream := 0;
 
   // Ensure BASS 2.0 was loaded
   if BASS_GetVersion() <> MAKELONG(2,1) then begin
     Error('BASS version 2.1 was not loaded!');
     Halt;
   end;
 
   // Initialize audio - default device, 44100hz, stereo, 16 bits
   if not BASS_Init(1, 44100, 0, 0, nil) then
     Error('Error initializing audio!');
end;
 
procedure   done_stuff;
begin
   // Free the stream
   if (stream <> 0) then
      BASS_StreamFree(stream);
 
   // Close BASS
   BASS_Free();
end;
 
procedure   load_song;
var
   p  :  PChar;
begin
   p := PChar(MUSIC_FILE);
   // Load the stream straight from a file.
   stream := BASS_StreamCreateFile(FALSE,p,0,0,0);
   if (stream = 0) then error('Error loading stream!');
end;
 
procedure   play_song;
begin
   // Play stream.
   if not BASS_ChannelPlay(stream, FALSE) then
     Error('Can''t play stream');
end;
 
procedure   stop_song;
begin
   BASS_ChannelStop(stream);
end;
 
 
begin
   clrscr;
   writeln('Welcome to the FPS BASS Test - by Paradice Software.');
   init_stuff;
   writeln('BASS Initialised successfully. ');
   writeln('Press any key to load file: ' + MUSIC_FILE);
   readkey;
   load_song;
   writeln('Song loaded successfully. press any key to play');
   readkey;
   totallength := round(BASS_ChannelBytes2Seconds(stream,BASS_StreamGetLength(stream)));
   play_song;
   writeln('Playing... press any key to stop!');
   repeat
      gotoxy(1,10);
      writeln('Playing: ' + seconds_to_minutes(round(BASS_ChannelBytes2Seconds(stream,BASS_ChannelGetPosition(stream)))) + ' of ' + seconds_to_minutes(totallength));
 
      // Bass plays in a separate thread, so we can sleep here to yield CPU.
      sleep(100);
   until keypressed;
   readkey;
   stop_song;
   clrscr;
   done_stuff;
   writeln('Done... exit');
end.

По-моему всё довольно наглядно и просто.

Сообщение отредактировано: Romtek - 22.05.05, 20:33

Нужно позарез в TP/BP.

Ash покешь мыло... закину...
Конеш прога не фонтан...
Когда-то выдрал демку из PREHISTORIC2... писал методом тыка...
Работает на SB совместимых (пробовал dos/win98)

А чёто он у меня молчит ни чё не издаёт?

Ash Ось DOS/WIN9X? Звукавуха sb совместимая? Базовый порт 220h?
Твой старый проигрыватель работает?

Пиши мне на мыло, [удалено модератором].

Можно обсуждать детали, но не в форме личной переписки!

Сообщение отредактировано: Romtek - 24.05.05, 08:08

Если звуковуха старая, можно попробовать программирование fm синтезатора.

[Модератор: Есть также теория по портам звуковой карты - в аттаче вместе с программой.]

ps 1,5 года назад я тоже хотел написать муз редактор для миди. Получилось только для ФМ. И то не доделано и не доведено до ума. Но надеюсь что возможно поможет.

Сообщение отредактировано: Romtek - 24.05.05, 15:35

Прикреплённый файлSound.zip (100.19 Кбайт, скачиваний: 1285)

Сорри, вроде не всё закачал.
Дубль 2:

ps Хорошо, Romtek. И документация тоже в zip

Сообщение отредактировано: @Hgpeu - 24.05.05, 15:39

Прикреплённый файлSound.zip (192.89 Кбайт, скачиваний: 1259)

Цитата hot_icer @ 24.05.05, 07:50

Ash Ось DOS/WIN9X? Звукавуха sb совместимая? Базовый порт 220h?
Твой старый проигрыватель работает?

Вот эта программа говорит: You have Sound Blaster Pro2

{$S-}
uses crt;
 
 
Const
 
   sbNamePrefix = 'Sound Blaster ';
 
   { Префикс имени модели для функции GetSBName }
 
 
Const
 
   svSB1       = $100;  { Sound Blaster 1.0/1.5 }    { 1.05??? }
 
   svSB2       = $200;  { Sound Blaster 2.0 }        { 2.01 }
 
   svSBPro     = $300;  { Sound Blaster Pro }        { ??? }
 
   svSBPro2    = $301;  { Sound Blaster Pro2 }       { 3.01, 3.02 }
 
   svSB16      = $400;  { Sound Blaster 16 }         { 4.04, 4.05 }
 
   svSB16SCSI2 = $40B;  { Sound Blaster 16 SCSI-2 }  { 4.11 }
 
   svSBAWE32   = $40C;  { Sound Blaster AWE32 }      { 4.12 }
 
   { Модели Sound Blaster'а, соответствующие версиям DSP (см. DSPVersion) }
 
 
Var sbBase     : Word;  { Базовый порт }
 
Var sbIRQ      : Byte;  { IRQ }
 
Var sbLDMA     : Byte;  { 8-битный канал DMA }
 
Var sbHDMA     : Byte;  { 16-битный канал DMA }
 
Var sbBaseMIDI : Word;  { Базовый порт MIDI }
 
Var sbModel    : Word;  { Модель Sound Blaster'а (см. константы smXXXX) }
 
Var DSPVersion : Word;  { Версия DSP Sound Blaster'а (см. константы svXXXX) }
 
{ Параметры Sound Blaster'а }
 
 
Procedure WriteToSB(N: Byte); assembler;
 
{ Записывает в порт Sound Blaster'а байт N (команду или данные) }
 
Asm
 
   mov dx,sbBase
 
   add dl,0Ch
 
 @:in al,dx
 
   or al,al
 
   js @
 
   mov al,N
 
   out dx,al
 
End;
 
 
Function ReadFromSB: Byte; assembler;
 
{ Читает байт из порта Sound Blaster'а }
 
Asm
 
   mov dx,sbBase
 
   add dl,0Eh
 
 @:in al,dx
 
   or al,al
 
   jns @
 
   sub dl,(0Eh-0Ah)
 
   in al,dx
 
End;
 
 
Function ResetDSP: Boolean; assembler;
 
{ Выполняет сброс процессора DSP и записывает номер версии в DSPVersion. }
 
{ Если  при  инициализации возникает ошибка (например, Sound Blaster уже }
 
{ используется  другой  программой и неверно указан номер базового порта }
 
{ sbBase), функция возвращает значение FALSE.                            }
 
Asm
 
   mov dx,sbBase
 
   add dl,6
 
   mov al,1
 
   out dx,al
 
   mov cx,1000h
 
   push cx
 
@1:loop @1
 
   dec ax
 
   out dx,al
 
   pop cx
 
   add dl,(0Eh-06h)
 
@2:in al,dx
 
   test al,80h
 
   loopz @2
 
   sub dl,(0Eh-0Ah)
 
   in al,dx
 
   cmp al,0AAh
 
   mov al,0
 
   jne @Error
 
   mov al,0E1h
 
   push ax
 
   call WriteToSB
 
   call ReadFromSB
 
   mov byte ptr DSPVersion[1],al
 
   call ReadFromSB
 
   mov byte ptr DSPVersion[0],al
 
   mov al,1
 
 @Error:
 
End;
 
 
Function DetectSBBase: Boolean; assembler;
 
{ Определяет  базовый  порт Sound Blaster'а. В случае неудачи возвращает }
 
{ значение  FALSE  и присваивает переменной sbBase значение $FFFF.       }
 
{ !!! Вызывает функцию ResetDSP.                                         }
 
Asm
 
   mov bx,210h
 
 @Test:
 
   mov sbBase,bx
 
   call ResetDSP
 
   or al,al
 
   jnz @Ok
 
 @:add bl,10h
 
   cmp bl,70h
 
   je @
 
   cmp bl,80h
 
   jbe @Test
 
   mov sbBase,0FFFFh
 
 @Ok:
 
End;
 
 
Function GetSBName: String;
 
{ Получить имя Sound Blaster'а ('1.x', '2.0', 'Pro' и т.д) по версии DSP }
 
Begin
 
   If DSPVersion >= svSBAWE32 then GetSBName := 'AWE32 or better'
 
   else If DSPVersion >= svSB16SCSI2 then GetSBName := '16 SCSI-2'
 
   else If DSPVersion >= svSB16 then GetSBName := '16'
 
   else If DSPVersion >= svSBPro2 then GetSBName := 'Pro2'
 
   else If DSPVersion >= svSBPro then GetSBName := 'Pro'
 
   else If DSPVersion >= svSB2 then GetSBName := '2.0'
 
   else If DSPVersion >= svSB1 then GetSBName := '1.x'
 
   else GetSBName := 'Unknown'
 
End;
 
 
Begin
 
  If not DetectSBBase then WriteLn('Error detecting SB base port!')
 
  else WriteLn('You have '+sbNamePrefix, GetSBName);
  Repeat until keypressed;
 
End.

Где можно посмотреть базовый порт?

Проигрыватель Wernera в ХР играет, в Win98 нет.

-юсртыхэю 24.05.05, 19:30

Цитата @Hgpeu @ 24.05.05, 14:05

Если звуковуха старая, можно попробовать программирование fm синтезатора.

В том то и дело что была у меня звукавуха старая, начал делать с помощью FM, а потом мать обновил, а там такого счастья нет, так вот теперь нужно как-нибудь звук то издать.

Цитата

Где можно посмотреть базовый порт?

Свойства системы/Оборудование/Диспетчер устройств/Звуковуха/Ресурсы
Там диапазон ввода-вывода
Или что?

Ash твоя прога может определить порт, после

If not DetectSBBase then WriteLn('Error detecting SB base port!')
   else WriteLn('You have '+sbNamePrefix, GetSBName);

вставь строку

  WriteLn('Base port: ',sbBase);

В модуле midi.pas есть косяки (хотя у меня пахало)
асмеры меня с потрохами должны со жрать

  mov cx,6
  rep in al,dx
  ...........
  mov cx,28
  rep in al,dx

это не есть правильно! Замени на :

      mov cx,6
@ops: in   al,dx
      loop @ops
      ...........
      mov cx,28
@ops1: in   al,dx
      loop @ops1

В prehistoric'e были "in al,dx" в длинный столбик!

Сообщение отредактировано: hot_icer - 25.05.05, 06:20