eda-tools/old-boom/annotate

#!/usr/bin/perl

require "parser.pl";
require "misc.pl";


$H = 50;	# character height
$W = $H*0.9;	# character width
$L = $H+20;	# line skip


sub normalize
{
    my @t = @_;

    # convert from (x0, y0, w, h) to (x0, y0, x1, y1)
    $t[2] += $t[0];
    $t[3] = $t[1]-$t[3];
    return ($t[0], $t[3], $t[2], $t[1]);
}


#
# 2x2 matrix inversion
# http://en.wikipedia.org/wiki/Invertible_matrix#Inversion_of_2.C3.972_matrices
#

sub invert
{
    my @m = @_;
    my $f = 1/($m[0]*$m[3]-$m[1]*$m[2]);
    return ($f*$m[3], -$f*$m[1], -$f*$m[2], $f*$m[0]);
}


sub block
{
    my @t = &normalize(@_);
    push(@block, [ @t ]);
    $wnl .= "Wire Notes Line\n\t$t[0] $t[1] $t[2] $t[3]\n";
}


sub pass
{
    my @t = &normalize(@_);

    for (@block) {
	my @b = @{ $_ };
	next if $t[0] > $b[2];
	next if $t[2] < $b[0];
	next if $t[1] > $b[3];
	next if $t[3] < $b[1];
	return 0;
    }
    return 1;
}


sub put
{
    local ($x0, $y0, $ref, @s) = @_;

    my $h = @s*$L;
    my $w = 0;
    for (@s) {
	my $t = $W*length $_;
	$w = $t if $t > $w;
    }
    my $a = 270;
    my $r = 100;
    my $x, $y;
    my $ym = $y0-$h+$H/2;
    for ($i = 0; $i != 128; $i++) {
	$x = int($x0+$r*cos($a/180*3.14159));
	$y = int($ym+$r*sin($a/180*3.14159));
	last if &pass($x, $y, $w, $h);
	$a += 22.5;
	$r += $L/8;
    }
    warn "no place found for \"$s[0]\"" if $i == 128;

    my @m = &invert( @{ $m{$ref} });
    &block($x, $y+$H/2, $w, $h);
    my $n = 10;
    for my $s (reverse @s) {
	my $dx = $x-$x0;
	my $dy = $y-$y0;
	my $sx = $x0+$dx*$m[0]+$dy*$m[1];
	my $sy = $y0+$dx*$m[2]+$dy*$m[3];
	($hv, $hj, $vj) = ("H", "L", "C") if $m[0] == 1;
	($hv, $hj, $vj) = ("H", "R", "C") if $m[0] == -1;
	($hv, $hj, $vj) = ("V", "C", "B") if $m[1] == 1;
	($hv, $hj, $vj) = ("V", "C", "T") if $m[1] == -1;
	$s =~ s/~/-/g;
	print "F $n \"$s\" $hv $sx $sy $H  0000 $hj ${vj}NN\n";
	$y -= $L;
	$n++;
    }
}


sub dsc_parts
{
    local ($ref) = @_;
    my @p = @{ $parts{$ref} };
    my @f = ();
    while (@p) {
	my @id = splice(@p, 0, 2);
	my $id = "$id[0] $id[1]";
	my $dsc = &dsc_find($id);
	push(@f, &dsc) if defined $dsc;
    }
    return @f;
}


sub dsc_order
{
    local ($ref) = @_;
    my @f = ();
    for my $id (keys %order) {
	my @p = @{ $order{$id} };
	for (splice(@p, 3)) {
	    push(@f, &dsc_find($id)) if $_ eq $ref;
	}
    }
    return @f;
}


sub usage
{
    print STDERR "usage: $0 [-s/from/to/ ...] ...\n";
    exit(1);
}


while ($ARGV[0] =~ /^-s/) {
    &usage unless &dsc_xlat_arg($');
    shift @ARGV;
}
&usage if $ARGV[0] =~ /^-./;

&parse;


#
# pass 1: find the orientation of all parts
#

for (@eeschema) {
    $ref = $1 if /^L \S+ (\S+)/;
    undef $ref if /^\$EndComp/;
    next unless /^\s+(-?[01])\s+(-?[01])\s+(-?[01])\s+(-?[01])\s*$/;
    my @m = split(/\s+/);
    shift @m;
    $m{$ref} = [ @m ];
}


#
# pass 2: block the spaces occupied by fields
#

for (@eeschema) {
    $ref = $1 if /^L \S+ (\S+)/;
    if (/^P (\d+) (\d+)/) {
	$x0 = $1;
	$y0 = $2;
    }
    next unless /^F /;
    die "$_" unless
      /^F \d+ "([^"]*)" ([HV]) (\d+) (\d+) (\d+) +(\d+) ([LC]) (C)/;
    ($s, $hv, $x, $y, $size, $flag, $hj, $vj) =
      ($1, $2, $3, $4, $5, $6, $7, $8);
    $dx = $x-$x0;
    $dy = $y-$y0;
    $x = $x0+$dx*$m{$ref}[0]+$dy*$m{$ref}[1];
    $y = $y0+$dx*$m{$ref}[2]+$dy*$m{$ref}[3];
    next if $flag != 0;
    $w = $size*0.8*length $s;
    # we don't need to consider H/V
    &block($hj eq "L" ? $x : $x-$w/2, $y+$size/2, $w, $size);
}

#
# pass 3:
#

for (@eeschema) {
    undef @f if /^\$Comp/;
    if (/^L \S+ (\S+)/) {
	$ref = $1;
	push(@f, &dsc_order($ref)) if %order;
	push(@f, &dsc_parts($ref)) if %parts;
    }
    if (/^P (\d+) (\d+)/) {
	$x = $1;
	$y = $2;
    }
    if (/^\s+/) {
	my %seen;
	my @u = ();
	for (@f) {
	    next if $seen{$_};
	    push(@u, $_);
	    $seen{$_} = 1;
	}
	undef @f;
	# $m{$ref}[0] == 1	OK
	# $m{$ref}[0] == -1	OK
	# $m{$ref}[1] == 1	OK
	# $m{$ref}[1] == -1	OK (small deviations found)
	&put($x, $y, $ref, @u) if 1 || $m{$ref}[1] == -1;
    }
    if (/\$EndSCHEMATC/) {
	# uncomment for debugging
#	print $wnl;
    }
    print "$_\n";
}