#!/usr/bin/perl -w

use strict;
use utf8;
use open ':encoding(utf8)';

binmode(STDOUT, ":encoding(UTF-8)");

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

my $line;
sub chkstr_line($@) {
    my $str = shift;
    $line = <>;
    chomp $line;
    $line =~ s/[ \t]*$//;

    for my $m (@_) {
	if ($line =~ m/^$m$/) {
	    return $m;
	}
    }
    print STDERR "A ", $str, " line may only contain: ^(", join("|", @_), ")\$\n";
    print STDERR "<$line>\n";
    exit(1);
}

# 1st line in file denotes fig version
#$line = <>;
chkstr_line("version", "#FIG 3\.2.*");
my $orientation = chkstr_line("orientation", "Landscape", "Portrait");
chkstr_line("justification", "Center", "Flush left");
my $units = chkstr_line("units", "Metric", "Inches");
my $paper = chkstr_line("papersize", "Letter", "Legal", "Ledger", "Tabloid", "A", "B", "C", "D", "E", "A4", "A3", "A2", "A1", "A0", "B5");
$line = <>; # float   magnification           (export and print magnification, %)
chkstr_line("multiple-page", "Single", "Multiple");
$line = <>; # int transparent color
$line = <>; # optional comment or int resolution coord_system
if ($line =~ m/^#/) {
    $line = <>; # int resolution coord_system
}
chomp $line;
my ($resolution, $csys) = split(/[ \t]+/, $line);
#print $line, "\n";
#print $res, "\n";

my %paper;
sub mk_paper() {
    my $ix;
    my $sqr2 = sqrt(2);
    my $k = sqrt($sqr2);
    my $w = 1000 * $k;
    my $h = $w / $sqr2;
    for ($ix = 0; $ix < 5; $ix++) {
	$paper{"A$ix"} = [ int($w+0.5), int($h+0.5) ];
	my $hn = $w / 2;
	$w = $h;
	$h = $hn;
    }
};
mk_paper;
sub show_paper() {
    my $ix;
    for $ix (sort keys %paper) {
	my $r = $paper{$ix};
	my $h = $$r[0];
	my $w = $$r[1];
	print "$ix: $h $w\n";
    }
    exit(0);
}
#show_paper;
my @bbox;
{
    my $rpaper = $paper{$paper};
    if (!defined($rpaper)) {
	print STDERR "TODO: specify paper size for $paper\n";
	exit(1);
    }
    @bbox = @$rpaper; # in mm
}
if ($orientation eq "Portrait") {
    @bbox = ($bbox[1], $bbox[0]);
}

# TODO: there is a scale thing when using Metric in xfig
# Note: in xfig, the y-axis is going down, in gschem i is going up, $maxy is to correct that
my $maxy = $bbox[1];
if ($units eq "Metric") {
    $maxy *= 45;
} else {
    $maxy *= $resolution / 25.4; # NOT TESTED
}

my $scale = 4;
my @fontalign = ( 0, 3, 6 ); # maps xfig:sub_type to gschem:alignment

##############################

print "v 20111231 2\n";

my $state = 0;
my @fld;
my @data;
while (<>) {
    chomp;

    if ($state == 0) {
	if      (m/^2 /) { # polyline
	    @fld = split;
	    if (@fld != 16) {
		print STDERR "wrong number of fields (!= 16) in polyline: <$_>\n";
		exit(1);
	    }
	    $state = 2;
	    @data = ();
	} elsif (m/^4 /) { # text
	    @fld = split(/[ \t]+/, $_, 14);
	    if (@fld != 14) {
		print STDERR "wrong number of fields (!= 14) in text: <$_>\n";
		exit(1);
	    }
	    my $subtype = $fontalign[$fld[1]];
	    my $fs = $scale * $fld[6];
	    my $angle = int( 360 * $fld[7] / $twopi + 0.5);
	    my $x = int($scale * $fld[11] + 0.5);
	    my $y = int($scale * ( $maxy - $fld[12]) + 0.5);
	    my $str = $fld[13];
	    $str =~ s/\\001$//;
	    $str =~ s/\\304/Ä/;
	    print "T $x $y 3 $fs  1 1 $angle $subtype 1\n";
	    print "$str\n";
	}
    } elsif ($state == 2) {
	if ($fld[13]) {
	    $fld[13] = 0; # TODO: handle forward_arrow
	} elsif ($fld[14]) {
	    $fld[14] = 0; # TODO: handle backward_arrow
	} else {
	    my $cnt = $fld[15];
	    push @data, split;
	    if (@data > 2 * $cnt) {
		print STDERR "\@data = ", @data+0, " \$fld\[14\] = ", $cnt, "\n";
		print join(" | ", @fld), "\n";
		print "  ", join(" / ", @data), "\n";
		exit(1);
	    } elsif (@data == 2 * $cnt) {
		my $ix;
		$state = 0;
		if ($fld[1] != 1) { # TODO: handle other things than polyline
		    print STDERR "TODO: handle this\n";
		}
		for ($ix = 0; $ix < 2*$cnt; $ix += 2) {
		    $data[$ix]  *= $scale;
		    $data[$ix+1] =  $scale * ($maxy - $data[$ix+1]);
		}
		# xfig: 1/80" (screen output) or 1/160" (postscript, bitmap), gschem: 1/1000"
		my $thickness = int( $scale * 6.25 * $fld[3] + 0.5);

		if (@data == 2) { # a point ??
		    print STDERR "not a line\n";
		    print join(" | ", @fld), "\n";
		    print "  ", join(" / ", @data), "\n";
		    exit(1);
		} elsif (@data == 4) { # a line
		    print "L ", join(" ", @data), "  3 ", $thickness," 2 0 -1 -1\n";
		} else { # a polyline
		    print "H 3 ", $thickness ," 2 0 -1 -1 0 -1 -1 -1 -1 -1 ", $cnt, "\n";
		    my $x;
		    my $y;

		    $x = shift @data;
		    $y = shift @data;
		    print "M $x $y\n";
		    while (@data > 0) {
			$x = shift @data;
			$y = shift @data;
			print "L $x $y\n";
		    }
		    #print "z\n";
		}
	    }
	}
    }
}