#!/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 => 'ra
+ised' )->pack(-fill => 'x', -expand => 0, -anchor => 'w');

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

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

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

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_n
+et_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 => 4
+00, -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')->pac
+k( -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('<ButtonPress-1>',sub {popup_control_window($plug,$button
+)}),
    $b->bind('<ButtonPress-2>',sub { connect_it($plug,$p,$b) });
    $b->bind('<ButtonPress-3>',sub { disconnect_it($plug,$p,$b) });
#    $frame->put(++$i,0,$b);
    }
    $net_canvas->createWindow(100,200,-window => $frame, -tags => [ $t
+ag, "table_$plug"], -anchor => 'n' );

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


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

    my $has_controls = grep { $plug->is_control($_) } $plug->ports;
    my $menu = $button->Menu( -type => 'normal', -title => $plug->labe
+l );
    $menu->add('command', -label => "Controls ...", -command => sub { 
+popup_control_window($plug, $button, $plug_id)}, -state => $has_contr
+ols ? 'normal' : 'disabled' );
    $menu->add('command', -label => "Delete", -command => sub { delete
+_plugin($plug,$frame,$plug_id) } );
    $menu->add('command', -label => "About ...", -command => sub { plu
+gin_about_window($plug, $button) } );

    
    $button->bind('<ButtonPress-3>', 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('<ButtonRelease>',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($_) * $sf
+req : $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,$po
+rt) }, -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($p
+ort2);
        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 "Co
+nnect 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' : '#00
+8000');
    }

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

    sub quit {
    $quit = 1;
    }

    my $blink = 0;
    sub blink {
    if ($run == 1) {
        $playbutton->configure(-background => $blink ? '#00e000' : '#0
+08000');
        $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
}
[download]

--- #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
[download]