Lazarus - Konsola i MMSystem.

0

Witam. Poszukuje kodu/unitu, który pozwoli mi odtwarzać (w konsoli) dźwięki w tle, tak aby reszta kodu była niezależna i działała podczas odtwarzania.

Przeszukałem internet i forum lecz niestety jedyne co znalazłem to: jakiś stary unit pod nazwą BackPlay, lecz niestety nie działa.

{$B-,F-,I+,O-,R-}

unit BackPlay;

{ Unit for playing music in the background.

  Copyright 1988 Scott Bussinger
  All rights reserved.
  Permission is hereby granted by the author for you to use this unit in your programs.

  Scott Bussinger
  Professional Practice Systems
  110 South 131st Street
  Tacoma, WA  98444
  (206)531-8944
  Compuserve [72247,2671]

  Version 1.00 --  9/24/1988 -- First version }

interface

type Song = procedure;
     SongAction = (EndRepeatSong,RepeatSong,ResumeSong,StopSong,SuspendSong);

function PlayingInBackground: boolean;
  { Is there a song currently playing? }

procedure PlayingMode(Action: SongAction);
  { Change the play mode }

function PlayMuz(Filename: string): boolean;
  { Play a song in the background loaded from a file -- returns true if file found }

procedure PlaySong(S: Song);
  { Play a song in the background already loaded in memory }

implementation

uses Dos;

const BackgroundBufferSize = 256;                { Maximum number of note changes in song }
      FreqConstant = 1193180.0;                  { Master timer chip clock rate }
      TickConstant = FreqConstant / 65536.0 / 1000.0; { Constant for tick speed }

const CurrentNote: 0..BackgroundBufferSize+1 = 0; { Pointer to current note in BackgroundBuffer }
      LastNote: 0..BackgroundBufferSize = 0;     { Pointer to last note in BackgroundBuffer }
      Playing: boolean = false;                  { Are we currently playing? }
      Repeating: boolean = false;                { Repeat song at end (automatically turned off when song started) }
      Suspended: boolean = false;                { Suspend playing temporarily (automatically turned off when song started) }
      TicksLeftInNote: word = 0;                 { Number of ticks left in current note }

var BackgroundBuffer: array[0..BackgroundBufferSize] of record
      TimerCount: word;                          { Timer constant for the frequency }
      Duration: word                             { Number of ticks left for this note }
      end;
    ExitSave: pointer;                           { Previous exit procedure }
    SaveInt1C: pointer;                          { Previous timer interrupt handler }

procedure DisableInterrupts;
  { Turn off interrupts }
  inline($FA);                                   { CLI }

procedure EnableInterrupts;
  { Turn on interrupts }
  inline($FB);                                   { STI }

