PoC: timetable generation

lib/App/FrameUtils.pm

+package FrameUtils;
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+BEGIN
+{
+    unshift @INC, '.';
+}
+
+use App::Utils;
+
+sub get_syubetsu
+{
+    my %frame = %{ $_[0] };
+    my $index = $_[1];
+
+    if ($index >= scalar @{ $frame{'syubetsu'} }) { die "Index error"; }
+    return %{ @{ $frame{'syubetsu'} }[$index] }{'name'};
+}
+
+sub get_ekimei
+{
+    my %frame = %{ $_[0] };
+    my $eki = $_[1];
+
+    if ($eki >= $frame{'eki_num'}) { die "Index error" };
+    return @{ $frame{'eki'} }[$eki];
+}
+
+sub get_destination
+{
+    my %frame = %{ $_[0] };
+    my @jikoku = @{ $_[1] };
+    my $offset = $_[2];
+    my $is_down = $_[3];
+
+    return get_ekimei \%frame, $is_down
+	? scalar $offset + @jikoku - 1
+	: $frame{'eki_num'} - $offset - @jikoku;
+}
+
+sub hassya_hyou
+{
+    my %frame = %{ $_[0] };
+    my $eki = $_[1];
+
+    if ($eki >= $frame{'eki_num'}) { die "Index error" };
+    print "Timetable for station @{ $frame{'eki'} }[$eki]\n";
+
+    sub process_ressya_list
+    {
+	my @ressyas = @{ $_[0] };
+	my $is_down = $_[2];
+	my $target_absolute = $_[1];
+	my $target_relative = $is_down
+	    ? $target_absolute
+	    : $frame{'eki_num'} - $target_absolute - 1;
+	
+	foreach my $ressya (@ressyas)
+	{
+	    my %data = %{ $ressya };
+	    my @jikoku = @{ $data{'jikoku'} };
+	    my $pos = 0;
+	    while ($pos != $target_relative) { shift @jikoku; $pos++; }
+	    if (!defined $jikoku[0]) { next; }
+	    
+	    my %ts = %{ $jikoku[0] };
+	    my $time = $ts{'hatsu'};
+	    if (!defined $time) { next; }
+	    # Format: time (tab) destination (tab) type (with eventual name)
+	    my $syubetsu = get_syubetsu \%frame, $data{'syubetsu'};
+	    print ((Utils::format_time $time)
+		   . "\tfor "
+		   . (get_destination \%frame, \@jikoku, $target_relative, $is_down)
+		   . "\t$syubetsu"
+		);
+	    if (defined $data{'meisyo'})
+	    {
+		print " $data{'meisyo'}";
+	    }
+	    print "\n";
+	}
+	print "\n";
+    }
+
+    print "=================== Down ===================\n";
+    process_ressya_list \@{ $frame{'dia'}{'kudari'} }, $eki, 1;
+    print "==================== Up ====================\n";
+    process_ressya_list \@{ $frame{'dia'}{'nobori'} }, $eki, 0;
+}
+
+1;

lib/App/Utils.pm

+package Utils;
+
+use strict;
+use warnings;
+
+sub format_time
+{
+    my $time = $_[0];
+    return sprintf "%02d:%02d", ($time / 100), (substr $time, -2);
+}
+
+1;

src/oud2_parser.pl

@@ -28,6 +28,7 @@ use File::BOM;
 use App::Ts;
 use App::Ressya;
 use App::Frame;
+use App::FrameUtils;
 use App::Dia;
 
 
@@ -169,7 +170,7 @@ TS_TIMESTAMP		::= TS_TIMESTAMP_STRUCT COMMA
 TS_TIMESTAMP_STRUCT   	::= TS_TIMESTAMP_WITHT
 			    action => ::first
 			 || TS_TIMESTAMP_NOT
-			    action => Dia::hash_of_ts_not
+			    action => ::first
 TS_TIMESTAMP_WITHT	::=
     # Simple pass
     TS_MODE TS_SEP_PLATFORM TS_INT
@@ -225,7 +226,7 @@ my $recce = Marpa::R2::Scanless::R->new(
 
 #$diag->read(\$input);
 
-try { print $recce->read(\$contents); }
+try { print $recce->read(\$contents) . ' bytes read.'; }
 catch ($e) { print "Malformation in .oud file.\n$e\n" }
 print "\n";
 
@@ -234,4 +235,6 @@ Frame::frame_info \%frame;
 # my $r = $frame{'dia'}{'nobori'}[0];
 # print Ressya::kukan $r;
 
+FrameUtils::hassya_hyou \%frame, 11;
+
 close $diah;