summaryrefslogtreecommitdiff
path: root/n/avr/proto/protodec
blob: 7a290045cf117808a0d7b30f5c36677654dccb30 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
#!/usr/bin/perl -w
use strict;

sub syntax
{
    print <<EOF;
$0 - D�codeur de protocol s�rie pour le robot.
Syntaxe : $0 code [colonnes] [code [colonnes] ...
Exemple : $0 l 1 2u 3-4 m 1-2.8
d�code pour les codes l et m. Pour l, d�code la premi�re colonne en 8 bits, la
deuxi�me en 8 bits non sign�s, les troisi�me et quatri�me en 16 bits. Pour m,
d�code la premi�re et deuxi�me en 16 bits, virgule fixe � 8 bits derri�re la
virgule.
EOF
    exit 1;
}

sub cvhexu
{
    my $h = join '', @_;
    return hex $h;
}

sub cvhex
{
    my $h = cvhexu @_;
    my $b = 8 * scalar @_;
    if ($h >= 2 ** ($b - 1)) {
	return -(2 ** $b - $h);
    } else {
	return $h;
    }
}

sub prcmd
{
    my ($cmd, $c, @v) = @_;
    return unless exists $$cmd{$c};
    print $c;
    for (@{$$cmd{$c}})
    {
	/^(\d+)-(\d+)(?:\.(\d+))?(u?)$/o;
	my $fp = 0;
	$fp = $3 if $3;
	if ($4 eq 'u') {
	    print ' ', (cvhexu @v[$1 - 1 .. $2 - 1]) / (1 << $fp);
	} else {
	    print ' ', (cvhex @v[$1 - 1 .. $2 - 1]) / (1 << $fp);
	}
    }
    print "\n";
};

my %cmd;
my ($acmd, @acmdl);

while ($_ = shift)
{
    /^[a-zA-Z]$/ and do {
	$cmd{$acmd} = [ @acmdl ] if defined $acmd;
	@acmdl = ();
	$acmd = $_;
	next;
    };
    /^(\d+)(\.\d+)?(u?)$/ and do {
	syntax if !defined $acmd;
	push @acmdl, "$1-$1$2";
	next;
    };
    /^(\d+)-(\d+)(\.\d+)?(u?)$/ and do {
	syntax if !defined $acmd;
	syntax if $2 <= $1;
	push @acmdl, $_;
	next;
    };
    syntax;
}
$cmd{$acmd} = [ @acmdl ] if defined $acmd;

syntax if !scalar %cmd;

while (<>)
{
    chomp;
    if (/^!([a-zA-Z])(?:[a-f0-9]{2})*$/o)
    {
	my $c = $1;
	s/^!([a-zA-Z])//;
	my @args = /[a-f0-9]{2}/og;
	prcmd \%cmd, $c, @args;
    }
}