speedread

#!/usr/bin/env perl
#
# speedread:  A simple terminal-based open source spritz-alike
#
# Show input text as a per-word RSVP (rapid serial visual presentation)
# aligned on optimal reading points.  This kind of input mode allows
# reading text at a much more rapid pace than usual as the eye can
# stay fixed on a single place.
#
# (c) Petr Baudis <pasky@ucw.cz>  2014
# MIT licence
#
# Usage: cat file.txt | speedread [-w WORDSPERMINUTE] [-r RESUMEPOINT] [-m]
#
# The default of 250 words per minut is very timid, designed so that
# you get used to this.  Be sure to try cranking this up, 500wpm
# should still be fairly easy to follow even for beginners.
#
# speedread can join short words together if you specify the -m switch.
# It did not work well for pasky so far, though.
#
# speedread is slightly interactive, with these controls accepted:
#
#   [ - slow down by 10%
#   ] - speed up by 10%
#   space - pause (and show the last two lines)

use warnings;
use strict;
use autodie;
use v5.14;

my $wpm = 250;
my $resume = 0;
my $multiword = 0;


use utf8;
binmode(STDIN, ":encoding(UTF-8)");
binmode(STDOUT, ":encoding(UTF-8)");

use Term::ANSIColor;
use POSIX qw(ceil floor);
use Time::HiRes qw(time sleep gettimeofday tv_interval);

use Getopt::Long;
GetOptions("wpm|w=i" => \$wpm,
	   "resume|r=i" => \$resume,
	   "multiword|m" => \$multiword);

my $wordtime = 0.9; # relative to wpm
my $lentime = 0.04; # * sqrt(length $word), relative to wpm
my $commatime = 2; # relative to wpm
my $fstoptime = 3; # relative to wpm
my $multitime = 1.2; # relative to wpm
my $firsttime = 0.2; # [s]
my $ORPloc = 0.35;
my $ORPmax = 0.2;
my $ORPvisualpos = 20;
my $cursorpos = 64;
my $paused = 0;
my $current_word;
my $current_orp;
my $next_word_time = 0;
my $next_input_time = 0;
my $skipped = 0;

my @lastlines;
my $tty = rawinput->new();
$| = 1;

my $wordcounter = 0;
my $lettercounter = 0;
my $t0 = [gettimeofday];
sub print_stats {
	my $elapsed = tv_interval($t0, [gettimeofday]);
	my $truewpm = $wordcounter / $elapsed * 60;
	printf("\n %.2fs, %d words, %d letters, %s%.2f%s true wpm\n",
		$elapsed, $wordcounter, $lettercounter,
		color('bold green'), $truewpm, color('reset'));
}
$SIG{INT} = sub {
	print_stats;
	my $resume_word = $wordcounter + $resume;
	say " To resume from this point run with argument -r $resume_word";
	exit;
};

main();

# ORP: Optical Recognition Point (the red-colored alignment pilot),
# the way Spritz probably does it.
sub find_ORP {
	my ($word, $ORPloc) = @_;

	return 4 if (length($word) > 13);
	return (0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3)[length($word)];
}

sub show_guide {
	# Top visual guide
	say(" "x$ORPvisualpos . color('red') . "v" . color('reset') . "\033[K");
}

sub show_word {
	my ($word, $i) = @_;

	my $pivotch = substr($word, $i, 1);
	$pivotch = "·" if $pivotch eq ' ';

	print("\r\033[K"
		. " " x ($ORPvisualpos - $i)
		. color("bold")
		. substr($word, 0, $i)
		. color("red")
		. $pivotch
		. color("reset")
		. color("bold")
		. substr($word, $i+1)
		. color("reset")
		. " " x ($cursorpos - (($ORPvisualpos - $i) + length($word)))
		. "$wpm wpm"
		. ($paused ? "  ".color("yellow")."PAUSED".color("reset") : ""));
}

