#!/bin/perl

=pod
treemake: makes a stick diagram from an acedb model.  fields are
replaced with ?,T,F,I,D,# while other characters in tags are replaced
by the underscore character, as are the characters in the class name.
UNIQUE and XREF are removed, except where UNIQUE lies between two tags
and is important for indentation.

useage: treemake.pl models.wrm > foo

=cut

$/ = "";

$protect{'Text'} = chr(255);
$protect{'Float'} = chr(254);
$protect{'Int'} = chr(253);
$protect{'DateType'} = chr(252);

while(<>){
    ($classname) = /^?(\S+)/; #for labeling purposes only
    s/\/\/.*\n/\n/g; #comments
    s/[ \t]+\n/\n/g; #space at end of lines
    s/\n+/\n/g;      #blank lines
    s/\?\S+\s+XREF\s+\S+/\?/g; #convert ?Foo XREF Bar -> ?
    s/\#\S+/\#/g; #convert any hash class -> #

    #protect basic field types
    foreach $code (keys %protect){
	s/[\t ]+($code)\b/" " . $protect{$1} . " "/eg;
    }

    #UNIQUE and REPEAT
    #UNIQUE between tags is critical for spacing
    s/(\w+\s+)(UNIQUE)(\s+\w+)/$1 . "      " . $3/eg;
    s/\s+UNIQUE//g; #UNIQUE before fields can be discarded
    s/REPEAT//g; #discard all REPEATs

    #convert alphanumerics to underscores
    s/\w/_/g;

    s/[\t ]+\?_+/\ ? /g; #all ?Foo -> ?
    s/(\n[ \t]+)_/$1\|/g; #branches point upward
    s/(_+)_(\s+)/$1>$2/g; #mark branchpoints with >
    s/(>)(\s+)_/$1."." x length($2) . "*"/eg; #join branchpoint to first
                                              #branch using periods
    s/>/_/g; #remove branchpoint marker >

    #unprotect basic field types
    foreach $code (keys %protect){
	s/$protect{$code}/ substr($code,0,1) /eg;
    }

    undef @lines; undef @model;
    @lines = split(/\n/);

    #put model into 2-d array
    for($i=0;$i<@lines;$i++){
	$model[$i] = [split("",$lines[$i])];
    }
    #rule: if a vertical bar has a space char above it,
    #replace the space with another vertical bar
    for($i=$#model; $i>0; $i--){
	for($j=0; $j<@{$model[$i]}; $j++){
#	for($j=0; $j<$model->[$i]; $j++){ #interesting
	    if($model[$i][$j] eq "|"){
		if($model[$i-1][$j] eq " "){
		    $model[$i-1][$j] = "|";
		}
	    }
	}
    }

    #print the tree-ified model
    print STDOUT "$classname\n";
    for($i=0; $i<@model; $i++){
	@line = @{$model[$i]};
	print STDOUT @line, "\n";
    }
    print STDOUT "\n";
}