browse-ttx.pl

#!/usr/bin/perl -w
#
#  Small level 2.5 teletext browser
#
#  Copyright (C) 2007,2020 Tom Zoerner
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#

# Description:
#
#   This script is an example for the use of classes Video::ZVBI::page and
#   Video::ZVBI::export for rendering teletext pages. The script captures
#   teletext from a given device and renders selected teletext pages in a
#   simple GUI using TkInter.

use strict;
use blib;
use Getopt::Long;
use IO::Handle;
use Tk;
use Video::ZVBI qw(/^VBI_/);

my $pxc;
my $cap;
my $vtdec;
my $dec_entry = 100;
my $pg_disp = -1;
my $pg_sched = 0x100;
my $pg_lab = "Page ###.##";

my $tk;
my $canvas;
my $img_xpm;
my $font = ['courier', -12];
my $mode_xpm = 1;
my $redraw;

my $opt_device = "/dev/dvb/adapter0/demux0";
my $opt_pid = 0;  # mandatory for DVB
my $opt_v4l2 = 0;
my $opt_verbose = 0;
my $opt_help = 0;

#
# This callback is invoked by the teletext decoder for every ompleted page.
# The function updates the page number display on top of the window and
# updates the display if the scheduled page has been captured.
#
sub pg_handler {
   my($type, $ev, $user_data) = @_;

   $pg_lab = sprintf "Page %03x.%02x ", $ev->{pgno}, $ev->{subno} & 0xFF;

   if ($ev->{pgno} == $pg_sched) {
      $redraw = 1;
   }
}

#
# This function is called every 10ms to capture VBI data.
# VBI frames are sliced and forwarded to the teletext decoder.
#
sub cap_frame {
   my $sliced;
   my $timestamp;
   my $n_lines;
   my $res;

   $res = $cap->pull_sliced($sliced, $n_lines, $timestamp, 50);

   if ($res > 0) {
      $vtdec->decode($sliced, $n_lines, $timestamp);
   }
   elsif ($res < 0) {
      warn "Capture error: $!\n";
   }

   if ($redraw) {
      pg_display();
      $redraw = 0;
   }
}

#
# This function is called once during start-up to initialize the
# device capture context and the teletext decoder
#
sub cap_init {
   my $err;

   if ($opt_v4l2 || (($opt_pid == 0) && ($opt_device !~ /dvb/))) {
      my $opt_buf_count = 5;
      my $opt_services = VBI_SLICED_TELETEXT_B;
      my $opt_strict = 0;

      $pxc = Video::ZVBI::proxy::create($opt_device, $0, 0, $err, $opt_verbose);
      if (defined $pxc) {
         $cap = Video::ZVBI::capture::proxy_new($pxc, 5, 0, $opt_services, $opt_strict, $err);
         undef $pxc unless defined $cap;
      }
      if (!defined $cap) {
         $cap = Video::ZVBI::capture::v4l2_new($opt_device, $opt_buf_count, $opt_services, $opt_strict, $err, $opt_verbose);
      }
      if (!defined $cap) {
         $cap = Video::ZVBI::capture::v4l_new($opt_device, 0, $opt_services, $opt_strict, $err, $opt_verbose);
      }
      if (!defined $cap) {
         $cap = Video::ZVBI::capture::bktr_new($opt_device, 0, $opt_services, $opt_strict, $err, $opt_verbose);
      }
   }
   else {
      warn "WARNING: DVB devices require --pid parameter\n" if $opt_pid <= 0;
      $cap = Video::ZVBI::capture::dvb_new2($opt_device, $opt_pid, $err, $opt_verbose);
   }
   die "Failed to open video device: $err\n" unless $cap;

   $vtdec = Video::ZVBI::vt::decoder_new();
   die "failed to create teletext decoder\n" unless defined $vtdec;

   $vtdec->event_handler_add(VBI_EVENT_TTX_PAGE, \&pg_handler); 

   # install a Tk event handler for capturing in the background
   my $io = new IO::Handle;
   $io->fdopen($cap->fd(), 'r');
   $tk->fileevent($io, 'readable', \&cap_frame);
}