procedure JumpToOldISR(OldIsr: pointer);
  { Chain on to previous ISR (doesn't return) }
  inline($5B/$58/$87/$5E/$0E/$87/$46/$10/$89/
         $EC/$5D/$07/$1F/$5F/$5E/$5A/$59/$CB);

{$F+,S-}
procedure Int1CHandler; interrupt;
  { Process timer interrupt }
  begin
  if Playing and not Suspended then              { Quit fast if we're not playing right now }
    begin
    if TicksLeftInNote = 0                       { Time to change notes }
     then
      begin
      inc(CurrentNote);
      if CurrentNote > LastNote
       then
        begin
        Port[$61] := Port[$61] and $FC;          { Turn sound off }
        CurrentNote := 0;                        { Reset buffer to beginning }
        if not Repeating then
          begin
          Playing := false;                      { We're done playing }
          LastNote := 0                          { Start filling from beginning }
          end
        end
       else
        with BackgroundBuffer[CurrentNote] do    { Change to new frequency }
          begin
          TicksLeftInNote := Duration;           { How long to hold note }
          if TimerCount = 0
           then
            Port[$61] := Port[$61] and $FC       { Turn sound off }
           else
            begin
            Port[$43] := $B6;                    { Change to new frequency }
            Port[$42] := lo(TimerCount);
            Port[$42] := hi(TimerCount);
            Port[$61] := Port[$61] or $03        { Turn sound on }
            end
          end
      end
     else
      dec(TicksLeftInNote)                       { Wait for note to finish }
    end;
  JumpToOldISR(SaveInt1C)                        { Call other interrupt handlers }
  end;
{$F-,S+}

function PlayingInBackground: boolean;
  { Is there a song currently playing? }
  begin
  PlayingInBackground := Playing
  end;

procedure PlayingMode(Action: SongAction);
  { Change the play mode }
  begin
  case Action of
    EndRepeatSong: Repeating := false;
    RepeatSong: if Playing then
                  Repeating := true;
    ResumeSong: if Suspended then
                  Suspended := false;
    StopSong: if Playing then
                begin
                Port[$61] := Port[$61] and $FC;  { Turn sound off }
                Playing := false;
                Repeating := false;
                Suspended := false;
                CurrentNote := 0;                { Reset buffer to beginning }
                LastNote := 0;
                TicksLeftInNote := 0             { So first tick starts the song }
                end;
    SuspendSong: if Playing and not Suspended then
                   begin
                   Port[$61] := Port[$61] and $FC; { Turn sound off }
                   Suspended := true;
                   TicksLeftInNote := 0          { Chop off current note }
                   end
    end
  end;

procedure PlaySong(S: Song);
  { Play a song in the background already loaded in memory }
  { Add this song to currently playing tune if a tune is still in progress }
  { Turns off automatic song repeat mode }
  type NoteArray = array[1..16383] of record     { Arbitrary sized collection of notes }
         O,NS: Byte;
         D: Word
         end;
  var SongPtr: ^NoteArray;                       { Pointer to a song }
      I: integer;

  procedure PlayANote(Octave,NoteStaccato: byte;Duration: integer);
    { Play a single note from MUZ file }
    const Factor: array[0..10] of real = (0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0);
          FreqVal: array[1..12] of real = (1.0000000000, 1.0594630944, 1.1224620484, 1.1892071151,
                                           1.2599210501, 1.3348398544, 1.4142135627, 1.4983070773,
                                           1.5874010524, 1.6817928311, 1.7817974369, 1.8877486261);
          OctVal: array[0..7] of real = (  65.406391320,  130.81278264,  261.62556528,  523.25113056,
                                         1046.5022611,   2093.0045222,  4186.0090445,  8372.0180890);
    var Note: byte;
        Staccato: byte;

    procedure StuffNote(Freq,Dur: word);
             { Put note information into BackgroundBuffer }
      begin
      DisableInterrupts;                         { Don't let a note change happen during this stretch }
      if (LastNote<BackgroundBufferSize) and (Dur>0) then { Don't enter 0 length durations }
        begin
        inc(LastNote);                           { Bump note counter }
        with BackgroundBuffer[LastNote] do       { Fill in the note information }
          begin
          TimerCount := Freq;
          Duration := Dur - 1                    { Pre-decrement the duration }
          end;
        Playing := true                          { There's at least one note in buffer, so start playing }
        end;
      EnableInterrupts                           { Turn interrupts back on again }
      end;

    begin
    Note := NoteStaccato shr 4;
    Staccato := (NoteStaccato and $0F) mod 11;
    CASE Note OF
      1..12: begin                               { Stuff on and off portion of notes }
              StuffNote(round(FreqConstant / (OctVal[(Octave-1) mod 8] * FreqVal[Note])),
                       round(Duration * Factor[10-Staccato] * TickConstant));
             StuffNote(0,round(Duration * Factor[Staccato] * TickConstant))
             end;
      13: StuffNote(0,round(Duration * TickConstant)) { Stuff a rest into buffer }
      else
      end
    end;

  begin
  SongPtr := @S;                                 { Get address of the song in memory }
  for I := 10 to (longint(SongPtr^[6]) and $FFFF) + 9 do { Play each of the notes in the song }
    with SongPtr^[I] do
      PlayANote(O,NS,D);
  Repeating := false                             { Turn off automatic repeat anytime you add to the music buffer }
  end;

function PlayMuz(Filename: string): boolean;
  { Play a song in the background loaded from a file -- returns true if file found }
  { Add this song to currently playing tune if a tune is still in progress }
  { Turns off automatic song repeat mode }
  var SaveFileMode: word;
      Size: longint;
      SongFile: file;
      SongPtr: pointer;
  begin
  PlayMuz := false;                              { Default to file not loaded }
  FileName := FSearch(FileName+'.MUZ',GetEnv('PATH')); { Search PATH for the song file }
  if Filename <> '' then
    begin
    SaveFileMode := FileMode;
    FileMode := $20 * ord(lo(DosVersion)>=3);    { Allow access to read only files }
    assign(SongFile,Filename);                   { Open the song file }
    {$I-}
    reset(SongFile,1);
    {$I+}
    if ioresult = 0 then                         { Since we've already found it, this really should always work }
      begin
      Size := FileSize(SongFile);
      getmem(SongPtr,Size);                      { Load file onto heap temporarily }
      blockread(SongFile,SongPtr^,Size);
      close(SongFile);
      FileMode := SaveFileMode;
      PlaySong(Song(SongPtr));
      freemem(SongPtr,Size);                     { Free up the heap again }
      PlayMuz := true
      end
    end
  end;

{$F+}
procedure ExitHandler;
{$F-}
  { Restore the timer interrupt and make sure sound is off }
  begin
  ExitProc := ExitSave;                          { Chain to other exit procedures }
  SetIntVec($1C,SaveInt1C);                      { Remove interrupt handler }
  Port[$61] := Port[$61] and $FC                 { Make sure sound is off }
  end;

begin
ExitSave := ExitProc;
ExitProc := @ExitHandler;                        { Install our exit procedure }
GetIntVec($1C,SaveInt1C);
SetIntVec($1C,@Int1CHandler)                     { Install our timer interrupt handler }
end.
 
1
  Copyright 1988 Scott Bussinger

No nie, bez jaj.

Poszukaj jak się używa bibliotek FMod albo BASS.

0

A musi być z użyciem mmsystem? Nie możesz skorzystać po ludzku z bass.dll i w wątku odtworzyć w tle co tam chcesz (w ramach obsługiwanych przez ową bibliotekę formatów), a w odpowiednim momencie zatrzymać odtwarzanie. Chyba Lazarus nie będzie stwarzał problemów skoro Delphi daje radę, ale pod Lazarusem z bass.dll nie korzystałem, jednak podejrzewam że skoro to dllka to tymbardziej będzie przenośna pomiędzy kompilatorami. A w razie czego zawsze jest dyrektywa kompilatora mode delphi.

EDIT: @Azarien mnie ubiegł. A i ja też widziałem ten rocznik w nagłowku modułu, ale myślałem że źle widzę. A czy Ty @szymonbialka chcesz się cofać w czasie albo odpalać swój kod pod DosBOX'em? Wiadomo wiele gier dosowych było świetnych, ale czy w dzisiejszych czasach aż trzeba dbać od przedpotopową wstęczną kompatybilność i się aż tak męczyć? Chyba jest na to jakaś moda, pseudo "wykładowcy" każą pisać pod TP 7.0, a inni chcą muzyki w *.muz - ech, co to za "mod"a? ;/

0

Gdy przeszukiwałem sieć niestety nie natrafiłem na biblioteki FMod ani BASS, poczytam o nich. Co do daty no tak wiem stare niestety jest - lecz wybaczcie pierwszy raz bawię się z dźwiękami w konsoli i jestem zielony w tym temacie (więc czytam wszytko co popadnie aby się nauczyć), dziękuje za rady. :)

0

Chyba Lazarus nie będzie stwarzał problemów skoro Delphi daje radę, ale pod Lazarusem z bass.dll nie korzystałem, jednak podejrzewam że skoro to dllka to tymbardziej będzie przenośna pomiędzy kompilatorami.

Potwierdzone, używałem Bass pod FPC i nie napotkałem żadnych godnych wspomnienia problemów.

A w razie czego zawsze jest dyrektywa kompilatora mode delphi.

...dodawana automatycznie przy konwersji plików źródłowych delphi, tak że nie ma po co o niej niepotrzebnie wspominać. Lazarus i bez tego jest w 90% zgodny.

Gdy przeszukiwałem sieć niestety nie natrafiłem na biblioteki FMod ani BASS, poczytam o nich.

Źle szukałeś. W ogóle to WinAPI coś powinno mieć do tego, MSDN zaprasza.

. Co do daty no tak wiem stare niestety jest - lecz wybaczcie pierwszy raz bawię się z dźwiękami w konsoli i jestem zielony w tym temacie (więc czytam wszytko co popadnie aby się nauczyć)

Spoko, pokazałeś że szukałeś i kombinowałeś, nie masz co przepraszać. Natomiast powinieneś powiedzieć jaki to kompilator i środowisko, jeżeli używasz FPC dla Windows to nie powinieneś mieć żadnych problemów z użyciem WinAPI tak jak w delphi, wystarczy poszukać bodaj PlaySound.

BASS to potężna biblioteka, ale wątpie czy taki początkujący będzie jej w stanie użyć, proponował bym poszukać w WinAPI dobrze może będzie coś wystarczającego a WinAPI się przyda bardziej niż BASS.

1

BASS to potężna biblioteka, ale wątpie czy taki początkujący będzie jej w stanie użyć

Bez przesady.

uses bass;

var mp3:HSTREAM;

begin
      BASS_Init(-1, 44100, 0, 0, nil);
      mp3:=BASS_StreamCreateFile(false, pchar('h:\muzyka\Globus - Preliator.mp3'), 0, 0, 0);
      BASS_ChannelPlay(mp3, false);
      readln;
      BASS_Free();
end.
1
Azarien napisał(a):

BASS to potężna biblioteka, ale wątpie czy taki początkujący będzie jej w stanie użyć

Bez przesady.

Nie przesadzam, pamiętam że gdy zaczynałem z BASS a byłem już nie aż takim znowu początkującym, to miałem straszne problemy z działaniem BASS który nigdy nie działał tak jak chciałem, ciągle coś robił źle etc. . Gotowca którego pokazałeś każdy może wkleić sobie, gorzej gdy trzeba dodać coś swojego. IMO Bass jest trudny zwłaszcza dla początkujących. A już na pewno nie jest potrzebny żeby tylko odtworzyć jakiś tam dźwięk, bo do tego wystarczy WinAPI.
Wybór oczywiście należy do pytacza, ale osobiścię odradzę BASS na rzecz WinAPI jeżeli chodzi tylko o odtworzenie paru dźwięków.

0

Gotowca którego pokazałeś każdy może wkleić sobie, gorzej gdy trzeba dodać coś swojego.

Tego "gotowca" sam wymyśliłem — a co do BASSa, to jest nie tyle trudny, co brak do niego sensownej dokumentacji — a większość przykładów to jakieś gotowe odtwarzacze z mega ilością funkcji, a nie ma właśnie takich prostych „odpal jedną mp3-kę”…

0

Używam FPC Lazarus 1.0

Szczerze mówiąc jestem dokładnie dopiero początkującym, staram się stworzyć grę w konsoli - kółko i krzyżyk 3x3 pola, niby łatwe jeżeli mowa o sam system gry (choć na AI jeszcze nie mam pomysłu [na ten czas mam samą rozgrywkę gracz vs. gracz]- ale to z czasem jakoś stworzę). Swój program chciałem udoskonalić jak najbardziej dam rade na samych podstawach i zabawa z biblioteką Bass na sam początek nie jest dla mnie zbyt łatwa, no lecz wyzwanie to wyzwanie bez ciężkiej pracy się nie nauczę - chociaż chciałbym także poznać inne alternatywne opcje dla tego rozwiązania (takie jak proponuje -123oho), które mogą mi się przydać w przyszłości.

wystarczy poszukać bodaj PlaySound.

No tak PlaySound mi zadziała ale zapomniałeś, że konsola jest jednowątkowa i do czasu gdy muzyka jest odtwarzana reszta programu stoi. : / - (mój błąd)

Co do Olesio

Chyba jest na to jakaś moda, pseudo "wykładowcy" każą pisać pod TP 7.0, a inni chcą muzyki w *.muz - ech, co to za "mod"a? ;/

  • Ja po prostu się uczę : )
0

konsola jest jedno warunkowa
Chyba „jednowątkowa”, i nie, nie jest.

1
szymonbialka napisał(a):

No tak PlaySound mi zadziała ale zapomniałeś, że konsola jest jedno warunkowa i do czasu gdy muzyka jest odtwarzana reszta programu stoi. : /

Nic nie stoi bo od tego jest flaga SND_ASYNC a nawet gdyby jej nie było yo zawsze można by funkcję wywołać w osobnym wątku. Tyle że tą funkcją nie odtworzysz MP3. Jeżeli chcesz MP3 to najprościej chyba tak:

uses MMSystem;

procedure playMP3(AFileName: string);
begin
  if mciSendString(PAnsiChar('open "' + AFileName + '" type mpegvideo'), nil, 0, 0) = 0 then
    mciSendString(PAnsiChar('play "' + AFileName +  '"'), nil, 0, 0);
end;

procedure stopMP3(AFileName: string);
begin
  mciSendString(PAnsiChar('close "' + AFileName + '"'), nil, 0, 0);
end;
0

Elegancko dziękuje, o to mi chodziło. Wszystko ładnie śmiga. : )

1 użytkowników online, w tym zalogowanych: 0, gości: 1