+ added example program capture_client.pp to libjack (translated from capture_client.c)

packages/libjack/examples/capture_client.pp

@@ -0,0 +1,393 @@
+{
+    Copyright (C) 2001 Paul Davis
+    Copyright (C) 2003 Jack O'Quin
+    
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+    * 2002/08/23 - modify for libsndfile 1.0.0 <[email protected]>
+    * 2003/05/26 - use ringbuffers - joq
+    
+}
+
+program capture_client;
+
+{$MODE ObjFpc}{$H+}
+
+uses
+{$ifdef UNIX}
+  CThreads,
+{$endif}
+  PThreads, CTypes, SysUtils, SndFile, Jack, JackRingBuffer;
+
+const
+  EIO = 5;
+  EPIPE = 32;
+
+type
+  Pjack_thread_info_t = ^jack_thread_info_t;
+  jack_thread_info_t = record
+    thread_id: TThreadId;
+    sf: PSNDFILE;
+    duration: jack_nframes_t;
+    rb_size: jack_nframes_t;
+    client: Pjack_client_t;
+    channels: cuint;
+    bitdepth: cint;
+    path: string;
+    can_capture: Boolean; {volatile;}
+    can_process: Boolean; {volatile;}
+    status: cint; {volatile;}
+  end;
+
+var
+  { JACK data }
+  nports: cuint;
+  ports: PPjack_port_t;
+  _in: PPjack_default_audio_sample_t;
+  nframes: jack_nframes_t;
+
+const
+  sample_size = SizeOf(jack_default_audio_sample_t);
+
+{ Synchronization between process thread and disk thread. }
+  DEFAULT_RB_SIZE = 16384;              { ringbuffer size in frames }
+
+var
+  rb: Pjack_ringbuffer_t;
+  disk_thread_lock: TPthreadMutex;
+  data_ready: TCondVar;
+  overruns: clong = 0;
+  total_captured: jack_nframes_t = 0;
+
+function disk_thread (arg: Pointer): PtrInt;
+label
+  done;
+var
+  info: Pjack_thread_info_t;
+  samples_per_frame: jack_nframes_t;
+  bytes_per_frame: csize_t;
+  framebuf: Pointer;
+  errstr: array [0..255] of Char;
+begin
+  info := arg;
+  samples_per_frame := info^.channels;
+  bytes_per_frame := samples_per_frame * sample_size;
+  framebuf := GetMem (bytes_per_frame);
+
+  pthread_setcanceltype (PTHREAD_CANCEL_ASYNCHRONOUS, nil);
+  pthread_mutex_lock (@disk_thread_lock);
+
+
+  info^.status := 0;
+
+  while True do
+  begin
+    { Write the data one frame at a time.  This is
+      inefficient, but makes things simpler. }
+    while info^.can_capture and
+         (jack_ringbuffer_read_space (rb) >= bytes_per_frame) do
+    begin
+      jack_ringbuffer_read (rb, framebuf, bytes_per_frame);
+
+      if sf_writef_float (info^.sf, framebuf, 1) <> 1 then
+      begin
+	      sf_error_str (nil, @errstr, sizeof (errstr) - 1);
+	      Writeln (StdErr,
+		       'cannot write sndfile (', errstr, ')');
+	      info^.status := EIO; { write failed }
+	      goto done;
+      end;
+
+      Inc(total_captured);
+      if total_captured >= info^.duration then
+      begin
+	Writeln ('disk thread finished');
+	goto done;
+      end;
+    end;
+
+    { wait until process() signals more data }
+    pthread_cond_wait (@data_ready, @disk_thread_lock);
+  end;
+
+done:
+  pthread_mutex_unlock (@disk_thread_lock);
+  FreeMem (framebuf);
+  Result := 0;
+end;
+	
+function process (nframes: jack_nframes_t; arg: Pointer): cint; cdecl;
+var
+  chn: cint;
+  i: csize_t;
+  info: Pjack_thread_info_t;
+begin
+  info := arg;
+
+  { Do nothing until we're ready to begin. }
+  if (not info^.can_process) or (not info^.can_capture) then
+    Exit(0);
+
+  for chn := 0 to nports - 1 do
+    _in[chn] := jack_port_get_buffer (ports[chn], nframes);
+
+  { Sndfile requires interleaved data.  It is simpler here to
+    just queue interleaved samples to a single ringbuffer. }
+  for i := 0 to nframes - 1 do
+    for chn := 0 to nports - 1 do
+      if jack_ringbuffer_write (rb, Pointer(_in[chn]+i), sample_size) < sample_size then
+        Inc(overruns);
+
+  { Tell the disk thread there is work to do.  If it is already
+    running, the lock will not be available.  We can't wait
+    here in the process() thread, but we don't need to signal
+    in that case, because the disk thread will read all the
+    data queued before waiting again. }
+  if pthread_mutex_trylock (@disk_thread_lock) = 0 then
+  begin
+    pthread_cond_signal (@data_ready);
+    pthread_mutex_unlock (@disk_thread_lock);
+  end;
+
+  Result := 0;
+end;
+
+procedure jack_shutdown (arg: Pointer); cdecl;
+begin
+  Writeln (StdErr, 'JACK shutdown');
+  // Halt (0);
+  //abort();
+end;
+
+procedure setup_disk_thread (info: Pjack_thread_info_t);
+var
+  sf_info: TSF_INFO;
+  short_mask: cint;
+  errstr: array [0..255] of Char;
+begin
+  sf_info.samplerate := jack_get_sample_rate (info^.client);
+  sf_info.channels := info^.channels;
+
+  case info^.bitdepth of
+    8:
+      short_mask := SF_FORMAT_PCM_U8;
+    16:
+      short_mask := SF_FORMAT_PCM_16;
+    24:
+      short_mask := SF_FORMAT_PCM_24;
+    32:
+      short_mask := SF_FORMAT_PCM_32;
+    else
+      short_mask := SF_FORMAT_PCM_16;
+  end;
+  sf_info.format := SF_FORMAT_WAV or short_mask;
+
+  info^.sf := sf_open (PChar(info^.path), SFM_WRITE, @sf_info);
+  if info^.sf = nil then
+  begin
+    sf_error_str (nil, @errstr, sizeof (errstr) - 1);
+    Writeln (StdErr, 'cannot open sndfile ', info^.path, ' for output (', errstr, ')');
+    jack_client_close (info^.client);
+    Halt (1);
+  end;
+
+  if info^.duration = 0 then
+    info^.duration := JACK_MAX_FRAMES
+  else
+    info^.duration *= sf_info.samplerate;
+
+  info^.can_capture := False;
+
+  info^.thread_id := BeginThread(@disk_thread, info);
+end;
+
+procedure run_disk_thread (info: Pjack_thread_info_t);
+begin
+  info^.can_capture := True;
+  WaitForThreadTerminate(info^.thread_id, -1);
+  sf_close (info^.sf);
+  if overruns > 0 then
+  begin
+    Writeln (StdErr,
+	     'jackrec failed with ', overruns, ' overruns.');
+    Writeln (StdErr, ' try a bigger buffer than -B ', info^.rb_size, '.');
+    info^.status := EPIPE;
+  end;
+end;
+
+procedure setup_ports (sources: cint; first_source_param: Integer; info: Pjack_thread_info_t);
+var
+  i: cuint;
+  in_size: csize_t;
+  name, source_name: string;
+begin
+  { Allocate data structures that depend on the number of ports. }
+  nports := sources;
+  ports := GetMem (SizeOf (Pjack_port_t) * nports);
+  in_size := nports * SizeOf (Pjack_default_audio_sample_t);
+  _in := GetMem (in_size);
+  rb := jack_ringbuffer_create (nports * sample_size * info^.rb_size);
+
+  { When JACK is running realtime, jack_activate() will have
+    called mlockall() to lock our pages into memory.  But, we
+    still need to touch any newly allocated pages before
+    process() starts using them.  Otherwise, a page fault could
+    create a delay that would force JACK to shut us down. }
+  FillChar(_in^, in_size, 0);
+  FillChar(rb^.buf^, rb^.size, 0);
+
+  for i := 0 to nports - 1 do
+  begin
+    WriteStr (name, 'input', i+1);
+
+    ports[i] := jack_port_register (info^.client, PChar(name), JACK_DEFAULT_AUDIO_TYPE, Ord(JackPortIsInput), 0);
+    if ports[i] = nil then
+    begin
+      Writeln (StdErr, 'cannot register input port "', name, '"!');
+      jack_client_close (info^.client);
+      Halt (1);
+    end;
+  end;
+
+  for i := 0 to nports - 1 do
+  begin
+    source_name := ParamStr(first_source_param + i);
+    if jack_connect (info^.client, PChar(source_name), jack_port_name (ports[i])) <> 0 then
+    begin
+      Writeln (StdErr, 'cannot connect input port ', jack_port_name (ports[i]), ' to ', source_name);
+      jack_client_close (info^.client);
+      Halt (1);
+    end;
+  end;
+
+  info^.can_process := True;            { process() can start, now }
+end;
+
+var
+  client: Pjack_client_t;
+  thread_info: jack_thread_info_t;
+  longopt_index: cint = 0;
+  show_usage: Boolean = False;
+begin
+  pthread_mutex_init(@disk_thread_lock, nil);
+  pthread_cond_init(@data_ready, nil);
+  FillChar (thread_info, SizeOf (thread_info), 0);
+  thread_info.rb_size := DEFAULT_RB_SIZE;
+
+  while longopt_index < ParamCount do
+  begin
+    Inc(longopt_index);
+    case ParamStr(longopt_index) of
+      '-h', '--help':
+        show_usage := True;
+      '-d', '--duration':
+        begin
+          Inc(longopt_index);
+          if longopt_index > ParamCount then
+          begin
+  	    Writeln (StdErr, 'error');
+  	    show_usage := True;
+            break;
+          end;
+	  thread_info.duration := StrToInt (ParamStr(longopt_index));
+        end;
+      '-f', '--file':
+        begin
+          Inc(longopt_index);
+          if longopt_index > ParamCount then
+          begin
+  	    Writeln (StdErr, 'error');
+  	    show_usage := True;
+            break;
+          end;
+	  thread_info.path := ParamStr(longopt_index);
+        end;
+      '-b', '--bitdepth':
+        begin
+          Inc(longopt_index);
+          if longopt_index > ParamCount then
+          begin
+  	    Writeln (StdErr, 'error');
+  	    show_usage := True;
+            break;
+          end;
+	  thread_info.bitdepth := StrToInt (ParamStr(longopt_index));
+        end;
+      '-B', '--bufsize':
+        begin
+          Inc(longopt_index);
+          if longopt_index > ParamCount then
+          begin
+  	    Writeln (StdErr, 'error');
+  	    show_usage := True;
+            break;
+          end;
+	  thread_info.rb_size := StrToInt (ParamStr(longopt_index));
+        end;
+      else
+        begin
+          if (Length(ParamStr(longopt_index)) >= 1) and (ParamStr(longopt_index)[1] = '-') then
+          begin
+	    Writeln (StdErr, 'error');
+	    show_usage := True;
+            break;
+          end
+          else
+          begin
+            Dec(longopt_index);
+            break;
+          end;
+        end;
+    end;
+  end;
+
+  if show_usage or (thread_info.path = '') or (longopt_index >= ParamCount) then
+  begin
+    Writeln (StdErr, 'usage: jackrec -f filename [ -d second ] [ -b bitdepth ] [ -B bufsize ] port1 [ port2 ... ]');
+    Halt (1);
+  end;
+
+  client := jack_client_open ('jackrec', JackNullOption, nil);
+  if client = nil then
+  begin
+    Writeln (StdErr, 'jack server not running?');
+    Halt (1);
+  end;
+
+  thread_info.client := client;
+  thread_info.channels := ParamCount - longopt_index;
+  thread_info.can_process := False;
+
+  setup_disk_thread (@thread_info);
+
+  jack_set_process_callback (client, @process, @thread_info);
+  jack_on_shutdown (client, @jack_shutdown, @thread_info);
+
+  if jack_activate (client) <> 0 then
+  begin
+    Writeln (StdErr, 'cannot activate client');
+  end;
+
+  setup_ports (ParamCount - longopt_index, longopt_index + 1, @thread_info);
+
+  run_disk_thread (@thread_info);
+
+  jack_client_close (client);
+
+  jack_ringbuffer_free (rb);
+
+  pthread_cond_destroy(@data_ready);
+  pthread_mutex_destroy(@disk_thread_lock);
+end.

packages/libjack/fpmake.pp

@@ -121,6 +121,7 @@ begin
       end;
 
     P.ExamplePath.Add('examples');
+    P.Targets.AddExampleProgram('capture_client.pp');
     P.Targets.AddExampleProgram('simple_client.pp');
     P.Targets.AddExampleProgram('simple_session_client.pp');
     P.Targets.AddExampleProgram('latent_client.pp');