#!/usr/bin/perl -w
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
;
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);
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
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
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
;
}
sub
draw {
if
(
defined
$_
[0]) {
return
if
(
$draw_count
== 0);
$draw_count
--
if
(
$draw_count
> 0);
$raw1
=
$_
[0];
}
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
);
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
;
}
}
draw_dec(
$nchars
)
unless
$found
;
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"
);
}
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
;
foreach
(
$canvas
->find(
'overlapping'
, 0,
$src_h
+ 1,
$src_w
,
$src_h
+ 1 +
$dst_h
*2)) {
$canvas
->
delete
(
$_
);
}
my
$x
=0;
while
(
$x
<
$src_w
) {
$canvas
->createLine(
$x
,
$src_h
+ 10,
$x
,
$src_h
+ 12+
$dst_h
, -fill,
'#AAAAAA'
);
$x
+= 10;
}
$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;});
$canvas
->Tk::
bind
(
'<Return>'
,
sub
{
$draw_count
= -1;});
$canvas
->bindtags([
$canvas
,
'all'
]);
$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
;
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) {
}
else
{
die
"Unexpected capture result code $r\n"
;
}
draw(
$raw2
);
}
my
%CmdOpts
= (
"device=s"
=> \
$option_dev_name
,
"ignore-error"
=> \
$option_ignore_error
,
"ntsc"
=> \
$option_ntsc
,
"pal"
=> \
$option_pal
,
"v4l"
=> \
$option_v4l
,
"v4l2-read"
=> \
$option_v4l2_read
,
"v4l2-mmap"
=> \
$option_v4l2_mmap
,
"proxy"
=> \
$option_proxy
,
"verbose+"
=> \
$option_verbose
,
);
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,
$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
) {
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"
;
}
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) {
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();
my
$io
= new IO::Handle;
$io
->fdopen(
$cap
->fd(),
'r'
);
$tk
->fileevent(
$io
,
'readable'
, \
&cap_frame
);
MainLoop();
}
main_func();