A simpleminded modular synthesizer
Joost
created: 2004-06-30 07:17:10
I made this little thing to try out my [cpan://Audio::LADSPA] modules (in other words, it's a shameless plug).

Prerequisites
You need the latest as-of-today version of the Audio::LADSPA distribution (0.013). If it's not yet on your cpan mirror get it from: [http://hortus-mechanicus.net/perl/audio-ladspa/]

Plugins needed by the demo.rack demo file are in the ladspa-sdk, which you will also need to run the tests on Audio::LADSPA - get it from [http://www.ladspa.org/] (debian users: "apt-get install ladspa-sdk")

Further needed modules: [cpan://Tk] and [cpan://YAML].

other stuff

I put up a screenshot [http://hortus-mechanicus.net/perl/audio-ladspa/rack.jpg|here].

Oh yeah, this code is pretty afwul, and will crash a lot; run from the command line to see the messages, and save often.

Newest version of the code should always be available from [http://hortus-mechanicus.net/perl/]

code:

#!/usr/bin/perl -w
#Audio::LADSPA Rack
#Copyright (C) 2003 - 2004 Joost Diepenmaat.
#
#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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#See the COPYING file for more information.


use strict;
use Audio::LADSPA::Network;
use Tk;
use Tk::Event qw(DONT_WAIT);
use Tk::DialogBox;
use Tk::Frame;
use Tk::LabFrame;
use Tk::Table;
use Tk::Font;
use Tk::ROText;
use Tk::FileSelect;
use YAML qw(Dump LoadFile DumpFile);

my $preferences = load_preferences();

my $network;
my $filename;

my $main = MainWindow->new( -title => 'Audio::LADSPA RACK');
$main->OnDestroy( \&quit );
my $smallfont = $main->Font( -family => 'Helvetica', -size => -8);
my $menubar = $main->Menu( -type => 'menubar');
$menubar->pack(-side => 'top', -fill => 'x', -expand => 0);

my $buttonbar = $main->LabFrame( -label => 'Transport' ,-relief => 'raised' )->pack(-fill => 'x', -expand => 0, -anchor => 'w');

my $playbutton = $buttonbar->Button( -text => 'Play', -command => \&play, -background => '#008000', -foreground => 'white')->pack( -side => 'left');

my $stopbutton = $buttonbar->Button( -text => 'Stop', -command => \&stop, -background => '#404040', -foreground => 'white')->pack( -side => 'left');

#my $net_frame = $main->Frame( -width => 500, -height => 400)->pack(-fill => 'both', -expand => 1);
my $plugmenu = $menubar->Menu( -title => 'Add Plugin', -type => 'normal');

my $filemenu = $menubar->Menu( -title => 'File', -type => 'normal');

$filemenu->add('command', -label => 'New', -command => \&new_net );
$filemenu->add('command', -label => 'Open...', -command => \&load_net );
$filemenu->add('command', -label => 'Save as...', -command => \&save_net_as);

$filemenu->add('command', -label => 'Dump Network', -command => sub { print Dump $network->dump });
$filemenu->add('command', -label => 'Quit', -command => \&quit);


my $helpmenu = $menubar->Menu( -title => 'Help', -type => 'normal');
$helpmenu->add('command', -label => 'Help', -command => \&help);
$helpmenu->add('command', -label => 'About', -command => \&about);

$menubar->add( 'cascade', -menu => $filemenu, -label => "File" );
$menubar->add( 'cascade', -menu => $plugmenu, -label => "Add Plugin");
$menubar->add( 'cascade', -menu => $helpmenu, -label => "Help");

my $net_canvas = $main->Scrolled('Canvas', -width => 500, -height => 400, -scrollbars => 'se');
$net_canvas->pack(-side=>'bottom', -fill => 'both', -expand => 1);

for (@{$preferences->{perl_based_plugins}}) {
    if (/^(\w+(?:::\w+)*)$/) {
	eval "use $1;";
	warn $@ if $@;
    }
}

my %plugins_by_letter;
for (Audio::LADSPA->plugins,@{$preferences->{perl_based_plugins}}) {
    my ($l) = $_->name() =~ /(\S)/;
    if ($l =~ /[A-Z]/i) {
        $l = uc($l);
    }
    else {
	$l = "#";
    }
    push @{$plugins_by_letter{$l}},$_;
}
for my $letter (sort keys %plugins_by_letter) {
   my $menu = $plugmenu->Menu( -type => 'normal', -title => "$letter ..." );
   my $lmenu = $menu;
   my $c = 0;
   for my $plug (sort @{$plugins_by_letter{$letter}}) {
       if (@{$plugins_by_letter{$letter}} > 20 && $c == 0) {
	   my $start = substr($plug->name,0,6);
	   $start = ucfirst($start);
	   $menu = $lmenu->Menu( -type => 'normal', -title => "$start ..." );
	   $lmenu->add('cascade', -menu => $menu, -label => "$start ...");
       }
       $menu->add('command', -label => $plug->name(), -command => sub { add_plugin($plug) } );
       $c++;
       $c = 0 if $c == 20;
   }
   $plugmenu->add('cascade', -menu => $lmenu, -label => "$letter ...");
}



my $sfreq = 44100;
my $buffer_size = 4410;
my %plugins;
my $plug_id =0;
my $arrow_id = 0;

my ($connecting_plug,$connecting_port);


$network = Audio::LADSPA::Network->new(sample_frequency => $sfreq);

sub add_plugin {
    my ($plugname) = @_;
    my $plug = $network->add_plugin($plugname);
    make_buttons_for_plug($plug);
}

sub make_buttons_for_plug {
    my $plug = shift;
    $plugins{++$plug_id} = $plug;
    my $tag = "plug_$plug_id";

    my $frame = $net_canvas->Frame();
    my $button = $frame->Button(  -text => $plug->label, -width => 25, -height => 1, -background => '#ffffe8', -foreground => 'black')->pack( -fill => 'x');
#    $frame->put(0,0,$button);
    my $i = 0;
    for my $p ($plug->ports) {
	my $b = $frame->Button( 
	    -anchor => $plug->is_input($p) ? "w" : "e",
	    -text => $p, 
	    -background => $plug->is_control($p) ? "#202020" : "#600000", 
	    -foreground => "white",
	    -width => 25, 
	    -height => 1,
	    -font => $smallfont,
	)->pack( -fill => 'x' );
	$b->bind('',sub {popup_control_window($plug,$button)}),
	$b->bind('',sub { connect_it($plug,$p,$b) });
	$b->bind('',sub { disconnect_it($plug,$p,$b) });
#	$frame->put(++$i,0,$b);
    }
    $net_canvas->createWindow(100,200,-window => $frame, -tags => [ $tag, "table_$plug"], -anchor => 'n' );

    $button->bind('', sub {
	$button->raise();
	my $xdelta = ($button->rootx - $button->pointerx) + 25;
	my $ydelta = ($button->rooty - $button->pointery) + 30;
	
	$button->bind('', sub {
	    $net_canvas->coords($tag,($net_canvas->pointerx - $net_canvas->rootx) + $xdelta, ($net_canvas->pointery - $net_canvas->rooty) + $ydelta);
	});
    });


    $button->bind('', sub {
        $button->bind('',undef);
	Tk::Menu->Unpost(undef);
	update_arrows();
    });

    my $has_controls = grep { $plug->is_control($_) } $plug->ports;
    my $menu = $button->Menu( -type => 'normal', -title => $plug->label );
    $menu->add('command', -label => "Controls ...", -command => sub { popup_control_window($plug, $button, $plug_id)}, -state => $has_controls ? 'normal' : 'disabled' );
    $menu->add('command', -label => "Delete", -command => sub { delete_plugin($plug,$frame,$plug_id) } );
    $menu->add('command', -label => "About ...", -command => sub { plugin_about_window($plug, $button) } );

    
    $button->bind('', sub {popup_menu($button, $menu) });




}

sub update_arrow_to_pointer {
    my ($arrow_tag,$from_button) = @_;
    my $xf = $from_button->rootx - $net_canvas->rootx;
    my $yf = $from_button->rooty - $net_canvas->rooty;
    my $xp = $net_canvas->pointerx - $net_canvas->rootx;
    my $yp = $net_canvas->pointery - $net_canvas->rooty;
    if ($xp > $xf + 100) {
	$xf += 100;
    }
    elsif ( $xp > $xf ) {
	$xf = $xp;
    }
    if ($yp > $yf + 50) {
	$yf += 50;
    }
    elsif ( $yp > $yf ) {
	$yf = $yp;
    }
    $net_canvas->coords($arrow_tag,$xf,$yf,$xp,$yp);
}

sub popup_menu {
    my ($widget, $menu ) = @_;
    $menu->post( $widget->pointerx , $widget->pointery );
    $menu->activate(0);
    $menu->bind('',sub { $menu->unpost() });
}

# TODO - replace DialogBox with something that doesnt stop the runloop!

sub plugin_about_window {
    my ($plug, $button ) = @_;
    my $text ="";
    for (qw(label id name maker copyright port_count is_realtime
	    is_hard_rt_capable is_inplace_broken has_run 
	    has_run_adding has_activate has_deactivate)) {
	$text .= sprintf("%-18s : ",$_);

	if (! /^(is|has)/ and defined $plug->$_ ) {
	    $text .= $plug->$_;
	}
	elsif (/^(is|has)/) {
	    $text .= $plug->$_ ? "yes" : "no";
	}
	else {
	    $text .= "?";
	}
	$text .= "\n";
    }

    for my $port ($plug->ports) {
	$text .= "$port\n";
	for (qw(is_input is_control lower_bound 
		    upper_bound is_toggled is_integer is_sample_rate 
		    is_logarithmic default)) {
	    next unless defined ($plug->$_($port));
	    $text .= " " x 4;
	    $text .= sprintf("%-14s : ",$_);
            if (/^is/) {
		$text .= ($plug->$_($port) ? "yes" : "no")."\n";
		next;
	    }
	    elsif (/_bound$/ && $plug->is_integer($port)) {
		$text .= sprintf "%1.0f",$plug->$_($port);
	    }
	    elsif(/_bound$/) {
		$text .= sprintf "%1f",$plug->$_($port);
	    }
	    else {
		$text .= $plug->$_($port);
	    }
	    if (/_bound$/ && $plug->is_sample_rate($port)) {
		$text .= " x sample_rate";
	    }
	    $text .= "\n";
	}
    }
    rotext("About ".$plug->label(),$text);
}

sub about {
    rotext('About Audio::LADSPA Rack',<<'ENDABOUT');
Audio::LADSPA Rack $Revision: 1.21 $

Copyright (C) 2003 - 2004 Joost Diepenmaat.

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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

See the COPYING file for more information.
ENDABOUT
}


sub rotext {
    my ($title,$text) = @_;
    my $win = $main->DialogBox( -title => $title, -buttons => ["Ok"] );
    my $textw = $win->Scrolled('ROText', -scrollbars => 'se')->pack;
    $textw->Contents( $text);
    $win->Show();
}

sub popup_control_window {
    my ($plug,$button) = @_;
    my $window = $button->Toplevel( -title => $plug->label, -width => 300);
    for ($plug->ports) {
	next if $network->connections($plug,$_);
	my $port = $_;
	next unless $plug->is_control($_);
	next unless $plug->is_input($_);
	my $from = 0;
	if (defined $plug->lower_bound($_)) { 
	    $from = $plug->is_sample_rate($_) ? $plug->lower_bound($_) * $sfreq : $plug->lower_bound($_);
	}
	my $to = 1;
	if (defined $plug->upper_bound($_)) {
	    $to = $plug->is_sample_rate($_) ? $plug->upper_bound($_) * $sfreq : $plug->upper_bound($_);
	}
	my $res = $plug->is_integer($_) ? 1 : -1;
	warn "$_ range: $from, $to (res: $res)";
	my $scale;
	$scale = $window->Scale( 
	    -label => $_,
	    -orient => 'horizontal', 
	    -from => $from,
	    -to => $to,
	    -resolution => $res,
	    -command => sub { $plug->set( $port, shift() ),
	    '-length' => 300,
	},
        )->pack( -expand => 1, -fill => 'x' );
	$scale->set($plug->get($_));
	
    }
}

sub popup_connect_window {
    my ($plug,$button) = @_;
    my $window = $button->Toplevel( -title => "Connect ".$plug->label);
    for my $port ($plug->ports) {
	my $butt = $window->Button( -command => sub { connect_it($plug,$port) }, -text => $port )->pack( -expand => 'x');
    }
}

{
    my ($plug1,$port1);
    sub connect_it {
	my ($plug2,$port2) = @_;
	if ($plug1) {
	    return unless $plug1->is_input($port1) xor $plug2->is_input($port2);
	    if ($plug1->is_input($port1)) {
		($plug1,$port1,$plug2,$port2) = ($plug2,$port2,$plug1,$port1);
	    }
	    return if ($plug1->is_control($port1) && ! $plug2->is_control($port2));
	    warn "Connecting $plug1,$port1 -> $plug2,$port2\n";
	    $network->connect($plug1,$port1,$plug2,$port2) or do {warn "Connect error\n"; return };
	    $plug1 = undef;
	    update_arrows();
	}
	else {
	    ($plug1,$port1) = ($plug2,$port2);
	}
    }
}

sub display_arrow {
    my ($plug1,$port1,$plug2,$port2) = @_;
    my (undef,$y1,$x1) = $net_canvas->bbox("table_$plug1");
    my ($x2,$y2) = $net_canvas->bbox("table_$plug2");
    my ($pclass1) = $plug1 =~ /([^=]+)/; # avert yer eyes!
    my ($pclass2) = $plug2 =~ /([^=]+)/;
    
    $y1 += $pclass1->port2index($port1) * 26 + 39;
    $y2 += $pclass2->port2index($port2) * 26 + 39;
    my $color = $pclass1->is_control($port1) ? "#202020" : "#600000";
    my $arrow = $net_canvas->createLine($x1, $y1, $x1 + 30, $y1, $x2 - 50, $y2, $x2, $y2,
	    -arrow => 'last',
	    -tags => [ "arrow" ],
	    -fill => $color,
	    -width => 3,
	    -smooth => 1,
	    );
    $net_canvas->createOval($x1-3,$y1-3,$x1+3,$y1+3,-tags => ["arrow"], -fill => $color, -outline => $color);
    
}

sub disconnect_it {
    my ($plug,$port) = @_;
    $network->disconnect($plug,$port);
    update_arrows();
}

sub update_arrows {
    $net_canvas->delete("arrow");
    for my $plug ($network->plugins) {
	for my $port ($plug->ports) {
	    next if $plug->is_input($port);
	    my @dest = $network->connections($plug,$port);
	    while (my ($plug2,$port2) = splice @dest,0,2) {
		display_arrow($plug,$port,$plug2,$port2);
	    }
	}
    }
}
	
sub delete_plugin {
    my ($plug, $button,$id) = @_;
    $network->delete($plug);
    delete $plugins{$id};
    $button->destroy();
    update_arrows();
}

sub save_net_as {
    my $fname = $main->getSaveFile( -defaultextension => 'alrack'); 
    return unless $fname;
    _save($fname);
}

sub sub_save_net {
    if ($filename) {
	_save($filename);
    }
    else {
	save_net_as();
    }
}


sub _save {
    my ($fname) = @_;
    eval {DumpFile($fname,$network->dump)};
    if ($@) {
        warn $@;
    }
    else {
	$filename = $fname;
    }
}

sub load_net {
    my $fname = $main->getOpenFile( -defaultextension => 'alrack' ) or return;
    $network = Audio::LADSPA::Network->from_dump(LoadFile($fname));
    $filename =$fname;
    $net_canvas->delete("all");
    make_buttons_for_plug($_) for $network->plugins;
    update_arrows();
}

sub new_net {
    $net_canvas->delete("all");
    $network = undef;
    $filename = undef;
}

sub load_preferences {
    my $defaults = {
	perl_based_plugins => [ qw(
		Audio::LADSPA::Plugin::Play
		Audio::LADSPA::Plugin::Sequencer4
		) ],
    };
    my $prefs;
    eval { $prefs = LoadFile("$ENV{HOME}/.audio_ladspa_rackrc") };
    if ($prefs) {
	$prefs ||= {
	    perl_based_plugins => [ qw(
		    Audio::LADSPA::Plugin::Play
		    Audio::LADSPA::Plugin::Sequencer4
		    ) ],	
	};
	save_prefs($prefs);
    }
    return $prefs;
}



sub save_prefs {
    my $prefs = shift;
    eval { DumpFile("$ENV{HOME}/.audio_ladspa_rackrc",$prefs) };
}

{
    my $run = 0;
    my $quit;

    sub play {
	$run = 1;
	update_buttonstate();
    }
    
    sub update_buttonstate {
	$playbutton->configure(-background => $run == 1 ? '#00e000' : '#008000');
    }

    sub stop {
	$run = 0;
	update_buttonstate();
    }

    sub quit {
	$quit = 1;
    }

    my $blink = 0;
    sub blink {
	if ($run == 1) {
	    $playbutton->configure(-background => $blink ? '#00e000' : '#008000');
	    $blink = !$blink;
	}
    }

    my $count;
    while (1) {
	DoOneEvent(DONT_WAIT);
	select undef,undef,undef,0.0001;
	$network->run(100,1) if $run;
	if ($count++ >= 250) {
	    blink();
	    $count =0;
	}
	exit if $quit;
    }
}

sub help {
    rotext('Help for Audio::LADSPA Rack',<<'ENDHELP');
Audio::LADSPA Rack - simpleminded modular synthesizer in Perl.

With this program you can create networks of LADSPA plugins
for general information about the LADSPA framework, including
information on how to obtain plugins, see http://www.ladspa.org/

For more information on the Audio::LADSPA perl modules, see the
man pages / pod for those modules; type perldoc Audio::LADSPA

BUGS

Lots. Save often.

ADDING AND DELETING PLUGINS

Add plugins using the "Add Plugin" menu. Move plugins around by
left-clicking and dragging the top bar of the plugin. Right-click
on the top bar pops up a menu for About, Controls and Delete.

New plugins will alway appear at the same location; there is no
smart placement, so move the plugins around after adding them
to get a better overview of the network.

CONNECTING PLUGINS

All plugin ports are shown as bars in the plugin. Red bars are
audio ports, black bars are control ports. Input ports are
left-aligned, output ports are right-aligned.

To connect port between plugins middle-click on a port, then
middle-click on another port. You can not connect a control-out
to an audio-in port, you can also not connect more than one
output port to an input port, and you can't create loops in the
network.

Right-click on a port will disconnect the port.

PLAY/STOP

Click on the play button to start play, and on the stop button
to stop playback. You need to have some output connected to
a plugin that sends the data to your audio card; you can use
the Audio::LADSPA::Plugin::Play plugin to do that (you can use
only one Audio::LADSPA::Plugin::Play plugin, and the output will
be mono).

ENDHELP
}

demo file:

--- #YAML:1.0
Audio::LADSPA::Network: 0.000
BufferSize: 1024
DumpVersion: 0.01
Plugins:
  - Class: Audio::LADSPA::Plugin::Sequencer4
    Id: 0x872ee0c
    Ports:
      - Name: Run/Step
        Value: 189
      - Name: Step 1
        Value: 68
      - Name: Step 2
        Value: 64
      - Name: Step 3
        Value: 72
      - Name: Step 4
        Value: 71
      - Connections:
          - Id: 0x8adaa58
            Port: Frequency (Hz)
        Name: Frequency
      - Connections: []
        Name: Trigger
  - Class: Audio::LADSPA::Plugin::XS::sine_fcac_1047
    Id: 0x8adaa58
    Ports:
      - Name: Frequency (Hz)
        Value: 329.627563476562
      - Name: Amplitude
        Value: 1
      - Connections:
          - Id: 0x8af984c
            Port: Input
        Name: Output
  - Class: Audio::LADSPA::Plugin::Play
    Id: 0x8af984c
    Ports:
      - Name: Input
SampleRate: 44100
Hope you like it,
Joost.
[id://149675|"What should it profit a man, if he should win a flame war, yet lose his cool?"]
Re: A simpleminded modular synthesizer
created: 2004-06-30 13:57:29
I am glad you posted this. I was having trouble getting Audio 1.028 to work with Alsa 1.0.4, but I just checked and Audio 1.029 is out and working fine. :-)

I got your script to run, but was wondering how do I use the demo file you list at the end of your code?


I'm not really a human, but I play one on earth. flash japh
Re^2: A simpleminded modular synthesizer
created: 2004-06-30 15:43:34
It should work by just saving the file somewhere and then loading it via "File.. open". Press play, and there should be sound :-)

Re^3: A simpleminded modular synthesizer
created: 2004-07-01 09:40:36
Ok, I see what the problem was. The loadable files must have an ".alrack" extension.

I'm not really a human, but I play one on earth. flash japh

perlmonks.org content © perlmonks.org and Joost, zentara

prlmnks.org © 2006 edmund von der burg (eccles & toad)

v 0.03