#!/usr/bin/perl use strict; use warnings; use IO::Handle; pipe(my $readpipe, WRITEPIPE); WRITEPIPE->autoflush(1); $readpipe->autoflush(1); my $conffile="$ENV{'HOME'}/.esbnums"; my $file=$ARGV[0]; if( ! -f $file ) { print "First argument needs to be a valid file.\n"; exit 1; } my %paranums; if( -f $conffile ) { print "conf file reading not done\n"; open( my $conffh, '<', $conffile ) or die "Can't open $conffile\n"; while(<$conffh>) { my ( $key, $val ) = ( m(^([^:]+):\s+(.+)$) ); $paranums{$key} = $val; } } my $shortfile=$file; $shortfile=~s(.*/)(); $shortfile=~s(:)()g; $shortfile=~s(\s)()g; if( ! defined $paranums{$shortfile} ) { $paranums{$shortfile} = 0; } qx(stty cbreak); qx(stty -echo); open( my $fh, "<", $file ) or die "could not open book"; my @para; { local $/; my $str = <$fh>; @para = split( qr(\n\s*\n), $str ); # save ram $str = ''; } if( my $pid = fork ) { close $readpipe; my $char; my $arrow1 = 0; my $arrow2 = 0; while( read( STDIN, $char, 1 ) ) { # print "char: -$char-, $arrow1, $arrow2\n"; # FIXME: use char code if( $char eq 'q' && ! $arrow1 && ! $arrow2 ) { print "quitting\n"; print WRITEPIPE "quit\n"; kill 'USR1', $pid; qx(stty -cbreak); qx(stty echo); close WRITEPIPE; wait; exit 0; } if( $char eq ' ' && ! $arrow1 && ! $arrow2 ) { print "space"; print WRITEPIPE "pause-toggle\n"; kill 'USR1', $pid; } if( $char eq '' && ! $arrow1 && ! $arrow2 ) { $arrow1 = 1; next; } if( $char eq '[' && $arrow1 && ! $arrow2 ) { $arrow2 = 1; next; } if( $char eq 'A' && $arrow1 && $arrow2 ) { print "up arrow\n"; print WRITEPIPE "faster\n"; kill 'USR1', $pid; } if( $char eq 'B' && $arrow1 && $arrow2 ) { print "down arrow\n"; print WRITEPIPE "slower\n"; kill 'USR1', $pid; } if( $char eq 'C' && $arrow1 && $arrow2 ) { print "right arrow\n"; print WRITEPIPE "next\n"; kill 'USR1', $pid; } if( $char eq 'D' && $arrow1 && $arrow2 ) { print "left arrow\n"; print WRITEPIPE "previous\n"; kill 'USR1', $pid; } $arrow1 = $arrow2 = 0; } } else { close WRITEPIPE; my $espeakfh; my $espeakpid; my $getcommand=0; my $speed=180; sub catch_usr1 { print "got signal usr1\n"; # must be here, or we wait to speak the whole para before checking the command kill 'KILL', $espeakpid; $getcommand=1; } $SIG{'USR1'} = \&catch_usr1; my $paused = 0; while( 1 ) { my $partext=$para[$paranums{$shortfile}]."\n"; if( ! $paused ) { $espeakpid = open( my $espeakfh, '|-', 'espeak', "-s $speed" ) or die qq(Can't call espeak: $!); print "reading para $paranums{$shortfile} at speed $speed: $partext\n"; print $espeakfh $partext; close( $espeakfh ); waitpid $pid, 0; } else { print "not reading para $paranums{$shortfile} at speed $speed: $partext\n"; sleep 900; } if( $getcommand ) { print "child getting command\n"; $getcommand=0; while( my ( $eof, $command ) = nonblockGetLines( $readpipe, 0.1 ) ) { if( $command eq 'next' ) { print "next\n"; $paranums{$shortfile} += 1; } elsif( $command eq 'previous' ) { print "previous\n"; $paranums{$shortfile} -= 1; } elsif( $command eq 'faster' ) { print "faster\n"; $speed += 20; } elsif( $command eq 'slower' ) { print "slower\n"; $speed -= 20; } elsif( $command eq 'pause-toggle' ) { print "pause ".($paused ? 'off' : 'on')."\n"; $paused = $paused ? 0 : 1 ; } elsif( $command eq 'quit' ) { # save paranums; must be here because parent doesn't have the updates open( my $conffh, '>', $conffile ) or die "Can't open $conffile\n"; foreach my $key (keys %paranums) { print $conffh "$key: $paranums{$key}\n"; } exit 0; } else { print "bad command $command\n"; } } } else { if( ! $paused ) { $paranums{$shortfile} += 1; } } } } # An non-blocking filehandle read that returns an array of lines read # Returns: ($eof,@lines) my %nonblockGetLines_last; sub nonblockGetLines { my ($fh,$timeout) = @_; $timeout = 0 unless defined $timeout; my $rfd = ''; $nonblockGetLines_last{$fh} = '' unless defined $nonblockGetLines_last{$fh}; vec($rfd,fileno($fh),1) = 1; return unless select($rfd, undef, undef, $timeout)>=0; # I'm not sure the following is necessary? return unless vec($rfd,fileno($fh),1); my $buf = ''; my $n = sysread($fh,$buf,1024*1024); # If we're done, make sure to send the last unfinished line return (1,$nonblockGetLines_last{$fh}) unless $n; # Prepend the last unfinished line $buf = $nonblockGetLines_last{$fh}.$buf; # And save any newly unfinished lines $nonblockGetLines_last{$fh} = (substr($buf,-1) !~ /[\r\n]/ && $buf =~ s/([^\r\n]*)$//) ? $1 : ''; $buf ? (0,split(/\n/,$buf)) : (0); }