#!/usr/bin/perl -w

use strict;
use Data::Dumper;

my %attr;
my $FILE;

my $dv = 4;
my $dt = 3;

sub dv($) {
    my $x = shift;
    int($x/$dv + 0.5);
}

sub show() {
}

my $pi = 2 * atan2(1,0);

sub rad_deg($) { # conversion from radians to degrees (360° = one full turn)
    my $x = shift;
    180 * $x / $pi;
}

sub deg_rad($) { # conversino from degrees to radians
    my $x = shift;
    $x * $pi / 180;
}
sub Acos($) {
    my $x = shift;
    rad_deg(acos($x));
}
sub Asin($) {
    my $x = shift;
    rad_deg(asin($x));
}
sub Sin($) {
    my $x = shift;
    sin(deg_rad($x));
}
sub Cos($) {
    my $x = shift;
    cos(deg_rad($x));
}
sub Tan($) {
    my $x = shift;
    tan(deg_rad($x));
}

#############
my @align = qw/ L L L B C T R R R /;
sub text($) {
    my $attr = shift;

    my $val = "U";
    my $x = 0;
    my $y = 0;
    my $sz = 50;
    my $orient = "H";
    my $vis = "V";
    my $just = "C";
    my $fnt  = "NN";
    if (defined($attr{$attr})) {
	my @arr = @{$attr{$attr}};
	$val = shift @arr;
	if ($attr eq "refdes") {
	    $val =~ s/\?$//;
	} elsif ($attr eq "footprint") {
	    $val =~ s/\.fp$//;
	}
	delete $attr{$attr};
	$x  = dv($arr[1]);
	$y  = dv($arr[2]);
	$sz = $dt*$arr[4];
	$vis = "I" if ($arr[5] == 0);
	my $angle = $arr[7];
	while ($angle >= 180) {
	    $angle -= 180;
	}
	if (270 > $angle && $angle > 45) {
	    $orient = "V";
	}
	#$just = $align[$arr[8]];
    }

    ($val, "$x $y $sz $orient $vis $just $just$fnt");
}

sub mkline($) {
    my $r = shift;
    for my $rr (@$r) {
	my ($N, $x1, $y1, $x2, $y2, $colour, $lw, @rest) = @$rr;
	if ($lw == 0) { $lw = 10; }
	$x1 = dv($x1);
	$x2 = dv($x2);
	$y1 = dv($y1);
	$y2 = dv($y2);
	$lw = dv($lw);
	printf "P 2 0 0 $lw $x1 $y1 $x2 $y2 N\n";
    }
}

sub mkbox($) {
    my $r = shift;
    for my $rr (@$r) {
	my ($N, $llx, $lly, $bw, $bh, $colour, $lw, $cap, $dash, $dl, $ds, $filltype, $fillw, $a1, $p1, $a2, $p2) = @$rr;
	if ($lw == 0) { $lw = 10; }
	$llx = dv($llx);
	$lly = dv($lly);
	$bw = dv($bw);
	$bh = dv($bh);
	$lw = dv($lw);
	my $urx = $llx + $bw;
	my $ury = $lly + $bh;
	my $fill = "N";
	if ($filltype == 1) { $fill = "F"; }
	elsif ($filltype) { $fill = "f"; }

	printf "S $llx $lly $urx $ury 0 0 $lw $fill\n";
    }
}

sub mkcir($) {
    my $r = shift;
    for my $rr (@$r) {
	my ($N, $xx, $yy, $rr, $colour, $lw, $cap, $dash, $dl, $ds, $filltype, $fillw, $a1, $p1, $a2, $p2) = @$rr;
	if ($lw == 0) { $lw = 10; }
	$xx = dv($xx);
	$yy = dv($yy);
	$rr = dv($rr);
	$lw = dv($lw);
	my $fill = "N";
	if ($filltype == 1) { $fill = "F"; }
	elsif ($filltype) { $fill = "f"; }

	printf "C $xx $yy $rr 0 0 $lw $fill\n";
    }
}

sub mkarc($) {
    my $r = shift;
    for my $rr (@$r) {
	my ($N, $xx, $yy, $rr, $sta, $sweep, $colour, $lw, @rest) = @$rr;
	if ($lw == 0) { $lw = 10; }
	$xx = dv($xx);
	$yy = dv($yy);
	$rr = dv($rr);
	$lw = dv($lw);
	my $end = $sta + $sweep;
	my $xs = int( $xx + $rr * Cos($sta) + 0.5);
	my $xe = int( $xx + $rr * Cos($end) + 0.5);
	my $ys = int( $yy + $rr * Sin($sta) + 0.5);
	my $ye = int( $yy + $rr * Sin($end) + 0.5);

	$sta *= 10;
	$end *= 10;

	printf "A $xx $yy $rr $sta $end 0 0 $lw N $xs $ys $xe $ye\n";
    }
}

