[ViewVC] Annotation of: cvs/Video-Capture-V4l/examples/capture

#!/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 $_]->();
   }
}

Revision:	1.1
Committed:	Fri May 5 20:21:53 2000 UTC (26 years, 4 months ago) by pcg
Branch:	MAIN
CVS Tags:	rel-0_9, rel-0_902, HEAD
Log Message:	Initial check-in
#	User	Rev	Content
1	pcg	1.1	#!/usr/bin/perl
2
3			#
4			# capture a steady stream of video frames, compress it and split it into
5			# multiple files, for long recording sessions
6			#
7			# configure it below
8			#
9
10			use Socket;
11			use Fcntl;
12
13			use Video::Capture::V4l;
14			use Video::RTjpeg;
15			use Time::HiRes 'time';
16
17			use File::Sync 'sync';
18
19			use IPC::SysV;
20			use POSIX qw(nice WNOHANG);
21			use IO::Select;
22
23			BEGIN { require "linux-dsp-ioctl.ph" }
24
25			$\|=1;
26
27			my $outprefix = "/tmp/vstream";
28
29			my $initial_fadein = 40; # initial settle time
30			my $consec = 25; # push this many frames to each encoder
31			my $syncfreq = 0.2; # pause this time between syncs
32			my $vencoders = 8; # number of encoder processes
33			my(@venc,@enc);
34
35			#my ($w, $h, $vformat) = (704, 528, PALETTE_YUV420P);
36
37			my ($cw, $ch, $vformat) = (576, 432, PALETTE_YUV420P);
38			my ($cl, $cr, $ct, $cb) = (16,16, 16,16);
39
40			#my ($cw, $ch, $vformat) = (320, 240, PALETTE_YUV420P);
41			#my ($cl, $cr, $ct, $cb) = (0,0, 0,0);
42
43			my $fps = 25;
44			my $spf = 1/$fps;
45
46			my ($x, $y, $w, $h) = ($cl, $ct, $cw-$cr-$cl, $ch-$cb-$ct);
47
48			my ($rate, $channels, $aformat) = (44100, 2, &AFMT_S16_LE);
49			my ($Q, $M) = (255, 0);
50			my $fsize = $cw$ch2;
51
52			my $buffers = int(3210241024/$fsize);
53			my $bufsize = $fsize * $buffers;
54
55			my $shm = shmget IPC_PRIVATE, $bufsize, IPC_CREAT\|0600;
56			$shm or die "unable to allocate $bufsize shm segment";
57			END { shmctl $shm, IPC_RMID, 0 }
58			$SIG{INT} = sub { exit };
59
60			my @buffers = (0..($buffers-1));
61
62			my $select = IO::Select->new();
63			my %cb;
64
65			# audio setup
66
67			sysopen DSP, "/dev/dsp", O_RDONLY
68			or sysopen DSP, "/dev/dsp", O_RDONLY
69			or die "unable to open /dev/dsp for reading: $!";
70
71			ioctl DSP, SNDCTL_DSP_SETFRAGMENT, pack "i", 0x7fff000e or die "SNDCTL_DSP_SETFRAGMENT: $!";
72			ioctl DSP, SNDCTL_DSP_SETFMT, pack "i", $aformat or die "SNDCTL_DSP_SETFMT: $!";
73			ioctl DSP, SNDCTL_DSP_CHANNELS, pack "i", $channels or die "SNDCTL_DSP_CHANNELS: $!";
74			ioctl DSP, SNDCTL_DSP_SPEED, pack "i", $rate or die "SNDCTL_DSP_SPEED: $!";
75
76			open AUDIO, ">$outprefix.a" or die;
77
78			# video setup
79
80			$grab = new Video::Capture::V4l
81			or die "Unable to open Videodevice: $!";
82
83			my $channel = $grab->channel (0);
84			my $tuner = $grab->tuner (0);
85			$tuner->mode(MODE_PAL);
86			$channel->norm(MODE_PAL);
87			$tuner->mode(8);
88			$tuner->set;
89			$channel->set;
90
91			#$CHANNEL69 = 855250;
92			#print $grab->freq ($CHANNEL69),"\n";
93
94			sub new_vencoder {
95			my $number = @enc;
96			my $encp = do { local *ENCODER_WRITER };
97			my $encc = do { local *ENCODER_READER };
98			socketpair $encc, $encp, AF_UNIX, SOCK_STREAM, PF_UNSPEC;
99			$select->add($encp);
100			$cb[fileno $encp] = sub {
101			my $buf;
102			4 == sysread $encp, $buf, 4 or die "unable to read bufferid";
103			$buf = unpack "N", $buf;
104			push @buffers, $buf;
105			};
106			if (0 == fork) {
107			open DATA, ">$outprefix.v$number" or die "$!";
108
109			my $tables = Video::RTjpeg::init_compress($cw,$ch,$Q);
110			Video::RTjpeg::init_mcompress();
111
112			syswrite DATA, pack "N", length($tables);
113			syswrite DATA, $tables;
114
115			my $buf;
116			my $count = $number * 313;
117			for(;;) {
118			8 == read $encc, $buf, 8 or die "incomplete frame time read: $!";
119			my ($buffer, $time) = unpack "NN", $buf;
120			last if $buffer >= $buffers;
121			shmread $shm, $buf, $buffer*$fsize, $fsize;
122			syswrite $encc, (pack "N", $buffer);
123			my $fr = Video::RTjpeg::mcompress($buf,$M,$M>>1, $x, $y, $w, $h);
124			#my $fr = Video::RTjpeg::compress($buf);
125			syswrite DATA, pack "NN", $time, length $fr;
126			syswrite DATA, $fr;
127
128			#Video::RTjpeg::fdatasync fileno DATA if ($count++ & 63) == 0;
129			print "+";
130			}
131			print "X";
132			exit;
133			}
134			push @enc, $encp;
135			}
136
137			new_vencoder for 1..$vencoders;
138
139			@venc = map (($_)x$consec, @enc);
140
141			my $frame = 0;
142			my $frames = 0;
143			my $dropped = 0;
144
145			sub put_vframe {
146			my $buffer = pop @buffers;
147			my $enc = pop @venc;
148			unshift @venc, $enc;
149			if (defined $buffer) {
150			print "-";
151			shmwrite $shm, ${$_[1]}, $buffer*$fsize, $fsize;
152			syswrite $enc, (pack "NN", $buffer, $_[0]);
153			} else {
154			print "o";
155			$dropped++;
156			}
157			}
158
159			my $syncpid = fork;
160			if ($syncpid==0) {
161			for(;;) {
162			select undef, undef, undef, $syncfreq;
163			print "S";
164			sync;
165			}
166			Video::RTjpeg::_exit;
167			};
168
169			system "rtprio -p $$";
170
171			my $fr = \$grab->capture ($frame, $cw, $ch, $vformat);
172			for(1..$initial_fadein) {
173			my $nfr = \$grab->capture (1-$frame, $cw, $ch, $vformat);
174			$grab->sync($frame) or die "unable to sync";
175			$frame = 1-$frame;
176			$fr = $nfr;
177			}
178
179			my $start = time;
180			my $nframe;
181
182			$fr = \$grab->capture ($frame, $cw, $ch, $vformat);
183
184			my $audpid = fork;
185			if ($audpid==0) {
186			my $count = 0;
187			my $in = ""; vec($in, fileno DSP, 1) = 1;
188			fcntl DSP, F_SETFL, O_NONBLOCK;
189			ioctl DSP, SNDCTL_DSP_SETTRIGGER, pack "i", 0;
190			ioctl DSP, SNDCTL_DSP_SETTRIGGER, pack "i", PCM_ENABLE_INPUT;
191			for(;;) {
192			my $buf;
193			select my $xin = $in, undef, undef, $spf*2;
194			print ".";
195			if (0 < sysread DSP, $buf, 128*1024) {
196			#print length $buf;
197			syswrite AUDIO, $buf;
198			}
199			}
200			Video::RTjpeg::_exit;
201			};
202
203			my $do_capture = 1;
204			$select->add(*STDIN);
205			$cb[fileno STDIN] = sub {
206			$do_capture = 0;
207			};
208
209			while($do_capture) {
210			printf "\n%02d:%02d +%2d %2ds %dd > ",
211			int($nframe$spf/60), int($nframe$spf)%60,
212			scalar@buffers, $frames-$nframe, $dropped
213			if $frames % $fps == 0;
214
215			my $nfr = \$grab->capture (1-$frame, $cw, $ch, $vformat);
216			$grab->sync($frame) or die "unable to sync";
217
218			my $now = time;
219			$nframe = int (($now-$start) / $spf + 0.5);
220			$start = $now - $nframe * $spf;
221
222			put_vframe($nframe, $fr);
223
224			for ($select->can_read(0)) {
225			$cb[fileno $_]->();
226			}
227
228			$frame = 1-$frame;
229			$frames++;
230			$fr = $nfr;
231			}
232
233			open CTRL, ">$outprefix" or die;
234			print CTRL <<EOF;
235			\$outprefix = "$outprefix";
236
237			\$fps = $fps;
238			\$spf = $spf;
239
240			\$frames = $frames;
241			\$nframe = $nframe;
242			\$dropped = $dropped;
243			\$vencoders = $vencoders;
244			\$rate = $rate;
245			\$channels = $channels;
246			\$aformat = $aformat;
247			\$w = $w;
248			\$h = $h;
249
250			\$buffers = $buffers;
251			\$fsize = $fsize;
252
253			1;
254			EOF
255			close CTRL;
256
257			$select->remove(*STDIN);
258
259			close DSP;
260			close AUDIO;
261			kill 'TERM', $syncpid;
262			kill 'TERM', $audpid;
263
264			for (@enc) {
265			syswrite $_, (pack "NN", -1, -1);
266			$select->remove($_);
267			}
268
269			for(;;) {
270			for ($select->can_read(0)) {
271			$cb[fileno $_]->();
272			}
273			}
274