sub word_time {
	my ($word) = @_;

	my $time = $wordtime;
	if ($word =~ /[.?!]\W*$/) {
		$time = $fstoptime;
	} elsif ($word =~ /[:;,]\W*$/) {
		$time = $commatime;
	} elsif ($word =~ / /) {
		$time = $multitime;
	}
	$time += sqrt(length($word)) * $lentime;
	$time *= 60 / $wpm;

	# Give user some time to focus on the first word, even with high wpm.
	$time = $firsttime if ($wordcounter == 0 and $time < $firsttime);

	return $time;
}

sub print_context {
	my ($wn) = @_;
	# One line up and to its beginning
	print "\r\033[K\033[A\033[K";
	# First line of context
	say $lastlines[1] if $lastlines[1];
	# In second line of context, highlight our word
	my $line0 = $lastlines[0];
	my $c0 = color('yellow');
	my $c1 = color('reset');
	$line0 =~ s/^((?:.*?(?:-|\s)+){$wn})(.*?)(-|\s)/$1$c0$2$c1$3/;
	say $line0;
}

sub process_keys {
	my ($word, $i, $wn) = @_;
	while ($tty->key_pressed()) {
		my $ch = $tty->getch();
		if ($ch eq '[') {
			if ($wpm > 1) {
				$wpm = int($wpm * 0.9);
			} else {
				$paused = 1;
			}
		} elsif ($ch eq ']') {
			if ($wpm >= 10) {
				$wpm = int($wpm * 1.1);
			} else {
				$wpm += 1;
			}
		} elsif ($ch eq ' ') {
			$paused = not $paused;
			if ($paused) {
				# Print context.
				print_context($wn);
				show_guide();
				show_word($word, $i);
			}
			else {
				$next_word_time = time();
			}
		}
	}
}

sub main {
	show_guide();

	$next_word_time = time();
	$next_input_time = time();

	while (<>) {
		chomp;

		unshift @lastlines, $_;
		pop @lastlines if @lastlines > 2;

		my (@words) = grep { /./ } split /(?:-|\s)+/;

		if ($multiword) {
			# Join adjacent short words
			for (my $i = 0; $i < $#words - 1; $i++) {
				if (length($words[$i]) <= 3 and length($words[$i+1]) <= 3) {
					$words[$i] .= ' ' . $words[$i+1];
					splice(@words, $i+1, 1);
				}
			}
		}

		my $wn = 0;
		while (scalar(@words) > 0) {
			if ($skipped < $resume) {
				$skipped++;
				shift @words;
				next;
			}

			my $current_time = time();

			if ($next_word_time <= $current_time and !$paused) {
				$current_word = shift @words;
				$current_orp = find_ORP($current_word, $ORPloc);
				$next_word_time += word_time($current_word);
				$wordcounter++;
				$lettercounter += length($current_word);
				$wn++;
			}

			if ($next_input_time <= $current_time) {
				process_keys($current_word, $current_orp, $wn);
				$next_input_time += 0.05; # checking for input 20 times / second seems to give a reasonably responsive UI
			}

			# redrawing the word on each "frame" gives a more responsive UI
			# (we don't have to wait for the word to change to display changed stats like wpm)
			show_word($current_word, $current_orp);

			my $sleep_time = ($next_word_time < $next_input_time and !$paused) ? $next_word_time-$current_time : $next_input_time-$current_time;
			sleep($sleep_time) if ($sleep_time > 0);
		}
	}

	print_stats();
	sleep(1);
}


package rawinput;

# An ad-hoc interface to interactive terminal input.  Term::Screen *should*
# have been a natural choice here, unfortunately it is fixated at reading
# from stdin instead of /dev/tty. Tough.

sub new {
	my $class = shift;
	my $self;
	open $self, '/dev/tty';
	bless $self, $class;
	stty('min 1', '-icanon', '-echo');
	return $self;
}

sub DESTROY {
	stty('cooked', 'echo');
}

sub stty {
	my $self = shift;
	eval { system('stty', $^O eq 'darwin' ? '-f' : '-F', '/dev/tty', @_); };
}

sub key_pressed {
	my $self = shift;
	my $readfields = '';
	vec($readfields, fileno($self), 1) = 1;
	my $ready = 0;
	eval { $ready = select($readfields, undef, undef, 0); };
	return $ready;
}

sub getch {
	my $self = shift;
	getc($self);
}