sub mkpath($) {
    my $r = shift;
    for my $rr (@$r) {
	my ($pp,$hh) = @$rr;
	my ($N, $colour, $lw, $cap,  $dash, $dl, $ds,  $filltype, $fillw, $a1, $p1, $a2, $p2, $nlines) = @$pp;
	if ($lw == 0) { $lw = 0.001 ; }
	$lw = dv($lw);

	my @line = @$hh;
	my $str = "";
	my $cnt = 0;
	my $sx;
	my $sy;
	for my $line (@line) {
	    $line =~ tr/ \t/ /s;
	    if ($line =~ m/^Z/i) {
		my $fill = "N";
		if ($filltype == 1) { $fill = "F"; }
		elsif ($filltype)   { $fill = "f"; }
		$fill = "N";
		$cnt++; # for final point == starting point
		printf "P $cnt 0 0 $lw   $str  $sx $sy   $fill\n";
		$str = "";
		$cnt = 0;
	    } elsif ($line =~ m/^([ML]) ([-+]?\d+)[, ]([-+]?\d+)$/i) {
		my $tt = $1;
		my $x = dv($2);
		my $y = dv($3);
		if ($tt eq "M") {
		    $sx = $x;
		    $sy = $y;
		}
		$str .= "  $x $y";
		$cnt++;
	    } else {
		warn "$FILE >> H <$line>";
		exit;
	    }
	}
	if ($cnt) {
	    my $fill = "N";
	    if ($filltype == 1) { $fill = "F"; }
	    elsif ($filltype)   { $fill = "f"; }
	    printf "P $cnt 0 0 $lw $str $fill\n";
	    $str = "";
	    $cnt = 0;
	}
    }
}

my %PINTYPE = (
    "in"  => "I",
    "out" => "O",
    "io"  => "B",
    "oc"  => "C",
    "oe"  => "E",
    "pas" => "P",
    "tp"  => "U",
    "tri" => "T",
    "clk" => "U",
    "pwr" => "U",
);

sub mkpins($) {
    my $r = shift;
    for my $rr (@$r) {
	my ($h,$a) = @$rr;
	my %h = @$h;
	my ($N, $x1, $y1, $x2, $y2, $colour, $ppintype, $whichend) = @$a;
	$x1 = dv($x1);
	$x2 = dv($x2);
	$y1 = dv($y1);
	$y2 = dv($y2);
	if ($ppintype != 0) {
	    print "cannot handle bus pins\n";
	    return;
	}

	my $pinlabel = "~"; my $plr;
	if (defined($h{pinlabel})) { ($pinlabel, $plr)  = @{$h{pinlabel}}; }
	my ($pinnumber, $pnr) = @{$h{pinnumber}};
	my ($pinseq, $psr)    = @{$h{pinseq}};
	my ($pintype, $ptr) = ("P", []);
	if (defined($h{pintype})) { ($pintype, $ptr)   = @{$h{pintype}}; }

	$pinlabel =~ tr/ /_/;
	my $shape = "";
	if ($pinlabel =~ m/^\\_(.*)\\_$/) {
	    $pinlabel = $1;
	    $shape = " I";
	}
	my $x = $x1;
	my $y = $y1;
	if ($whichend) {
	    $x = $x2; $y = $y2;
	    $x2 = $x1; $y2 = $y1;
	}
	my $dx = $x2 - $x;
	my $dy = $y2 - $y;
	my $l = sqrt( $dx*$dx + $dy*$dy);
	my $orient = "R";
	if ($dy > abs($dx)) { $orient = "U"; }
	if ($dy < -abs($dx)) { $orient = "D"; }
	if ($dx < 0) { $orient = "L"; }
	my $lsz = 40;
	my $nsz = 40;
	my $type = "P";
	if (defined($PINTYPE{$pintype})) { $type = $PINTYPE{$pintype}; }

	print "X $pinlabel $pinnumber $x $y $l $orient $lsz $nsz 0 0 $type$shape\n";
    }
}

