#!/usr/bin/perl -w

# Given a gscheme schematic file called 'infile.sch', this script:
#
#   1.  Gropes through it to find all the objects with attribute
#       device=INPUT or device=OUTPUT.  It takes note of the refdes
#       attribute values for these objects.
#
#   2.  Creates a tragesym input file called infile.tragesym st a run
#       of tragesym with this argument will create a symbol with
#       appropriately labeled pins.
#
#   3.  Runs tragesym on infile.tragesym, creating infile.sym.  Note
#       infile.tragesym will still exist as you may want to tweak it
#       by hand and rerun tragesym to get the exact effect desired.
#
#   4.  Adds a source=infile.sch attribute line to the produced
#       infile.sym.
#
# An optional second argument may also be supplied.  If it is, it is
# used as the name to print on the symbol.  If it isn't, the schematic
# file base name is used.  There is a good chance the file base name
# will be way too long to fit well with the symbol.
#
# WARNING: this script is based on me looking at the example gTAG
# project that came with gEDA as of early 2007.  I don't really fully
# understand the file format I'm claiming to be parsing.  Its up to
# you to make sure you have nets for ground, power, etc. in the
# schematic being symbolized if you don't want to make those things
# explicit inputs or outputs.  YMMV.

use strict;

use File::Basename;

@ARGV == 1 or @ARGV == 2 or die "wrong number of arguments";

my $schematic = $ARGV[0];

$schematic =~ m/^(.*)\.sch$/
    or die "input file name doesn't seem to have a '.sch' extension";

my $tragesym_file = "$1.tragesym";
my $symbol_file = "$1.sym";

# Determine the name to use on the symbol.
my $symbol_name;
if ( @ARGV == 2 ) {
    $symbol_name = $ARGV[1];
}
else {
    $symbol_name = $1;
}

open(SCHEMATIC, "<$schematic")
    or die "failed to open '$schematic' for reading: $!";

# Input and output objects that we find described in the .sch file.
my @inputs;
my @outputs;

# The .sch file format seems to general stuff ouside of brackets, and
# the descriptions of specific objects inside brackets.  We will set
# this true when we find we are in a bracketed device description.
my $in_device = 0;

# These flags get set true when we find we are in an object
# description that describes an input or output device.
my $is_input_device = 0;
my $is_output_device = 0;

# The refdes attribute from the most recently encountered
# 'refdes=value' attribute line.
my $refdes;

# We expect a refdes attribute line to look like this.  This is
# probably too permissive for other parts of gscheme and friends (GAF)
# on the characters allowed in the attribute and possibly too
# restrictive on the single-line requirement.
my $refdes_pat = '^\s*refdes=(.+)\s*$';

while ( <SCHEMATIC> ) {

    if ( m/\{/ ) {
	# Enter a new device block.
	$in_device++;
	$in_device == 1 or die "unexpected nested brackets";
    }

    if ( m/device=INPUT/ ) {
	print "trap";
    }

    if ( m/\}/ ) {
	# We have reached the end of a device block.  If the device
	# was an input or an output device, remember its refdes.
	$in_device--;
	$in_device == 0 or die "unexpected imbalanced brackets";
	if ( $is_input_device or $is_output_device ) {
	    if ( $is_input_device ) {
		push(@inputs, $refdes);
	    }
	    elsif ( $is_output_device ) {
		push(@outputs, $refdes);
	    }
	    else {
		die;   # Shouldn't be here.
	    }
	}
	$is_input_device = 0;
	$is_output_device = 0;
	$refdes = undef;
    }

    # Remember any refdes line we encounter.
    if ( $in_device ) {
	if ( m/$refdes_pat/ ) {
	    not defined($refdes)
		or die "unexpected refdes attribute line '$_'";
	    $refdes = $1;
	}
    }

    # Take not when we see an attribute that indicates that we are in
    # an INPUT or OUTPUT device.
    if ( $in_device ) {
	$is_input_device ||= m/^\s*device=INPUT\s*$/;
	$is_output_device ||= m/^\s*device=OUTPUT\s*$/;
    }
}

