Root/old-boom/annotate

1#!/usr/bin/perl
2
3require "parser.pl";
4require "misc.pl";
5
6
7$H = 50; # character height
8$W = $H*0.9; # character width
9$L = $H+20; # line skip
10
11
12sub normalize
13{
14    my @t = @_;
15
16    # convert from (x0, y0, w, h) to (x0, y0, x1, y1)
17    $t[2] += $t[0];
18    $t[3] = $t[1]-$t[3];
19    return ($t[0], $t[3], $t[2], $t[1]);
20}
21
22
23#
24# 2x2 matrix inversion
25# http://en.wikipedia.org/wiki/Invertible_matrix#Inversion_of_2.C3.972_matrices
26#
27
28sub invert
29{
30    my @m = @_;
31    my $f = 1/($m[0]*$m[3]-$m[1]*$m[2]);
32    return ($f*$m[3], -$f*$m[1], -$f*$m[2], $f*$m[0]);
33}
34
35
36sub block
37{
38    my @t = &normalize(@_);
39    push(@block, [ @t ]);
40    $wnl .= "Wire Notes Line\n\t$t[0] $t[1] $t[2] $t[3]\n";
41}
42
43
44sub pass
45{
46    my @t = &normalize(@_);
47
48    for (@block) {
49    my @b = @{ $_ };
50    next if $t[0] > $b[2];
51    next if $t[2] < $b[0];
52    next if $t[1] > $b[3];
53    next if $t[3] < $b[1];
54    return 0;
55    }
56    return 1;
57}
58
59
60sub put
61{
62    local ($x0, $y0, $ref, @s) = @_;
63
64    my $h = @s*$L;
65    my $w = 0;
66    for (@s) {
67    my $t = $W*length $_;
68    $w = $t if $t > $w;
69    }
70    my $a = 270;
71    my $r = 100;
72    my $x, $y;
73    my $ym = $y0-$h+$H/2;
74    for ($i = 0; $i != 128; $i++) {
75    $x = int($x0+$r*cos($a/180*3.14159));
76    $y = int($ym+$r*sin($a/180*3.14159));
77    last if &pass($x, $y, $w, $h);
78    $a += 22.5;
79    $r += $L/8;
80    }
81    warn "no place found for \"$s[0]\"" if $i == 128;
82
83    my @m = &invert( @{ $m{$ref} });
84    &block($x, $y+$H/2, $w, $h);
85    my $n = 10;
86    for my $s (reverse @s) {
87    my $dx = $x-$x0;
88    my $dy = $y-$y0;
89    my $sx = $x0+$dx*$m[0]+$dy*$m[1];
90    my $sy = $y0+$dx*$m[2]+$dy*$m[3];
91    ($hv, $hj, $vj) = ("H", "L", "C") if $m[0] == 1;
92    ($hv, $hj, $vj) = ("H", "R", "C") if $m[0] == -1;
93    ($hv, $hj, $vj) = ("V", "C", "B") if $m[1] == 1;
94    ($hv, $hj, $vj) = ("V", "C", "T") if $m[1] == -1;
95    $s =~ s/~/-/g;
96    print "F $n \"$s\" $hv $sx $sy $H 0000 $hj ${vj}NN\n";
97    $y -= $L;
98    $n++;
99    }
100}
101
102
103sub dsc_parts
104{
105    local ($ref) = @_;
106    my @p = @{ $parts{$ref} };
107    my @f = ();
108    while (@p) {
109    my @id = splice(@p, 0, 2);
110    my $id = "$id[0] $id[1]";
111    my $dsc = &dsc_find($id);
112    push(@f, &dsc) if defined $dsc;
113    }
114    return @f;
115}
116
117
118sub dsc_order
119{
120    local ($ref) = @_;
121    my @f = ();
122    for my $id (keys %order) {
123    my @p = @{ $order{$id} };
124    for (splice(@p, 3)) {
125        push(@f, &dsc_find($id)) if $_ eq $ref;
126    }
127    }
128    return @f;
129}
130
131
132sub usage
133{
134    print STDERR "usage: $0 [-s/from/to/ ...] ...\n";
135    exit(1);
136}
137
138
139while ($ARGV[0] =~ /^-s/) {
140    &usage unless &dsc_xlat_arg($');
141    shift @ARGV;
142}
143&usage if $ARGV[0] =~ /^-./;
144
145&parse;
146
147
148#
149# pass 1: find the orientation of all parts
150#
151
152for (@eeschema) {
153    $ref = $1 if /^L \S+ (\S+)/;
154    undef $ref if /^\$EndComp/;
155    next unless /^\s+(-?[01])\s+(-?[01])\s+(-?[01])\s+(-?[01])\s*$/;
156    my @m = split(/\s+/);
157    shift @m;
158    $m{$ref} = [ @m ];
159}
160
161
162#
163# pass 2: block the spaces occupied by fields
164#
165
166for (@eeschema) {
167    $ref = $1 if /^L \S+ (\S+)/;
168    if (/^P (\d+) (\d+)/) {
169    $x0 = $1;
170    $y0 = $2;
171    }
172    next unless /^F /;
173    die "$_" unless
174      /^F \d+ "([^"]*)" ([HV]) (\d+) (\d+) (\d+) +(\d+) ([LC]) (C)/;
175    ($s, $hv, $x, $y, $size, $flag, $hj, $vj) =
176      ($1, $2, $3, $4, $5, $6, $7, $8);
177    $dx = $x-$x0;
178    $dy = $y-$y0;
179    $x = $x0+$dx*$m{$ref}[0]+$dy*$m{$ref}[1];
180    $y = $y0+$dx*$m{$ref}[2]+$dy*$m{$ref}[3];
181    next if $flag != 0;
182    $w = $size*0.8*length $s;
183    # we don't need to consider H/V
184    &block($hj eq "L" ? $x : $x-$w/2, $y+$size/2, $w, $size);
185}
186
187#
188# pass 3:
189#
190
191for (@eeschema) {
192    undef @f if /^\$Comp/;
193    if (/^L \S+ (\S+)/) {
194    $ref = $1;
195    push(@f, &dsc_order($ref)) if %order;
196    push(@f, &dsc_parts($ref)) if %parts;
197    }
198    if (/^P (\d+) (\d+)/) {
199    $x = $1;
200    $y = $2;
201    }
202    if (/^\s+/) {
203    my %seen;
204    my @u = ();
205    for (@f) {
206        next if $seen{$_};
207        push(@u, $_);
208        $seen{$_} = 1;
209    }
210    undef @f;
211    # $m{$ref}[0] == 1 OK
212    # $m{$ref}[0] == -1 OK
213    # $m{$ref}[1] == 1 OK
214    # $m{$ref}[1] == -1 OK (small deviations found)
215    &put($x, $y, $ref, @u) if 1 || $m{$ref}[1] == -1;
216    }
217    if (/\$EndSCHEMATC/) {
218    # uncomment for debugging
219# print $wnl;
220    }
221    print "$_\n";
222}
223

Archive Download this file

Branches:
master



interactive