#
# This function is invoked out of the capture event handler when the page
# which is scheduled for display has been captured.
#
sub pg_display_xpm {
   my $pg = $vtdec->fetch_vt_page($pg_sched, 0, VBI_WST_LEVEL_3p5, 25, 1);
   if (defined $pg) {
      my ($h, $w) = $pg->get_page_size();

      # export page in XPM format (only supported starting with 0.2.26)
      my $err;
      my $ex = Video::ZVBI::export::new('xpm', $err);
      if (defined $ex) {
         # suppress all XPM extensions because Pixmap can't handle them
         $ex->option_set('creator', "") or die;
         $ex->option_set('titled', 0) or die;
         $ex->option_set('transparency', 0) or die;
         my $tmp = $ex->alloc($pg);
         $img_xpm = $tk->Pixmap(-data, $tmp);

      } else {
         my $fmt;
         # conversion of 8-bit palette image format into XPM is faster, so prefer that if supported
         if (Video::ZVBI::check_lib_version(0,2,26)) {
            $fmt = VBI_PIXFMT_PAL8;
         } else {
            $fmt = VBI_PIXFMT_RGBA32_LE;
         }
         my $img_canvas = $pg->draw_vt_page($fmt);
         undef $img_xpm;
         $img_xpm = $tk->Pixmap(-data, $pg->canvas_to_xpm($img_canvas, $fmt, 1));
      }

      $canvas->delete('all');
      $canvas->createImage(0, 0, -anchor, 'nw', -image, $img_xpm);
      $canvas->configure(-width, $img_xpm->width(), -height, $img_xpm->height());
      $pg_disp = $pg_sched;
   }
}

sub vbi_rgba {
   sprintf "#%02X%02X%02X", $_[0]&0xff, ($_[0]>>8)&0xff, ($_[0]>>16)&0xff;
}
sub pg_display_text {
   my $pg = $vtdec->fetch_vt_page($pg_sched, 0, VBI_WST_LEVEL_3p5, 25, 1);
   if (defined $pg) {
      $canvas->delete('all');
      my ($rows, $columns) = $pg->get_page_size();
      my $pal = $pg->get_page_color_map();
      my $text = $pg->get_page_text();
      my $prop = $pg->get_page_text_properties();
      my $fh = $canvas->fontMetrics($font, -linespace);
      my $fw = $canvas->fontMeasure($font, '0');
      my $i = 0;
      for (my $row = 0; $row < $rows; $row++) {
         for (my $col = 0; $col < $columns; $col++, $i++) {
            my $pp = $prop->[$i];
            $canvas->createRectangle($col * $fw, $row * $fh,
                                     ($col+1) * $fw, ($row+1) * $fh,
                                     -outline, undef,
                                     -fill, vbi_rgba($pal->[($pp>>8) & 0xFF]));
            $canvas->createText($col * $fw, $row * $fh,
                                -text, substr($text, $i, 1),
                                -anchor, 'nw', -font, $font,
                                -fill, vbi_rgba($pal->[$pp & 0xFF]));
         }
      }
      $canvas->configure(-width, $columns * $fw, -height, $rows * $fh);
      $pg_disp = $pg_sched;
   }
}

sub pg_display {
   if ($mode_xpm) {
      pg_display_xpm();
   } else {
      pg_display_text();
   }
}

#
# This callback is invoked when the user clicks into the teletext page.
# If there's a page number of FLOF link under the mouse pointer, the
# respective page is scheduled for display.
#
sub pg_link {
   my ($wid, $x, $y) = @_;

   if ($pg_disp != -1) {
      my $pg = $vtdec->fetch_vt_page($pg_disp, VBI_ANY_SUBNO, VBI_WST_LEVEL_1p5, 25, 1);
      my $fh;
      my $fw;
      if (defined $pg) {
         if ($mode_xpm) {
            # note: char width 12, char height 10*2 due to scaling in XPM conversion
            $fh = 20;
            $fw = 12;
         } else {
            $fh = $canvas->fontMetrics($font, -linespace);
            $fw = $canvas->fontMeasure($font, '0');
         }

         my $h = $pg->resolve_link($x / $fw, $y / $fh);
         if ($h->{type} == VBI_LINK_PAGE) {
            $pg_sched = $h->{pgno};
            $dec_entry = sprintf "%03X", $pg_sched;
            $redraw = 1;
         }
      }
   }
}