close(SCHEMATIC) or die;

# Now we can produce a tragesym file.

my $date = `date +%Y%m%d`;
chomp($date);

open(TRAGESYM_FILE, ">$tragesym_file")
    or die "couldn't open '$tragesym_file' for writing: $!";

print TRAGESYM_FILE <<END_TRAGESYM_HEADER;
# Produced automaticly by symbolize.perl.  Edit it if you want but
# know that it may be destroyed unless care it taken :)

[options]
# rotate_labels rotates the pintext of top and bottom pins
# wordswap swaps labels if the pin is on the right side an looks like this:
# "PB1 (CLK)"
wordswap=yes
rotate_labels=no
sort_labels=yes
generate_pinseq=yes
sym_width=2000
pinwidthvertikal=400
pinwidthhorizontal=400

[geda_attr]
# name will be printed in the top of the symbol
# if you have a device with slots, you'll have to use slot= and slotdef=
# use comment= if there are special information you want to add
version=$date
name=$symbol_name
device=none
refdes=S?
#footprint=
description=See $schematic for details
author=symbolize.perl
documentation=See $schematic for details
numslots=0
#slot=1
#slotdef=1:
#slotdef=2:
#slotdef=3:
#slotdef=4:
comment=Automaticly produced by symbolize.perl from $schematic
#comment=
#comment=

[pins]
# tabseparated list of pin descriptions
# pinnr is the physical number of the pin
# seq is the pinseq= attribute, leave it blank if it doesn't matter
# type can be (in, out, io, oc, oe, pas, tp, tri, clk, pwr)
# style can be (line,dot,clk,dotclk,none). none if only want to add a net
# posit. can be (l,r,t,b) or empty for nets
# net specifies the name of the Vcc or GND name
# label represents the pinlabel.
#	negation lines can be added with _Q_
#	if you want to add a "_" or "\" use "\_" and "\\" as escape sequences
#-----------------------------------------------------
#pinnr	seq	type	style	posit.	net	label
#-----------------------------------------------------
END_TRAGESYM_HEADER

my $pin_number = 1;

foreach ( @inputs ) {
    # Note that we (mostly arbitrarily) put input on the left side of the
    # symbol.
    print TRAGESYM_FILE "$pin_number\t$pin_number\tin\tline\tl\t\t$_\n";
    $pin_number++;
}

foreach ( @outputs ) {
    # Note that we (mostly arbitrarily) put outputs on the right side
    # of the symbol.
    print TRAGESYM_FILE "$pin_number\t$pin_number\tout\tline\tr\t\t$_\n";
}

close(TRAGESYM_FILE) or die;

my $tragesym_command = "tragesym $tragesym_file $symbol_file";

not system($tragesym_command)
    or die "tragesym command '$tragesym_command' had non-zero exit status";

my $symbol_source = `cat $symbol_file`;

# If tragesym has behaved as expected (and programmed to behave in the
# above code) the last two lines in the symbol file should describe
# the position and text of a comment attribute that appears at the top
# of the symbol drawing area.  We want to find the position of this
# comment so we can put our source attribute above it.
my @source_lines = split("\n", $symbol_source);
my $comment_line = pop(@source_lines);
$comment_line =~ m/^comment=/
    or die "didn't find comment attribute line at end of symbol file";
my $comment_position = pop(@source_lines);
$comment_position =~ m/^T \d+ (\d+) \d+ \d+ \d+ \d+ \d+ \d+ \d+\s*$/
    or die "failed to match comment attribute position description source";
my $vertical_position = $1 + 200;

# Symbol source code for the source attribute we are going to add to
# the symbol description.
my $source_source = <<END_SOURCE_SOURCE;
T 400 $vertical_position 5 10 0 0 0 0 1
source=$schematic
END_SOURCE_SOURCE

open(SYMBOL_FILE, ">>$symbol_file")
    or die "couldn't open '$symbol_file' for appending: $!";
print SYMBOL_FILE $source_source;
close(SYMBOL_FILE) or die;

exit 0;