#!/usr/bin/perl -w
use strict;
# svx2th v0.1
# Copyright (C) Olly Betts 2004
# v0.2 Wookey 2022

#TODO
#*data passage -> *data dimensions
#.. -> -, ... -> - (and . but we need to be more careful with that)
# make inlining optional - use 'input' instead


sub convert_file($);

my $in_survey = 0;
my $in_group = 0;
my $had_fix = 0;
print "encoding utf-8\n";
for my $filename (@ARGV) {
    convert_file($filename);
}
if ($in_survey) {
    print "endsurvey dummy\n";
}

sub convert_file($) {
    my $filename = shift;
    open F, "<", $filename or die "$filename: $!\n";
    my @lines = <F>;
    close F;
    my $in_centre_line = 0;
    my $lineno = 0;
    my $dummy_survey = -1;
    foreach $_ (@lines) {
	++$lineno;
	# Replace ; with # as comment separator.
	# FIXME won't cope with ; in a filename or *title
	s/;/#/;

	# Comment out "*export" and "*entrance" as there seems to be no
	# equivalent of either.
	if (/^\s*\*\s*(?:export|entrance)\b/i) {
	    print "#$_";
	    next;
	}

	if ($in_centre_line) {
	    if (/^\s*\*/ && !/^\s*\*\s*(?:date|calibrate|fix|equate|data|instrument|units|sd|infer|flags|team)\b/i) {
		print "endcentreline\n";
		$in_centre_line = 0;
	    }
	    #fixup anonymous stations
	    s/(\s)\.\.\.(\s)/$1-$2/g;
	    s/(\s)\.\.(\s)/$1-$2/g;
	} else {
	    if (/^\s*[^\s*#]/ || /^\s*\*\s*(?:date|calibrate|fix|equate|data|instrument|units|sd|infer|flags|team)\b/) {
		if (!$in_survey) {
		    # Therion can't handle these outside a centreline which
		    # must be inside a survey, so we have to add a dummy
		    # top-level survey.
		    print "survey dummy -title \"Dummy workaround survey\"\n";
		    ++$in_survey;
		}
		print "centreline\n";
		$in_centre_line = 1;
	    }
	}
	    
	# *begin <survey> -> survey <survey>
	if (s/^(\s*)\*(\s*)begin\b(\s*)(\S+)/$1$2survey$3$4 -title "$4" /i) {
	    ++$in_survey;
	    print $_;
	    next;
	}
	# *begin -> <nothing>
	# The *begin will cause an endcentreline / centreline pair to be
	# output which hopefully prevents settings from escaping.  However
	# this doesn't restore the old settings, just undoes any new ones.
	# FIXME: Need to address this somehow...
	if (s/^(\s*)\*(\s*)begin\*$/group/i) {
	    ++$in_group;
            print "#$_";
	    next;
	}

	# *end [<survey>] -> endsurvey [<survey>]
	if (s/^(\s*)\*(\s*)end\b/$1$2endsurvey/i) {
	    if ($dummy_survey == $in_survey) {
		$_ = "#$_";
		$dummy_survey = -1;
	    }
	    --$in_survey;
	    if ($in_centre_line) {
		print "endcentreline\n";
		$in_centre_line = 0;
	    }
	    print $_;
	    next;
	}
	# *end -> endgroup
	if (s/^(\s*)\*(\s*)end\b/$1$2endgroup/i) {
	    --$in_survey;
	    print $_;
	    next;
	}
	# *title <title> -> # -title <title>
	# FIXME: just comment out for now - should really convert to -title on
	# the "survey" line.
	if (s/^(\s*)\*\s*title\b\s*/$1# -title /i) {
	    print $_;
	    next;
	}
	# *ref <reference> -> # ref <reference>
	# FIXME: just comment out for now - not sure there is an equivalent
	if (s/^(\s*)\*\s*ref\b\s*/$1# ref: /i) {
	    print $_;
	    next;
	}
	# *team and *instrument format is unspecified in Survex, and they're
	# just informational so comment them out for now...
	# NB therion seems to be case sensitive so "Compass" isn't a valid role
	# ("compass" is)...
	# NB in *team pics -> pictures
	if (s/^(\s*)\*(\s*(?:team|instrument))\b/#$1$2/i) {
	    print $_;
	    next;
	}
	# *include -> literal text inclusion. (should probably use 'input' instead?)
	# Note that the *include means an implicit *begin, but the output
	# may not reflect this correctly (since we can't handle *begin
	# with no survey name anyway...)
	if (/^\s*\*\s*include\s*"?([^"\s]*)/i) {
	    # Use Unix path separators (/ not \) - Survex understands either on
	    # either platform.
	    my $filename = $1;
	    $filename =~ s!\\!/!g;
	    $filename .= '.svx' unless $filename =~ /\.svx$/i;
	    convert_file($filename);
	    next;
	}
	# survey.subsurvey.12 -> 12@subsurvey.survey
	if (s/^(\s*)\*(\s*equate)\b/$1$2/i) {
	    # Ensure that a comment separator doesn't get eaten by station name.
	    s/(\S)#/$1 #/;
	    s/(\S+)\.(\S+)/"$2\@".join(".",reverse split m!\.!, $1)/ge;
	    print $_;
	    next;
	}
	if (/^\s*\*\s*fix\b/i) {
	    $had_fix = 1;
	}
	s/^(\s*)\*/$1/;
	print;
    }
}