in reply to Re^2: Help Please: FCS Binary 2 ASCII conversion
in thread Help Please: FCS Binary 2 ASCII conversion
sysread( FCS, my $data, $eData - $sData ) or die $!;
The start- and end-of data offsets are inclusive. Therefore to read the whole section you need $eData - $sData +1.
This is a regex meta-character, which means the split to construct the hash:
my %text = split $delim, $text;
Screws up. The solution is to quotemeta the delimiter read from the first character of the TEXT section just in case:
my %text = split quotemeta( $delim ), $text;
This means that only the first 12 bits of the 16-bit values should be considered. And that once the data has been unpacked, it must be masked to 12 bits to ensure that you don't get out-of-range values from picking up "stray bits" in the upper 4-bits.
It would be a bloody-minded data supplier that would pack 12-bit data in to 16-bit words without ensuring the up 4-bits are zeroed, but according to the specification he isn't obliged to do so. And their example demonstrates this.
I've added thise code to deal with that:
if( $text{ '$DATATYPE' } eq 'I' and defined $text{ '$P1R' } ) { my $mask = $text{ '$P1R' } - 1; $_ &= $mask for @data; }
my $par = $text{ '$PAR' }; for( my $i = 0; $i < @data; $i += $par ) { print join ' ', @data[ $i .. $i + $par - 1 ]; }
my %tmpls = ( '1,2,3,4' => { I => { 16 => 'v*', 32 => 'V*' }, F => { 32 => 'f<*' }, D => { 64 => 'd<*' }, }, '4,3,2,1' => { I => { 16 => 'n*', 32 => 'N*' }, F => { 32 => 'f>*' }, D => { 64 => 'd>*' }, }, );
Three TEXT section key/value pairs identify the format of the binary data in the DATA section.
Other byteordering are apparently possible!
There is also an 'A' datatype I haven't attempted to cater for. Though it doesn't look too hard to do.
This seems to be mostly for the 'I' datatype. 64-bit integers is a possibility. The datastructure makes it easy to cater for that.
All of this information is in the spec! Other formats that I haven't catered for in my example are possible.
I use the %tmpls structure to map those three values to an appropriate unpack template:
my $tmpl = $tmpls{ $text{ '$BYTEORD' } } { $text{ '$DATATYPE' } } { $text{ '$P1B' } };
You should work through the specs, and work out what each of those key/value pairs is, and how you should be using them.
Anyway, here's a modified version that incorporates the corrections outlined above, that handles both supplied samples.
But it is still only example code intended to give you a starting point from which to progress!
#! perl -slw use strict; use Data::Dump qw[ pp ]; my %tmpls = ( '1,2,3,4' => { I => { 16 => 'v*', 32 => 'V*' }, F => { 32 => 'f<*' }, D => { 64 => 'd<*' }, }, '4,3,2,1' => { I => { 16 => 'n*', 32 => 'N*' }, F => { 32 => 'f>*' }, D => { 64 => 'd>*' }, }, ); open FCS, '<:raw', 'c:\downloaded\FCSExtract-TestData\FloatData4031.fcs' # 'c:\downloaded\FCSExtract-TestData\CC4_067_BM.fcs' or die $!; sysread( FCS, my $header, 58 ) or die $!; my( $id, $sText, $eText, $sData, $eData, $sAnalysis, $eAnalysis ) = unpack 'A6 x4 (A8)6', $header; sysseek FCS, $sText, 0 or die $!; sysread( FCS, my $text, $eText - $sText ) or die $!; my $delim = substr $text, 0, 1, ''; my %text = split quotemeta( $delim ), $text; pp \%text; <>; sysseek FCS, $sData, 0 or die $!; sysread( FCS, my $data, $eData - $sData +1 ) or die $!; my $tmpl = $tmpls{ $text{ '$BYTEORD' } }{ $text{ '$DATATYPE' } }{ $tex +t{ '$P1B' } }; die 'Can\'t handle format' unless $tmpl; my @data = unpack $tmpl, $data; if( $text{ '$DATATYPE' } eq 'I' and defined $text{ '$P1R' } ) { my $mask = $text{ '$P1R' } - 1; $_ &= $mask for @data; } my $par = $text{ '$PAR' }; for( my $i = 0; $i < @data; $i += $par ) { print join ' ', @data[ $i .. $i + $par - 1 ]; }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^4: Help Please: FCS Binary 2 ASCII conversion
by david_lyon (Sexton) on Apr 13, 2010 at 03:19 UTC | |
by BrowserUk (Patriarch) on Apr 13, 2010 at 03:23 UTC | |
by david_lyon (Sexton) on Apr 13, 2010 at 03:50 UTC | |
by BrowserUk (Patriarch) on Apr 13, 2010 at 04:01 UTC | |
by david_lyon (Sexton) on Apr 13, 2010 at 04:11 UTC | |
|