From 2e9749f0922e4c0337845b1d2de733d1ceab3195 Mon Sep 17 00:00:00 2001 From: Harvie Date: Sun, 31 Oct 2010 20:07:44 +0100 Subject: [PATCH] Added first revision of experimental MPmix software - DJ player using Mplayer, PERL and GTK+ --- perl/mpmix/MPlayer.pm | 292 ++++++++++++++++++++++++++++++++++++++++++ perl/mpmix/mpmix.pl | 38 ++++++ perl/mpmix/mpmix.ui | 240 ++++++++++++++++++++++++++++++++++ 3 files changed, 570 insertions(+) create mode 100644 perl/mpmix/MPlayer.pm create mode 100755 perl/mpmix/mpmix.pl create mode 100644 perl/mpmix/mpmix.ui diff --git a/perl/mpmix/MPlayer.pm b/perl/mpmix/MPlayer.pm new file mode 100644 index 0000000..4567ab8 --- /dev/null +++ b/perl/mpmix/MPlayer.pm @@ -0,0 +1,292 @@ +package Audio::Play::MPlayer; + +use strict; +use warnings; +#use base qw(Class::Accessor::Fast); +use base qw(Object::Accessor); + +=head1 NAME + +Audio::Play::MPlayer - a frontend to play audio files using MPlayer + +=head1 SYNOPSIS + + use Audio::Play::MPlayer; + + # same as Audio::Play::MPG123 + $player = Audio::Play::MPlayer->new; + + # Set speed to _2.5x_ + $player->speed(+1.5); + + $player->load( "ex-mp30.mp3" ); + print $player->title, "\n"; + $player->poll( 1 ) until $player->state == 0; + +=head1 DESCRIPTION + +This module acts as a frontend to an external MPlayer process started +with the C<-slave> command-line option. The idea and interface (and +in part the code) has been taken from L. + +Please see L for the documentation. Take into account +that the methods: + + copyrighted + emphasis + error_protected + extension + layer + mode + mode_extension + stat + statfreq + type + url + IN + +have not been implemented, and that: + + jump + tpf + +work differently: C takes offsets in seconds, and C always +returns C<1> to make it possible to write: + + $player->jump( 60 / $player->tpf ); + +=cut + +use IPC::Open3 qw(open3); +use IO::Handle; + +our $VERSION = '0.03'; + +# FIXME, missing +# url type layer mode mode_extension copyrighted error_protected +# emphasis extension +#__PACKAGE__->mk_accessors( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); +#Object::Accessor->new( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); + +#my $bool = $obj->mk_accessors( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); + +sub new { + my( $class, %args ) = @_; + my $self = bless \%args, $class; + + $self->start_mplayer( $args{mplayerargs} ); + $self->{state} = 0; + + $self->mk_accessors( qw(frame title artist album year comment genre samplerate channels bitrate extension) ); + return $self; +} + +sub DESTROY { + my( $self ) = @_; + + $self->stop_mplayer; +} + +sub start_mplayer { + my( $self, $args ) = @_; + my( $wr, $rd ); + + my $pid = open3( $wr, $rd, $rd, + 'mplayer', '-slave', '-idle', @{$args || []} ); + + die "Can't start mplayer" unless $pid; + + $self->{pid} = $pid; + $self->{r} = $rd; + $self->{w} = $wr; + $self->{r}->blocking( 0 ); + $self->{frame} = [ undef, undef, undef, undef ]; + $self->{buffer} = ''; +} + +sub stop_mplayer { + my( $self ) = @_; + + return unless $self->{pid}; + $self->command( 'quit' ); + my $pid = delete $self->{pid}; + close delete $self->{r}; + close delete $self->{w}; + waitpid $pid, 0; +} + +sub line { + my( $self, $wait ) = @_; + + for(;;) { + # append to buffer + my $len = sysread $self->{r}, $self->{buffer}, 2048, + length( $self->{buffer} ); + return $1 if $self->{buffer} =~ s/^([^\n\r]*)[\r\n]+//; + if( $wait ) { + vec( my $rbits = '', fileno( $self->{r} ), 1 ) = 1; + select $rbits, undef, undef, 60; + } else { + return; + } + } +} + +my %info = + ( meta_title => [ 'get_meta_title', 'title', ], + meta_artist => [ 'get_meta_artist', 'artist', ], + meta_album => [ 'get_meta_album', 'album', ], + meta_year => [ 'get_meta_year', 'year', ], + meta_comment => [ 'get_meta_comment', 'comment', ], + meta_genre => [ 'get_meta_genre', 'genre', ], + ); + +# AUDIO: 44100 Hz, 2 ch, s16le, 128.0 kbit/9.07% (ratio: 16000->176400) +# A: 16.5 (16.4) of 252.3 (04:12.3) 3.6% +# ===== PAUSE ===== +sub parse { + my( $self, $re, $wait ) = @_; + + while( my $line = $self->line( $wait ) ) { + if( $line =~ /^A:\s+([\d\.]+)\s+\([\d\:\.]+\)\s+of\s+([\d\.]+)/ ) { + $self->{frame}->[2] = $1; + $self->{frame}->[3] = $2 - $1; + # FIXME heuristic + $self->{state} = 0 if $self->{frame}->[3] <= 0; + } elsif( $line =~ /=====\s+PAUSE\s+=====/ ) { + $self->{state} = 1; + } elsif( $line =~ /^ANS_(\w+)='([^']+)'$/ ) { + # FIXME quoting + my( $k, $v ) = ( lc( $1 ), $2 ); + + if( $info{$k} ) { + $self->{$info{$k}->[1]} = $v; + } + } elsif( $line =~ /^AUDIO:\s+(\d+)/ ) { + $self->{samplerate} = $1; + if( $line =~ /(\d+)\s+ch/i ) { + $self->{channels} = $1; + } + if( $line =~ /(\d+)\.\d+\s+kbit/i ) { + $self->{bitrate} = $1; + } + } elsif( $line =~ /^Playing\s/ ) { + $self->{$_->[1]} = undef foreach values %info; + $self->command( $_->[0] ) foreach values %info; + } elsif( $line =~ /^\s+(title|artist|album|year|comment|genre):\s(.*?)\s*$/i ) { + # FIXME heuristic + $self->{lc($1)} = $2; + } else { + # print STDERR $line, "\n"; + } + return $line if $line =~ $re; + } + + return; +} + +sub poll { + my( $self, $wait ) = @_; + + $self->parse( qr/./, $wait ); # wait for anything + $self->parse( qr/^\0/, 0 ); # consume pending output +} + +sub command { + my( $self, $command ) = @_; + + print { $self->{w} } $command, "\n"; +} + +sub load { + my( $self, $file ) = @_; + + # FIXME quoting + $self->command( qq{loadfile "$file"} ); + $self->{state} = 2; # feeling lucky +} + +sub state { + my( $self ) = @_; + + return $self->{state}; +} + +# FIXME works more-or-less +sub stop { + my( $self ) = @_; + + return if $self->{state} == 0; + $self->pause if $self->{state} == 2; + $self->command( 'pausing_keep seek 0.0 2' ); + $self->poll; + $self->{state} = 0; +} + +sub pause { + my( $self ) = @_; + + return if $self->{state} == 0; + $self->command( "pause" ); + if( $self->{state} == 2 ) { + $self->parse( qr/=====\s+PAUSE\s+=====/, 1 ); + # try to parse metatdata command answers + $self->poll; + } elsif( $self->{state} == 1 ) { + $self->{state} = 2; + } +} + +sub paused { $_[0]->{state} == 2 ? 0 : 1 } + +# FIXME not like Audio::Play::MPG123 +sub jump { + my( $self, $seconds ) = @_; + + if( $seconds && $seconds =~ /^[+\-]/ ) { + $self->command( "seek $seconds 0" ); + } else { + $self->command( "seek $seconds 2" ); + } +} + +# Sets the player speed to current speed + delta +sub speed { + my( $self, $delta ) = @_; + + return if $self->{state} == 0; + return if not defined $delta or $delta == 0; + + $self->command( sprintf( "speed %.2f", $delta ) ); + return; +} + +# mock Audio::Play::MPG123 +sub tpf { 1 } + +=head1 AUTHOR + +Mattia Barbon , using ideas from +L by Marc Lehmann . + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=head1 SOURCES + +The latest sources can be found on GitHub at +L + +=head1 THANKS + +Marc Lehmann for L. + +The MP3 file used in tests has been taken from +L (test ID3 tag not +in original). + +=cut + +1; diff --git a/perl/mpmix/mpmix.pl b/perl/mpmix/mpmix.pl new file mode 100755 index 0000000..835edd6 --- /dev/null +++ b/perl/mpmix/mpmix.pl @@ -0,0 +1,38 @@ +#!/usr/bin/env perl +#ArchLinux Daemon Manager Gui! by Harvie 2oo9 +use strict; +use warnings; +use utf8; +require "MPlayer.pm"; +use Gtk2 qw(-init); + +my $player = Audio::Play::MPlayer->new; +$player->load( "/home/harvie/Downloads/Shared/Bonobo-Walk_In_The_Sky_(Feat.Bajka).mp3" ); +sleep 1; +#print $player->title. "\n"; +#print $player->{track}->{title}, "\n"; +$player->speed(0.3); +$player->poll( 1 ) until $player->state == 0; + +my $builder = Gtk2::Builder->new(); +$builder->add_from_file('mpmix.ui'); + +my %widgets; +foreach my $widget qw(window1) +{ + $widgets{$widget}=$builder->get_object($widget); +} + +$builder->connect_signals(undef); +$builder = undef; + +$widgets{'window1'}->show(); + + +Gtk2->main(); +exit; + +sub on_window1_destroy +{ + Gtk2->main_quit(); +} diff --git a/perl/mpmix/mpmix.ui b/perl/mpmix/mpmix.ui new file mode 100644 index 0000000..d4a33e0 --- /dev/null +++ b/perl/mpmix/mpmix.ui @@ -0,0 +1,240 @@ + + + + + + 440 + 250 + + + + True + vertical + + + True + + + True + True + vertical + + + False + 0 + + + + + True + vertical + + + True + label + + + 0 + + + + + True + True + False + + + 1 + + + + + True + True + + + gtk-media-play + True + True + True + True + + + False + 0 + + + + + loop + True + True + True + + + 1 + + + + + + + + 2 + + + + + True + + + 100 + True + True + vertical + + + False + 0 + + + + + + + + + + + + + + + + + 3 + + + + + 1 + + + + + True + label + + + 2 + + + + + True + True + vertical + + + False + 3 + + + + + False + 0 + + + + + True + True + + + True + label + + + 0 + + + + + True + True + + + 1 + + + + + True + label + + + 2 + + + + + False + 1 + + + + + True + True + left + + + True + label + + + + + True + music + + + False + + + + + + + + True + page 2 + + + 1 + False + + + + + + + + True + page 3 + + + 2 + False + + + + + 2 + + + + + + -- 2.30.2