initial commit

author: Daniel Friesel <derf@finalrewind.org> 2011-10-29 02:29:33 +0200
committer: Daniel Friesel <derf@finalrewind.org> 2011-10-29 02:29:33 +0200
commit: ae6fb6a1aa12a52d94bf1f220d75111dff6a54ee (patch)
tree: 52bbcbf307f62bdf53eafa5c4b7bbc11701c8c5d
4 files changed, 339 insertions, 0 deletions
diff --git a/Build.PL b/Build.PL
new file mode 100755
index 0000000..a1d6833
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Module::Build;
+
+Module::Build->new(
+
+	build_requires => {
+		'Module::Build' => '0.36',
+		'Test::More' => 0,
+		'Test::Compile' => 0,
+		'Test::Pod' => 0,
+	},
+	module_name => 'App::VRR::Fakedisplay',
+	license => 'perl',
+	requires => {
+		'perl' => '5.10.0',
+	},
+	share_dir => 'share',
+	sign => 1,
+
+)->create_build_script();
diff --git a/cgi/index.pl b/cgi/index.pl
new file mode 100644
index 0000000..90ef4db
--- /dev/null
+++ b/cgi/index.pl
@@ -0,0 +1,156 @@
+#!/usr/bin/env perl
+use Mojolicious::Lite;
+use Cache::File;
+
+use App::VRR::Fakedisplay;
+use Travel::Status::DE::VRR;
+
+our $VERSION = '0.00';
+
+sub get_results_for {
+	my ($city, $stop) = @_;
+
+	my $cache = Cache::File->new(
+		cache_root      => '/tmp/vrr-fake',
+		default_expires => '900 sec',
+	);
+
+	my $results = $cache->thaw("${city} _ ${stop}");
+
+	if ( not $results ) {
+		my $status
+		  = Travel::Status::DE::VRR->new(place => $city, name => $stop);
+		$results = [ [$status->results], $status->errstr ];
+		$cache->freeze( "${city} _ ${stop}", $results );
+	}
+
+	return @{$results};
+}
+
+sub handle_request {
+	my $self    = shift;
+	my $city    = $self->stash('city');
+	my $stop    = $self->stash('stop');
+
+	$self->stash( title      => 'vrr-fakedisplay' );
+	$self->stash( version    => $VERSION );
+
+	$self->render(
+		'main',
+		city       => $city,
+		stop       => $stop,
+		version    => $VERSION,
+		title      => "departures for ${city} ${stop}",
+	);
+}
+
+sub render_image {
+	my $self = shift;
+	my $city = $self->stash('city');
+	my $stop = $self->stash('stop');
+
+	$self->res->headers->content_type('image/png');
+
+	my ($results, $errstr) = get_results_for($city, $stop);
+
+	my $png = App::VRR::Fakedisplay->new();
+	for my $d (@{$results}[0 .. 5]) {
+		$png->draw_at(0, $d->line);
+		$png->draw_at(30, $d->destination);
+		$png->draw_at(180, $d->time);
+		$png->new_line();
+	}
+
+	$self->render(data => $png->png);
+}
+
+get '/_redirect' => sub {
+	my $self    = shift;
+	my $city    = $self->param('city');
+	my $stop    = $self->param('stop');
+
+	$self->redirect_to("/${city}/${stop}");
+};
+
+get '/'                => \&handle_request;
+get '/:city/:stop.png' => \&render_image;
+get '/:city/:stop'     => \&handle_request;
+
+app->start();
+
+__DATA__
+
+@@ main.html.ep
+<!DOCTYPE html>
+<html>
+<head>
+	<title><%= $title %></title>
+	<meta charset="utf-8">
+	<style type="text/css">
+
+	div.about {
+		font-family: Sans-Serif;
+		color: #666666;
+	}
+
+	div.about a {
+		color: #000066;
+	}
+
+	</style>
+</head>
+<body>
+
+% if ($city and $stop) {
+<img src="../../<%= $city %>/<%= $stop %>.png" alt=""/>
+% }
+% else {
+
+<p>
+DB-Fakedisplay displays the next departures at a DB station, just like the big
+LC display in the station itself.
+</p>
+
+% }
+
+<div class="input-field">
+
+<% if (my $error = stash 'error') { %>
+<p>
+  Error: <%= $error %><br/>
+</p>
+<% } %>
+
+<%= form_for _redirect => begin %>
+<p>
+  Station name:
+  <%= text_field 'city' %>
+  <%= text_field 'stop' %>
+  <%= submit_button 'Display' %>
+</p>
+<% end %>
+
+</div>
+
+<div class="about">
+<a href="http://finalrewind.org/projects/db-fakedisplay/">db-fakedisplay</a>
+v<%= $version %>
+</div>
+
+</body>
+</html>
+
+@@ not_found.html.ep
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+	"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+<head>
+	<title>page not found</title>
+	<meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
+</head>
+<body>
+<div>
+page not found
+</div>
+</body>
+</html>
diff --git a/lib/App/VRR/Fakedisplay.pm b/lib/App/VRR/Fakedisplay.pm
new file mode 100644
index 0000000..3912560
--- /dev/null
+++ b/lib/App/VRR/Fakedisplay.pm
@@ -0,0 +1,160 @@
+package App::VRR::Fakedisplay;
+
+use strict;
+use warnings;
+use 5.010;
+
+use File::ShareDir qw(dist_file);
+use GD;
+
+our $VERSION = '0.00';
+
+sub new {
+	my ( $class, %opts ) = @_;
+
+	my $self = {
+		font_file => dist_file( 'App-VRR-Fakedisplay', 'font.png' ),
+		width => 300,
+		height => 50,
+		scale => 10,
+		offset_x => 0,
+		offset_y => 0,
+	};
+
+	$self->{font} = GD::Image->new($self->{font_file});
+	$self->{image} = GD::Image->new($self->{width} * $self->{scale}, $self->{height} * $self->{scale});
+
+	$self->{color}->{bg} = $self->{image}->colorAllocate(0, 0, 0);
+	$self->{color}->{fg} = $self->{image}->colorAllocate(255, 0, 0);
+
+	$self->{image}->filledRectangle(0, 0, ($self->{width} * $self->{scale}) -1,
+	($self->{height} * $self->{scale}) - 1, $self->{color}->{bg});
+
+	$self->{font_idx} = $self->{font}->colorClosest(0, 0, 0);
+
+	return bless( $self, $class );
+}
+
+sub locate_char {
+	my ($self, $char) = @_;
+	my ($x, $y, $w, $h) = (0, 30, 6, 10);
+
+	given ($char) {
+		when (/[a-z]/) { $y = 10; $x = (ord($char) - 97) * 10 }
+		when (/[A-Z]/) { $y =  0; $x = (ord($char) - 65) * 10 }
+		when (/[0-9]/) { $y = 20; $x = (ord($char) - 48) * 10 }
+
+		when (q{ }) { $y = 90; $x =   0 }
+		when (q{:}) { $y = 30; $x =   0 }
+		when (q{-}) { $y = 30; $x =  10 }
+		when (q{.}) { $y = 30; $x =  20 }
+		when (q{,}) { $y = 30, $x =  30 }
+	}
+
+	given ($char) {
+		when (/[WwMm]/) { $w = 8 }
+		when (/[BDEt]/) { $w = 5 }
+		when (/[il]/) { $w = 4 }
+		when (/[:.,]/) { $w = 3 }
+	}
+
+	return ($x, $y, $w, $h);
+}
+
+sub draw_at {
+	my ($self, $offset_x, $text) = @_;
+
+	my $im = $self->{image};
+	my $font = $self->{font};
+
+	my $c_bg = $self->{color}{bg};
+	my $c_fg = $self->{color}{fg};
+
+	my $font_idx = $self->{font_idx};
+
+	my ($off_x, $off_y) = ($offset_x, $self->{offset_y});
+
+	for my $char (split(qr{}, $text)) {
+		my ($x, $y, $w, $h) = $self->locate_char($char);
+		for my $pos_x ( $x .. ($x + $w) ) {
+			for my $pos_y ( $y .. ($y + $h)) {
+				if ($font->getPixel($pos_x, $pos_y) == $font_idx) {
+					$im->filledEllipse(
+						($off_x + $pos_x - $x) * 10, ($off_y + $pos_y - $y) * 10,
+						10, 10,
+						$c_fg
+					);
+				}
+				say "";
+			}
+		}
+		$off_x += $w;
+	}
+
+	return;
+}
+
+sub new_line {
+	my ($self) = @_;
+	$self->{offset_y} += 10;
+
+	return;
+}
+
+sub png {
+	my ($self) = @_;
+
+	return $self->{image}->png;
+}
+
+sub write_image_to {
+	my ($self, $filename) = @_;
+
+	open(my $out_fh, '>', $filename) or die("Cannot open ${filename}: ${!}\n");
+	binmode $out_fh;
+	print $out_fh $self->{image}->png;
+	close($out_fh);
+
+	return;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 VERSION
+
+version
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head1 DEPENDENCIES
+
+=over
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+=head1 SEE ALSO
+
+=head1 AUTHOR
+
+Copyright (C) 2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+  0. You just DO WHAT THE FUCK YOU WANT TO.
diff --git a/share/font.png b/share/font.png
new file mode 100644
index 0000000..fee6637
--- /dev/null
+++ b/share/font.png
author	Daniel Friesel <derf@finalrewind.org>	2011-10-29 02:29:33 +0200
committer	Daniel Friesel <derf@finalrewind.org>	2011-10-29 02:29:33 +0200
commit	ae6fb6a1aa12a52d94bf1f220d75111dff6a54ee (patch)
tree	52bbcbf307f62bdf53eafa5c4b7bbc11701c8c5d