#!/usr/bin/perl -w
#
# libzvbi test
#
# Copyright (C) 2000-2002, 2004 Michael H. Schimek
# Copyright (C) 2003 James Mastros
# Perl Port: Copyright (C) 2007 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.
#
# Perl $Id: osc.pl,v 1.1 2007/11/18 18:48:35 tom Exp tom $
# libzvbi #Id: osc.c,v 1.29 2006/10/08 06:19:48 mschimek Exp #
use blib;
use strict;
use Tk;
use Video::ZVBI qw(/^VBI_/);
my $option_dev_name = "/dev/vbi0";
my $option_ignore_error = 0;
my $option_ntsc = 0;
my $option_pal = 0;
my $option_sim = 0;
my $option_v4l = 0;
my $option_v4l2_read = 0;
my $option_v4l2_mmap = 1;
my $option_proxy = 0;
my $option_verbose = 0;
my $cap;
my $par;
my $rawdec;
my $pxc;
my $src_w;
my $src_h;
my $dst_h = 64;
my $raw1;
my $tk;
my $canvas;
my $pgm;
my $canvas_pgm;
my $canvas_lid;
my $dec_text;
my $draw_row = 0;
my $draw_count = -1;
my $cur_x;
my $cur_y;
# from capture.c
sub PIL {
my ($day, $mon, $hour, $min) = @_;
((($day) << 15) + (($mon) << 11) + (($hour) << 6) + (($min) << 0));
}
sub decode_ttx {
my ($buf) = @_;
my $packet_address = Video::ZVBI::unham16p ($buf);
return "" if ($packet_address < 0); # hamming error
my $magazine = $packet_address & 7;
my $packet = $packet_address >> 3;
my $text = sprintf "pg %x%02d >", $magazine, $packet;
Video::ZVBI::unpar_str ($buf);
$buf =~ s#[\x00-\x1F\x7F]#.#g;
return $text . substr($buf, 0, 42) . "<";
}
sub dump_pil {
my($pil) = @_;
my $day = $pil >> 15;
my $mon = ($pil >> 11) & 0xF;
my $hour = ($pil >> 6) & 0x1F;
my $min = $pil & 0x3F;
my $text;
if ($pil == PIL(0, 15, 31, 63)) {
$text = " PDC: Timer-control (no PDC)";
} elsif ($pil == PIL(0, 15, 30, 63)) {
$text = " PDC: Recording inhibit/terminate";
} elsif ($pil == PIL(0, 15, 29, 63)) {
$text = " PDC: Interruption";
} elsif ($pil == PIL(0, 15, 28, 63)) {
$text = " PDC: Continue";
} elsif ($pil == PIL(31, 15, 31, 63)) {
$text = " PDC: No time";
} else {
$text = sprintf " PDC: %05x, 200X-%02d-%02d %02d:%02d",
$pil, $mon, $day, $hour, $min;
}
return $text;
}
my $pr_label = "";
my $label = " " x 16;
my $label_off = 0;
sub decode_vps {
my ($buf) = @_;
my @ord = unpack "C15", $buf;
my $text = "VPS: ";
my $c = Video::ZVBI::rev8 ($ord[1]);
if ($c & 0x80) {
$pr_label = substr($label, 0, $label_off);
$label_off = 0;
}
my $cp = $c & 0x7F;
$cp =~ s#[\x00-\x1F\x7F]#.#g;
substr($label, $label_off, 1) = pack "C", $cp;
$label_off = ($label_off + 1) % 16;
$text .= sprintf " 3-10: %02x %02x %02x %02x %02x %02x %02x %02x (\"%s\") ",
$ord[0], $ord[1], $ord[2], $ord[3], $ord[4], $ord[5], $ord[6], $ord[7],
$pr_label;
my $pcs = $ord[2] >> 6;
my $cni = + (($ord[10] & 3) << 10)
+ (($ord[11] & 0xC0) << 2)
+ (($ord[8] & 0xC0) << 0)
+ ($ord[11] & 0x3F);
my $pil = (($ord[8] & 0x3F) << 14) + ($ord[9] << 6) + ($ord[10] >> 2);
my $pty = $ord[12];
$text .= sprintf " CNI: %04x PCS: %d PTY: %d ", $cni, $pcs, $pty;
$text .= dump_pil($pil);
return $text;
}
# End from capture.c
sub draw {
if (defined $_[0]) {
# new frame available - handling freeze & single-stepping counter
return if ($draw_count == 0);
$draw_count-- if ($draw_count > 0);
# store a copy of the raw data (to allow navigating during freeze)
$raw1 = $_[0];
}
# display raw data as gray-scale image
draw_pgm();
if (($draw_row =~ /^\d+$/) && ($draw_row >= 0) && ($draw_row < $src_h)) {
my $field = ($draw_row >= $par->{count_a});
my $phys_line;
my $nchars;
if ((($field == 0) ? $par->{start_a} : $par->{start_b}) < 0) {
$nchars = sprintf "Row %d Line ? - ", $draw_row;
$phys_line = -1;
} elsif ($field == 0) {
$phys_line = $draw_row + $par->{start_a};
$nchars = sprintf "Row %d Line %d - ", $draw_row, $phys_line;
} else {
$phys_line = $draw_row - $par->{count_a} + $par->{start_b};
$nchars = sprintf "Row %d Line %d - ", $draw_row, $phys_line;
}
my $sliced;
my $slines = $rawdec->decode($raw1, $sliced);
# search the selected physical line in the slicer output
my $found = 0;
for (my $six = 0; $six < $slines; $six++) {
my ($sld, $slid, $slin) = Video::ZVBI::get_sliced_line($sliced, $six);
if ($slin == $phys_line) {
draw_dec($nchars, $sld, $slid, $slin);
$found = 1;
last;
}
}
# display decoder output
draw_dec($nchars) unless $found;
# plot that line
draw_plot($draw_row);
}
}
sub draw_pgm {
my $pgm_str = "P5\n$src_w $src_h\n255\n" . $raw1;
open X, ">raw.pgm";
syswrite X, $pgm_str;
close X;
$pgm->read("raw.pgm");
#$button->configure(-image, $pgm);
}
sub draw_dec {
my ($nchars, $sld, $slid, $slin) = @_;
my $buf;
my $i;
if (defined $sld) {
if ($slid & VBI_SLICED_TELETEXT_B) {
$nchars .= decode_ttx($sld);
} elsif ($slid & VBI_SLICED_VPS) {
$nchars .= decode_vps($sld);
} elsif ($slid & (VBI_SLICED_CAPTION_625 | VBI_SLICED_CAPTION_525)) {
$nchars .= "Closed Caption";
} else {
$nchars .= sprintf "Sliced service 0x%X", $slid;
}
} else {
$nchars .= "Unknown signal";
}
$dec_text = $nchars;
}
sub draw_plot {
my $start = $src_w * $draw_row;
my $h0 = $src_h + $dst_h - unpack("x$start C1", $raw1) / 256;
my @Poly = ();
my $h;
my $r = $src_h + 10 + $dst_h;
my $i = 0;
foreach $h (unpack("x$start C$src_w", $raw1)) {
push @Poly, $i++, ($r - $h *$dst_h/256);
$h0 = $h;
}
$canvas->coords($canvas_lid, @Poly);
}
sub resize_window {
my ($self, $w, $h) = @_;
$dst_h = $h - ($src_h + 10);
$dst_h = $src_h if $dst_h < $src_h;
# remove old grid
foreach ($canvas->find('overlapping', 0, $src_h + 1,
$src_w, $src_h + 1 + $dst_h*2)) {
$canvas->delete($_);
}
# paint grid in the new size
my $x=0;
while ($x < $src_w) {
$canvas->createLine($x, $src_h + 10, $x, $src_h + 12+$dst_h, -fill, '#AAAAAA');
$x += 10;
}
# create plot element
$canvas_lid = $canvas->createLine(0, $src_h+$dst_h, 0, $src_h+$dst_h, -fill, '#ffffff');
}
sub init_window {
$tk = MainWindow->new();
$tk->title('Raw capture & plot');
$canvas = $tk->Canvas(-borderwidth, 1, -relief, 'sunken', -background, '#000000',
-height, $src_h + 10 + $dst_h, -width, 640,
-scrollregion, [0, 0, $src_w, $src_h]);
$canvas->pack(-side, 'top', -fill, 'x', -expand, 1);
my $csb = $tk->Scrollbar(-orient, 'horizontal', -takefocus, 0, -width, 10, -borderwidth, 1,
-command, [xview => $canvas]);
$canvas->configure(-xscrollcommand, [set => $csb]);
$csb->pack(-side, 'top', -fill, 'x');
$canvas->pack(-side, 'top', -fill, 'both', -expand, 1);
$canvas->Tk::bind('<Configure>', [\&resize_window, Ev('w'), Ev('h')]);
$canvas->Tk::bind('<q>', sub {exit});
$canvas->Tk::bind('<Down>', sub {if ($draw_row+1<$src_h){$draw_row += 1;} Tk->break});
$canvas->Tk::bind('<Up>', sub {if ($draw_row>0){$draw_row -= 1;} Tk->break});
$canvas->Tk::bind('<space>', sub {$draw_count = 1;}); # single-stepping
$canvas->Tk::bind('<Return>', sub {$draw_count = -1;}); # live capture
$canvas->bindtags([$canvas, 'all']); # remove widget default bindings
$canvas->focus();
my $label = $tk->Entry(-textvariable, \$dec_text, -font, ['courier', -12],
-takefocus, 0, -width, 50);
$label->pack(-side, 'top', -fill, 'x', -anchor, 'w');
my $f = $tk->Frame();
my $f_c = $f->Checkbutton(-text, 'Live capture',
-offvalue, 1, -onvalue, -1, -variable, \$draw_count);
my $f_l = $f->Label(-text, "Plot row:");
my $f_s = $f->Spinbox(-from, 0, -to, $src_h - 1, -width, 5,
-textvariable, \$draw_row, -command, sub {draw()});
$f_c->pack(-side, 'left', -padx, 10, -pady, 5);
$f_l->pack(-side, 'left', -padx, 5);
$f_s->pack(-side, 'left', -padx, 5, -pady, 5);
$f->pack(-side, 'top', -anchor, 'w');
$pgm = $tk->Photo();
$canvas_pgm = $canvas->createImage(0, 0, -image, $pgm, -anchor, 'nw');
}
sub cap_frame {
my $timestamp;
my $raw2;
# note: must use "read" and not "pull" since a copy of the data is kept in "raw1"
my $r = $cap->read_raw($raw2, $timestamp, 100);
if ($r == -1) {
warn "VBI read error: $!\n";
next if $option_ignore_error;
exit(-1);
} elsif ($r == 0) {
warn "VBI read timeout\n";
next if $option_ignore_error || defined $pxc;
exit(-1);
} elsif ($r == 1) {
# ok
} else {
die "Unexpected capture result code $r\n";
}
draw($raw2);
#printf "raw: %f; sliced: %d\n", $timestamp, $slines;
}
#static const char short_options[] = "123cd:enpsv";
my %CmdOpts = (
"device=s" => \$option_dev_name, # 'd'
"ignore-error" => \$option_ignore_error, # 'e'
"ntsc" => \$option_ntsc, # 'n'
"pal" => \$option_pal, # 'p'
"v4l" => \$option_v4l, # '1'
"v4l2-read" => \$option_v4l2_read, # '2'
"v4l2-mmap" => \$option_v4l2_mmap, # '3'
"proxy" => \$option_proxy, # '4'
"verbose+" => \$option_verbose, # 'v'
);
sub main_func {
my $errstr;
my $scanning = 625;
my $verbose = 0;
my $interface = 0;
my $c;
my $index;
GetOptions(%CmdOpts) || die "Invalid command line options\n";
if ($option_ntsc) {
$scanning = 525;
} elsif ($option_pal) {
$scanning = 625;
}
my $services = VBI_SLICED_VBI_525 | VBI_SLICED_VBI_625
| VBI_SLICED_TELETEXT_B | VBI_SLICED_CAPTION_525
| VBI_SLICED_CAPTION_625 | VBI_SLICED_VPS
| VBI_SLICED_WSS_625 | VBI_SLICED_WSS_CPR1204;
my $strict = 0;
while(1) {
if ($option_v4l2_read || $option_v4l2_mmap) {
$cap = Video::ZVBI::capture::v4l2_new ($option_dev_name,
5, #/* buffers */ 5,
$services,
$strict,
$errstr,
$option_verbose);
last if defined $cap;
warn "Cannot capture vbi data with v4l2 interface:\n$errstr\n";
}
if ($option_v4l < 2) {
$cap = Video::ZVBI::capture::v4l_new ($option_dev_name,
$scanning,
$services,
$strict,
$errstr,
$option_verbose);
last if defined $cap;
warn "Cannot capture vbi data with v4l interface:\n$errstr\n";
}
if ($option_proxy) {
$pxc = Video::ZVBI::proxy::create($option_dev_name, "capture", 0,
$errstr, $option_verbose);
if (defined $pxc) {
# strip non-raw services, else request for raw is masked out
my $sv = $services & (VBI_SLICED_VBI_525 |
VBI_SLICED_VBI_625);
$cap = Video::ZVBI::capture::proxy_new($pxc, 5, 0, $sv,
$strict, $errstr );
last if defined $cap;
warn "Cannot capture vbi data ".
"through proxy:\n$errstr\n";
}
warn "Cannot initialize proxy\n$errstr\n";
}
# BSD interface */
if (1) {
$cap = Video::ZVBI::capture::bktr_new ($option_dev_name,
$scanning,
$services,
$strict,
$errstr,
$option_verbose);
last if defined $cap;
warn "Cannot capture vbi data ".
"with bktr interface:\n$errstr\n";
}
exit -1;
}
$rawdec = Video::ZVBI::rawdec::new($cap);
die unless defined $rawdec;
$rawdec->add_services($services, $strict) or die;
$par = $cap->parameters();
die unless defined $par;
if ($option_verbose > 1) {
#vbi_capture_set_log_fp ($cap, stderr);
set_log_on_stderr(0);
}
die unless $par->{sampling_format} == VBI_PIXFMT_YUV420;
$src_w = $par->{bytes_per_line};
$src_h = $par->{count_a} + $par->{count_b};
init_window();
# 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);
# everything from here on is event driven
MainLoop();
}
main_func();