sub per_file($) {
    my $file = shift;
    $FILE = $file;
    %attr = ();
    if ($file =~ m/sym\/(A[34]liggande|arrow)/) {
	return;
    }

    open(FH, $file) || return;
    {
	my $str = <FH>;
	if ($str =~ m/^v 20\d{6} \d+$/) {
	    # ok
	} else {
	    printf STDERR "not a symbol file <$file>\n";
	    return;
	}
    }

    my $Tcnt = 0;
    my $Hcnt = 0;
    my @L;
    #my @G;
    my @B;
    my @V;
    my @A;
    my @T;
    my @P;
    my @pp;
    my %pt;
    my @H;
    my @hh;
    my %pattr;
    my $plvl = 0;

    while (<FH>) {
	chomp;

	my @fld = split;

	if ($plvl) {
	    if (m/^\{/) {
		$plvl = 2;
		%pt = ();
		next;
	    } elsif (m/^\}/) {
		$plvl = 0;
		push @P, [ [%pt], [@pp] ];
		next;
	    } elsif ($plvl != 2) {
		print "P $plvl error <$_>\n";
		return;
	    }

	    if ($fld[0] eq "T") { # text + lines
		$Tcnt = $fld[9];
		next;
	    } elsif ($Tcnt) {
		$Tcnt--;
		if (m/^([a-z]+)=(.*)$/) {
		    my $key = $1;
		    my $value = $2;
		    $pt{$key} = [ $value, @fld ];
		    next;
		} else {
		    # just text
		    print "warn fallthrough in P/T <$_>\n";
		    next;
		}
	    }
	    print "warn fallthrough in P <$_>\n";
	} elsif ($Tcnt) {
	    $Tcnt--;
	    if (m/^([a-z]+)=(.*)$/) {
		my $key = $1;
		my $value = $2;
		$attr{$key} = [ $value, @{$T[$#T]} ];
	    } else {
		# just text
	    }
	} elsif ($Hcnt) {
	    $Hcnt--;
	    chomp;
	    push @hh, $_;
	    if ($Hcnt == 0) {
		push @H, [ \@pp, \@hh ];
	    }

	} elsif ($fld[0] eq "F") { # font
	    warn "In font files only: Font";
	    return;

	} elsif ($fld[0] eq "N") { # net
	    warn "In schematics only: Net";
	    return;
	} elsif ($fld[0] eq "U") { # bus
	    warn "In schematics only: Bus";
	    return;
	} elsif ($fld[0] eq "C") { # component
	    warn "In schematics only: Component";
	    return;

	} elsif ($fld[0] eq "G") { # picture + lines
	    warn "Picture";
	    return;

	} elsif ($fld[0] eq "T") { # text + lines
	    push @T, [ @fld ];
	    $Tcnt = $fld[9];
	} elsif ($fld[0] eq "P") { # pin
	    # in sym files only
	    $plvl = 1;
	    @pp = @fld;
	} elsif ($fld[0] eq "H") { # path + lines
	    @pp = @fld;
	    @hh = ();
	    $Hcnt = $fld[13];

	} elsif ($fld[0] eq "L") { # line
	    push @L, [ @fld ];
	} elsif ($fld[0] eq "B") { # box
	    push @B, [ @fld ];
	} elsif ($fld[0] eq "V") { # circle
	    push @V, [ @fld ];
	} elsif ($fld[0] eq "A") { # arc
	    push @A, [ @fld ];
	} else {
	    print "warn fallthrough <$_>\n";
	}
    }
    close(FH);

    # make component output
    if (defined($attr{source})) {
	return;
    }

    {
	#
	my $name = $file;
	$name =~ s/\.sym$//;
	$name =~ s|.*/||;
	print "#\n";
	print "# $name\n";
	print "#\n";
	my ($val, $text ) = text("refdes");
	printf "DEF $name $val 0 30 Y Y 1 F N\n";
	# no aliases

	## fields
	printf "%s \"%s\" %s\n", "F0", $val, $text;
	my $dtext = $text;
	($val, $text ) = text("value");
	if ($val) { printf "%s \"%s\" %s\n", "F1", $name, $text; }
	else      { printf "%s \"%s\" %s\n", "F1", $name, $dtext; }
	($val, $text ) = text("footprint");
	if ($val) { printf "%s \"%s\" %s\n", "F2", $val, $text; }
	else      { printf "%s \"%s\" %s\n", "F2", "", $dtext; }
	($val, $text ) = text("documentation");
	if ($val) {
	    $val =~ s/"//g;
	    printf "%s \"%s\" %s\n", "F3", $val, $text;
	}
	my $ix = 4;
	for my $k (sort keys %attr) {
	    ($val, $text ) = text($k);
	    if ($val) { printf "F$ix \"$val\" $text \"$k\"\n"; }
	    $ix++;
	}

	printf "DRAW\n";
	mkline(\@L);
	mkbox(\@B);
	mkcir(\@V);
	mkarc(\@A);
	mkpins(\@P);
	#mkpath(\@H);
	printf "ENDDRAW\n";
	printf "ENDDEF\n";
    }

    return;
}

sub Usage($) {
    my $str = shift;

    if ($str) {
	print $str;
	print "\n";
    }

    print
"Usage:
\tsym2kical.pl files...
";
    if ($str) {
	exit 1;
    }
    exit 0;
}

sub main() {
    printf "EESchema-LIBRARY Version 2.3\n";
    printf "#encoding utf-8\n";
    for my $file (@ARGV) {
	per_file($file);
    }
    printf "# End Library\n";
}

main();

__END__