#!/usr/bin/perl
#
# capture a steady stream of video frames, compress it and split it into
# multiple files, for long recording sessions
#
# configure it below
#
use Socket;
use Fcntl;
use Video::Capture::V4l;
use Video::RTjpeg;
use Time::HiRes 'time';
use File::Sync 'sync';
use IPC::SysV;
use POSIX qw(nice WNOHANG);
use IO::Select;
BEGIN { require "linux-dsp-ioctl.ph" }
$|=1;
my $outprefix = "/tmp/vstream";
my $initial_fadein = 40; # initial settle time
my $consec = 25; # push this many frames to each encoder
my $syncfreq = 0.2; # pause this time between syncs
my $vencoders = 8; # number of encoder processes
my(@venc,@enc);
#my ($w, $h, $vformat) = (704, 528, PALETTE_YUV420P);
my ($cw, $ch, $vformat) = (576, 432, PALETTE_YUV420P);
my ($cl, $cr, $ct, $cb) = (16,16, 16,16);
#my ($cw, $ch, $vformat) = (320, 240, PALETTE_YUV420P);
#my ($cl, $cr, $ct, $cb) = (0,0, 0,0);
my $fps = 25;
my $spf = 1/$fps;
my ($x, $y, $w, $h) = ($cl, $ct, $cw-$cr-$cl, $ch-$cb-$ct);
my ($rate, $channels, $aformat) = (44100, 2, &AFMT_S16_LE);
my ($Q, $M) = (255, 0);
my $fsize = $cw*$ch*2;
my $buffers = int(32*1024*1024/$fsize);
my $bufsize = $fsize * $buffers;
my $shm = shmget IPC_PRIVATE, $bufsize, IPC_CREAT|0600;
$shm or die "unable to allocate $bufsize shm segment";
END { shmctl $shm, IPC_RMID, 0 }
$SIG{INT} = sub { exit };
my @buffers = (0..($buffers-1));
my $select = IO::Select->new();
my %cb;
# audio setup
sysopen DSP, "/dev/dsp", O_RDONLY
or sysopen DSP, "/dev/dsp", O_RDONLY
or die "unable to open /dev/dsp for reading: $!";
ioctl DSP, SNDCTL_DSP_SETFRAGMENT, pack "i", 0x7fff000e or die "SNDCTL_DSP_SETFRAGMENT: $!";
ioctl DSP, SNDCTL_DSP_SETFMT, pack "i", $aformat or die "SNDCTL_DSP_SETFMT: $!";
ioctl DSP, SNDCTL_DSP_CHANNELS, pack "i", $channels or die "SNDCTL_DSP_CHANNELS: $!";
ioctl DSP, SNDCTL_DSP_SPEED, pack "i", $rate or die "SNDCTL_DSP_SPEED: $!";
open AUDIO, ">$outprefix.a" or die;
# video setup
$grab = new Video::Capture::V4l
or die "Unable to open Videodevice: $!";
my $channel = $grab->channel (0);
my $tuner = $grab->tuner (0);
$tuner->mode(MODE_PAL);
$channel->norm(MODE_PAL);
$tuner->mode(8);
$tuner->set;
$channel->set;
#$CHANNEL69 = 855250;
#print $grab->freq ($CHANNEL69),"\n";
sub new_vencoder {
my $number = @enc;
my $encp = do { local *ENCODER_WRITER };
my $encc = do { local *ENCODER_READER };
socketpair $encc, $encp, AF_UNIX, SOCK_STREAM, PF_UNSPEC;
$select->add($encp);
$cb[fileno $encp] = sub {
my $buf;
4 == sysread $encp, $buf, 4 or die "unable to read bufferid";
$buf = unpack "N", $buf;
push @buffers, $buf;
};
if (0 == fork) {
open DATA, ">$outprefix.v$number" or die "$!";
my $tables = Video::RTjpeg::init_compress($cw,$ch,$Q);
Video::RTjpeg::init_mcompress();
syswrite DATA, pack "N", length($tables);
syswrite DATA, $tables;
my $buf;
my $count = $number * 313;
for(;;) {
8 == read $encc, $buf, 8 or die "incomplete frame time read: $!";
my ($buffer, $time) = unpack "NN", $buf;
last if $buffer >= $buffers;
shmread $shm, $buf, $buffer*$fsize, $fsize;
syswrite $encc, (pack "N", $buffer);
my $fr = Video::RTjpeg::mcompress($buf,$M,$M>>1, $x, $y, $w, $h);
#my $fr = Video::RTjpeg::compress($buf);
syswrite DATA, pack "NN", $time, length $fr;
syswrite DATA, $fr;
#Video::RTjpeg::fdatasync fileno DATA if ($count++ & 63) == 0;
print "+";
}
print "X";
exit;
}
push @enc, $encp;
}
new_vencoder for 1..$vencoders;
@venc = map (($_)x$consec, @enc);
my $frame = 0;
my $frames = 0;
my $dropped = 0;
sub put_vframe {
my $buffer = pop @buffers;
my $enc = pop @venc;
unshift @venc, $enc;
if (defined $buffer) {
print "-";
shmwrite $shm, ${$_[1]}, $buffer*$fsize, $fsize;
syswrite $enc, (pack "NN", $buffer, $_[0]);
} else {
print "o";
$dropped++;
}
}
my $syncpid = fork;
if ($syncpid==0) {
for(;;) {
select undef, undef, undef, $syncfreq;
print "S";
sync;
}
Video::RTjpeg::_exit;
};
system "rtprio -p $$";
my $fr = \$grab->capture ($frame, $cw, $ch, $vformat);
for(1..$initial_fadein) {
my $nfr = \$grab->capture (1-$frame, $cw, $ch, $vformat);
$grab->sync($frame) or die "unable to sync";
$frame = 1-$frame;
$fr = $nfr;
}
my $start = time;
my $nframe;
$fr = \$grab->capture ($frame, $cw, $ch, $vformat);
my $audpid = fork;
if ($audpid==0) {
my $count = 0;
my $in = ""; vec($in, fileno DSP, 1) = 1;
fcntl DSP, F_SETFL, O_NONBLOCK;
ioctl DSP, SNDCTL_DSP_SETTRIGGER, pack "i", 0;
ioctl DSP, SNDCTL_DSP_SETTRIGGER, pack "i", PCM_ENABLE_INPUT;
for(;;) {
my $buf;
select my $xin = $in, undef, undef, $spf*2;
print ".";
if (0 < sysread DSP, $buf, 128*1024) {
#print length $buf;
syswrite AUDIO, $buf;
}
}
Video::RTjpeg::_exit;
};
my $do_capture = 1;
$select->add(*STDIN);
$cb[fileno STDIN] = sub {
$do_capture = 0;
};
while($do_capture) {
printf "\n%02d:%02d +%2d %2ds %dd > ",
int($nframe*$spf/60), int($nframe*$spf)%60,
scalar@buffers, $frames-$nframe, $dropped
if $frames % $fps == 0;
my $nfr = \$grab->capture (1-$frame, $cw, $ch, $vformat);
$grab->sync($frame) or die "unable to sync";
my $now = time;
$nframe = int (($now-$start) / $spf + 0.5);
$start = $now - $nframe * $spf;
put_vframe($nframe, $fr);
for ($select->can_read(0)) {
$cb[fileno $_]->();
}
$frame = 1-$frame;
$frames++;
$fr = $nfr;
}
open CTRL, ">$outprefix" or die;
print CTRL <<EOF;
\$outprefix = "$outprefix";
\$fps = $fps;
\$spf = $spf;
\$frames = $frames;
\$nframe = $nframe;
\$dropped = $dropped;
\$vencoders = $vencoders;
\$rate = $rate;
\$channels = $channels;
\$aformat = $aformat;
\$w = $w;
\$h = $h;
\$buffers = $buffers;
\$fsize = $fsize;
1;
EOF
close CTRL;
$select->remove(*STDIN);
close DSP;
close AUDIO;
kill 'TERM', $syncpid;
kill 'TERM', $audpid;
for (@enc) {
syswrite $_, (pack "NN", -1, -1);
$select->remove($_);
}
for(;;) {
for ($select->can_read(0)) {
$cb[fileno $_]->();
}
}