1#!/usr/bin/env perl
2# $Id: lib_form.pl,v 1.3 2002/09/14 21:07:03 euske Exp $
3#
4# lib_form.pl - form handling (form_*.pl)
5#
6#	2002/2, by 1@2ch
7#	* public domain *
8#
9
10# define_form($): construct a form a given text.
11# disp_form(@args): display the form (used in disp_* tools)
12# make_form($file, @args): dump the form (used in make_* tools)
13
14
15require 'lib_util.pl';
16
17sub define_form($) {
18    foreach $_ (split("\n", $_[0])) {
19	my $c;
20	$c = $1 if (s/(\#.*)$//);
21	split(/\s+/);
22	if (2 <= @_) {
23	    push(@form_fields, $_[1]);
24	    push(@form_comments, $c);
25	    $_[1] =~ tr/A-Z/a-z/;
26	    $form_types{$_[1]} = $_[0];
27	}
28    }
29    1;
30}
31
32sub disp_form(@) {
33    my $ff = shift(@_);
34    ropen($ff);
35    %form_val = ();
36    for(my $i = 0; $i < @form_fields; $i++) {
37	my $f = $form_fields[$i];
38	$f =~ tr/A-Z/a-z/;
39	my $t = $form_types{$f};
40	my $v;
41	if ($t eq 'uint8') {
42	    $v = ruint8();
43	} elsif ($t eq 'uint16' || $t eq 'ufword') {
44	    $v =  ruint16();
45	} elsif ($t eq 'sint16' || $t eq 'fword') {
46	    $v = rsint16();
47	} elsif ($t eq 'bits16') {
48	    $v = sprintf("0x%04lx", ruint16());
49	} elsif ($t eq 'uint32' || $t eq 'fixed') {
50	    $v = sprintf("0x%08lx", ruint32());
51	} elsif ($t eq 'str32') {
52	    $v = rstr32();
53	} elsif ($t eq 'uint64') {
54	    $v = sprintf("0x%08lx 0x%08lx", ruint32(), ruint32());
55	} else {
56	    print STDERR "disp_form: unknown type: $f ($t)\n";
57	}
58	$form_val{$f} = $v;
59    }
60    if (0 == @_) {
61	for(my $i = 0; $i < @form_fields; $i++) {
62	    my $f = $form_fields[$i];
63	    $f =~ tr/A-Z/a-z/;
64	    print "$form_fields[$i]\t$form_val{$f}\t$form_comments[$i]\n";
65	}
66    } else {
67	foreach my $f (@_) {
68	    $f =~ tr/A-Z/a-z/;
69	    print $form_val{$f},"\n";
70	}
71    }
72    rclose();
73}
74
75sub make_field1(@) {
76    my ($f, $arg1, $arg2) = @_;
77    $f =~ tr/A-Z/a-z/;
78    my $t = $form_types{$f};
79    #print "$f, $t, $arg1\n";
80    if ($t eq 'uint8') {
81	$form_val{$f} = pack('C', eval($arg1));
82    } elsif ($t eq 'uint16' || $t eq 'ufword') {
83	$form_val{$f} = substr(pack('n', eval($arg1)), 0, 2);
84    } elsif ($t eq 'sint16' || $t eq 'fword' || $t eq 'bits16') {
85	$arg1 += 65536 if ($arg1 < 0);
86	$form_val{$f} = substr(pack('n', eval($arg1)), 0, 2);
87    } elsif ($t eq 'uint32' || $t eq 'fixed') {
88	$form_val{$f} = pack('N', eval($arg1));
89    } elsif ($t eq 'str32') {
90	$form_val{$f} = substr($arg1, 0, 4);
91    } elsif ($t eq 'uint64') {
92	$form_val{$f} = pack('N', eval($arg1)) . pack('N', eval($arg2));
93    } else {
94	print STDERR "make_form: warining: unknown type: $f ($t)\n";
95    }
96}
97
98sub make_form($@) {
99    my $ff = shift(@_);
100    @extra = @_;
101    open(IN, $ff) || die("open: $ff: $!");
102    %form_val = ();
103    while($_ = getline(IN)) {
104	split(/\s+/);
105	next if (@_ < 2);
106	make_field1(@_);
107    }
108    close(IN);
109    foreach my $x (@extra) {
110	$x =~ /^(\w+)=(.+)$/;
111	@args = split(/\s+/, $2);
112	make_field1($1, @args);
113    }
114    foreach my $f (@form_fields) {
115	$f =~ tr/A-Z/a-z/;
116	die "make_form: $ff: '$f' lacks" if ($form_val{$f} eq '');
117    }
118    wopen('&STDOUT');
119    foreach my $f (@form_fields) {
120	wstrn($form_val{$f});
121    }
122    wclose();
123}
124
1251;
126