#
# This callback is invoked when the user hits the left/right buttons
# (actually this is redundant to the +/- buttons in the spinbox)
#
sub pg_plus_minus {
   my ($off) = @_;

   if ($off >= 0) {
      $off = 1;
   } else {
      $off = 0xF9999999;
   }
   $pg_sched = Video::ZVBI::add_bcd($pg_sched, $off);
   $pg_sched = 0x899 if $pg_sched < 0x100;
   $dec_entry = sprintf "%03X", $pg_sched;
   $redraw = 1;
}

#
# This callback is invoked when the user edits the page number
#
sub pg_change {
   if ($dec_entry =~ /^\d+$/) {
      $pg_sched = Video::ZVBI::dec2bcd($dec_entry);
      $redraw = 1;
   }
}

#
# This callback is invoked when the user hits the "TOP" button
# to display the TOP page table
#
sub pg_top_index {
   $pg_sched = 0x900;
   $dec_entry = 900;
   $redraw = 1;
}

#
# This function is called once during start-up to create the GUI.
#
sub gui_init {
   $tk = MainWindow->new();
   $tk->title('Teletext Level 2.5 Demo');
   $tk->resizable(0, 0);

   # frame holding control widgets at the top of the window
   my $wid_f1 = $tk->Frame();
   my $wid_f1_sp = $wid_f1->Spinbox(-from, 100, -to, 899, -width, 5,
                                    -textvariable, \$dec_entry,
                                    -command, \&pg_change);
   $wid_f1_sp->bind('<Return>', \&pg_change);
   $wid_f1_sp->pack(-side, "left", -anchor, "w");
   my $wid_f1_lab = $wid_f1->Label(-textvariable, \$pg_lab);
   $wid_f1_lab->pack(-side, "left",);
   $wid_f1->pack(-side, "top", -fill, "x");
   my $wid_f1_but1 = $wid_f1->Button(-text, "<<", -command, [\&pg_plus_minus, -1], -padx, 1);
   my $wid_f1_but2 = $wid_f1->Button(-text, ">>", -command, [\&pg_plus_minus, 1], -padx, 1);
   my $wid_f1_but3 = $wid_f1->Button(-text, "TOP", -command, [\&pg_top_index], -padx, 1);
   $wid_f1_but1->pack(-side, "left", -anchor, "e");
   $wid_f1_but2->pack(-side, "left", -anchor, "e");
   $wid_f1_but3->pack(-side, "left", -anchor, "e");
   my $wid_f1_mode = $wid_f1->Checkbutton(-variable, \$mode_xpm, -text, "XPM",
                                          -command, sub {$redraw = 1;});
   $wid_f1_mode->pack(-side, "left", -anchor, "e");

   # button to display the teletext page as image
   $canvas = $tk->Canvas(-borderwidth, 0, -relief, 'flat', -background, '#000000');
   $canvas->bindtags([$canvas, 'all']);
   $canvas->Tk::bind('<Key-q>', sub {exit;});
   $canvas->Tk::bind('<Button-1>', [\&pg_link, Ev('x'), Ev('y')]);
   $canvas->pack(-fill, 'both');
   $canvas->focus();

   $redraw = 0;
}

sub usage {
        print STDERR "\
Teletext browser GUI demo\
Copyright (C) 2007,2020 T. Zoerner\
This program is licensed under GPL 2 or later. NO WARRANTIES.\n\
Usage: $0 [OPTIONS]\n\
--device PATH     Specify the capture device\
--pid NNN         Specify the PES stream PID: Required for DVB\
--v4l2            Force device to be addressed via analog driver\
--verbose         Emit debug trace output\
--help            Print this message and exit\
";
  exit(1);
}
my %CmdOpts = (
        "device=s" =>  \$opt_device,
        "pid=i" =>     \$opt_pid,
        "v4l2" =>      \$opt_v4l2,
        "verbose" =>   \$opt_verbose,
        "help" =>      \$opt_help,
);
GetOptions(%CmdOpts) || usage();
usage() if $opt_help;
die "Options --v4l2 and --pid are mutually exclusive\n" if $opt_v4l2 && $opt_pid;

# create & display GUI
gui_init();

# start capturing teletext
cap_init();

# everything from here on is event driven
MainLoop();