| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package ByteBeat; | 
| 2 |  |  |  |  |  |  | our $VERSION = '0.0.4'; | 
| 3 |  |  |  |  |  |  |  | 
| 4 | 1 |  |  | 1 |  | 1001 | use Mo; | 
|  | 1 |  |  |  |  | 372 |  | 
|  | 1 |  |  |  |  | 4 |  | 
| 5 | 1 |  |  | 1 |  | 802 | use Getopt::Long; | 
|  | 1 |  |  |  |  | 8869 |  | 
|  | 1 |  |  |  |  | 4 |  | 
| 6 | 1 |  |  | 1 |  | 423 | use ByteBeat::Compiler; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 405 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | has args => (); | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | my $code = ''; | 
| 11 |  |  |  |  |  |  | my $file; | 
| 12 |  |  |  |  |  |  | my $second = 2**13; | 
| 13 |  |  |  |  |  |  | my $length = 0; | 
| 14 |  |  |  |  |  |  | my $debug = 0; | 
| 15 |  |  |  |  |  |  | my $shell = 0; | 
| 16 |  |  |  |  |  |  | my $play = 0; | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | sub run { | 
| 19 | 0 |  |  | 0 | 0 |  | my ($self) = shift; | 
| 20 | 0 |  |  |  |  |  | $self->get_options; | 
| 21 |  |  |  |  |  |  |  | 
| 22 | 0 | 0 | 0 |  |  |  | if ($shell or not $code) { | 
| 23 | 0 |  |  |  |  |  | require ByteBeat::Shell; | 
| 24 | 0 |  |  |  |  |  | ByteBeat::Shell->new(file => $file)->run; | 
| 25 | 0 |  |  |  |  |  | return; | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 | 0 |  |  |  |  |  | my $function = ByteBeat::Compiler->new(code => $code)->compile; | 
| 29 |  |  |  |  |  |  |  | 
| 30 | 0 | 0 |  |  |  |  | if ($debug) { | 
| 31 | 0 |  |  |  |  |  | print "RPN: @{$function->{rpn}}\n"; | 
|  | 0 |  |  |  |  |  |  | 
| 32 | 0 |  |  |  |  |  | for (my $t = 1; $t <= $length; $t++) { | 
| 33 | 0 |  |  |  |  |  | print $function->run($t) % 256, "\n"; | 
| 34 |  |  |  |  |  |  | } | 
| 35 | 0 |  |  |  |  |  | return; | 
| 36 |  |  |  |  |  |  | } | 
| 37 |  |  |  |  |  |  |  | 
| 38 | 0 |  | 0 |  |  |  | $length ||= 60 * $second; | 
| 39 |  |  |  |  |  |  |  | 
| 40 | 0 | 0 |  |  |  |  | if ($play) { | 
| 41 | 0 |  |  |  |  |  | require IPC::Run; | 
| 42 | 0 |  |  |  |  |  | my $bytes; | 
| 43 |  |  |  |  |  |  | my $out; | 
| 44 |  |  |  |  |  |  |  | 
| 45 | 0 |  |  |  |  |  | my $process = IPC::Run::start(['aplay'], \$bytes, \$out, \$out); | 
| 46 | 0 |  |  |  |  |  | for (my $t = 1; $t <= $length; $t++) { | 
| 47 | 0 |  |  |  |  |  | $bytes .= chr ($function->run($t) % 256); | 
| 48 | 0 |  |  |  |  |  | IPC::Run::pump($process); | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  | } | 
| 51 |  |  |  |  |  |  |  | 
| 52 | 0 |  |  |  |  |  | for (my $t = 1; $t <= $length; $t++) { | 
| 53 | 0 |  |  |  |  |  | print chr ($function->run($t) % 256); | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  | } | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | sub get_options { | 
| 58 | 0 |  |  | 0 | 0 |  | my ($self) = shift; | 
| 59 | 0 |  |  |  |  |  | local @ARGV = @{$self->args}; | 
|  | 0 |  |  |  |  |  |  | 
| 60 | 0 |  |  |  |  |  | GetOptions( | 
| 61 |  |  |  |  |  |  | 'file=s' => \$file, | 
| 62 |  |  |  |  |  |  | 'length=s' => \$length, | 
| 63 |  |  |  |  |  |  | 'debug' => \$debug, | 
| 64 |  |  |  |  |  |  | 'shell' => \$shell, | 
| 65 |  |  |  |  |  |  | 'play' => \$play, | 
| 66 |  |  |  |  |  |  | ); | 
| 67 | 0 | 0 |  |  |  |  | $length = | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | $length =~ /^(\d+)s$/ ? $1 * $second : | 
| 69 |  |  |  |  |  |  | $length =~ /^(\d+)m$/ ? $1 * $second * 60 : | 
| 70 |  |  |  |  |  |  | $length =~ /^(\d+)$/ ? $1 : | 
| 71 |  |  |  |  |  |  | die "Invalid value for '-l'\n"; | 
| 72 | 0 | 0 |  |  |  |  | $code = @ARGV ? shift(@ARGV) : -t STDIN ? '' : <>; | 
|  |  | 0 |  |  |  |  |  | 
| 73 | 0 |  |  |  |  |  | chomp $code; | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | 1; |