#!/usr/bin/env perl
BEGIN { $|=1; }
use warnings;
use utf8;

# This program has been superceded (superseded for those who want the correct form but don't know the Latin origin of the word) by visldep2malt.pl

#########################################################################
#### Author: © Eckhard Bick 2006-2017; contact: eckhard.bick@mail.dk ####
#########################################################################
#
# use: cat file.dep | visldep2malt > file.malt
#
# turns Constraint Grammar dependency format into MALT format
# also creates VISL tags from CG tags (if you don't want this, bypass that section with a goto command
#
# Input format is expected as "niceline", not cohort format
# word     [base] <...> ... POS MORF ... @FUNC #n->m
#
# the program will respect <...> meta lines, but not create any new ones
#
#########################################################################

while (<>) {

#    s/[ \t]+\#.*//g;
  s/ &[A-Za-z\-0-9]+//g;
    s/( \@.+)+ \@/ \@/;
    s/  +/ /g;
  s/^\#.*\n//;
    if (m/^(.*?) *\t ?\[(.*?)\]( +(<.*?> +)*)([A-Z0-9n_ \/\+]+ +).*?\@(.*?) +[\#=]([0-9]+?)(->|:)([0-9]+)/) {

### assign fields

	$wordform =$1;
	$base =$2;
	$extra =$3;
	$posmorf =$5;
	$syn =$6;
	$id =$7;
	$head =$9;

	$wordform =~ s/^\$//;
	$wordform =~ s/=/_/g;
	$wordform =~ s/\"/\&quot\;/g;
	$base =~ s/=/_/g;
	$extra =~ s/^ +//; $extra =~ s/ +$//; $extra =~ s/[<>]//g; $extra =~ s/  +/ /g;
#	print "--posmorf = $posmorf\n";
	$posmorf =~ m/^([A-Z_]+) +(.+)?$/;
	$pos =$1;
	if ($2) {$morf =$2;}
	else {$morf ="";}
	$morf =~ s/^ +//; $morf =~ s/ +$//;
#	$syn =~ s/</\«/g;
#	$syn =~ s/>/\»/g;

	if ($extra eq "") {$extra = "--";}
	if ($pos eq "") {$pos = "--";}
	if ($posmorf eq "") {$posmorf = "--";}
	if ($morf eq "") {$morf = "--";}
	if ($syn eq "") {$syn = "--";}

#create cg2visl tags

 	$pos =~ s/^(.*)$/\L$1/;
 	$pos =~ s/kc/conj-c/;
 	$pos =~ s/ks/conj-s/;
# 	$pos =~ s/^(indp|pers|det)$/pron/g;
# 	$pos =~ s/^(indp|pers|det)$/pron-$1/g;

	if ($extra) {
	  if ($extra =~ /poss/) {$pos =~ s/^(indp|pers|det)$/pron-poss/g;}
	  if ($extra =~ /rel/) {$pos =~ s/^(indp|pers|det)$/pron-rel/g;}
	  if ($extra =~ /interr/) {$pos =~ s/^(indp|pers|det)$/pron-int/g;}
	  if ($extra =~ /dem/) {$pos =~ s/^(indp|pers|det)$/pron-dem/g;}
	}
	$pos =~ s/^(pers)$/pron-pers/g;
	$pos =~ s/^(indp|pers|det)$/pron-indef/g; # <quant>, rest category, also <diff>
	if ($morf =~ s/(INF|GER|PCP[12]) *//) {$submorf =$1; $pos =~ s/^v/v-\L$submorf/;}
	else {$pos =~ s/^v$/v-fin/;}

 	$pos =~ s/^in$/intj/g;

	$syn =~ s/^(FAUX|FMV)/FS-STA/;
	$syn =~ s/^(IAUX|IMV)/ICL-UTT/;
	$syn =~ s/^ICL-AUX</Oaux/;
	$syn =~ s/^ICL->AUX/Oaux/;
	$syn =~ s/^(FS|ICL|AS)\-//;
	$syn =~ s/^ADVL>A/fA/g;
	$syn =~ s/^F-<*SUBJ>*/Sf/g;
	$syn =~ s/^S-<*SUBJ>*/Ss/g;
	$syn =~ s/^<*SUBJ>*/S/g;
	$syn =~ s/^<*ACC(-PASS)?>*/Od/g;
	$syn =~ s/F-<?ACC>?/Of/g;
	$syn =~ s/^<*DAT>*_<*ACC>*/Oi_Od/g;
	$syn =~ s/^<*DAT>*/Oi/g;
	$syn =~ s/^<*PIV>*/Op/g;
	$syn =~ s/^<*SA>*/As/g;
	$syn =~ s/^<*OA>*/Ao/g;
	$syn =~ s/^VO[CK]/fCvoc/g; # vocative adjunct
	$syn =~ s/^<*SC>*/Cs/g;
#	$syn =~ s/^FOC>/Dfoc/g;
	$syn =~ s/^FOC>/DC/g;
	$syn =~ s/^<*OC>*/Co/g;
	$syn =~ s/^<*ADVL>*/fA/g;
	$syn =~ s/^<*ADV>*/A/g;
	$syn =~ s/^<*PASS/fApass/g;
	$syn =~ s/^TOP/fAtop/g;
	$syn =~ s/^N<PRED/DNc/g;
	$syn =~ s/^<*PRED>*/fCs/g;
	$syn =~ s/^APP/DNapp/g;
	$syn =~ s/^N<FUSE/DNfuse/g;
	$syn =~ s/^>N/DN/g;
	$syn =~ s/^N<+/DN/g;
	$syn =~ s/^>AS/Dfoc/g;
	$syn =~ s/^>A/DA/g;
	$syn =~ s/^A<+/DA/g;
	$syn =~ s/^KOMP</DAcom/g;
	$syn =~ s/^P</DP/g;
	$syn =~ s/^>>P/DP/g;
	if (/ (DIR|<adir>) /) {$syn =~ s/^>P/DPmod/g;}
	else {$syn =~ s/^>P/DA/;}
	$syn =~ s/^PRT-AUX</SUBaux/g;
	$syn =~ s/^PRD/SUBprd/g;
	$syn =~ s/^COM(adv|conj|prp)/SUBcom$1/g;
	$syn =~ s/^AS<[A-Z]*/DCarg/g; # argument of complementizer (clause body)
	$syn =~ s/^S</fCsta/g;
	$syn =~ s/^>S/fCsta/g;
	$syn =~ s/^CMD/COM/g;
	$syn =~ s/^MV</Vpart/g;
#	$syn =~ s/pu/PU/; # ???
	$syn =~ s/^NPHR/X/g;
	$syn =~ s/>>A/DA/g;
	if($extra =~ m/foc/){
	    $syn = "Dfoc";
	}

### add CJT
#	if (! $syn) {$syn ="XXX";}
	$func{$id} =$syn;
	if ($extra =~ m/co-([a-z]+)/ || $syn =~ /CO/ && ! ($extra =~ /adv/)) {
	    $cotype =$1;
	    if (! $cotype) {$cotype ="co";}

	    $cotype =~ s/prparg/DP/;
	    $cotype =~ s/(pre|post)nom/DN/;
	    $cotype =~ s/(pre|post)ad/DA/;
	    $cotype =~ s/subj/S/;
	    $cotype =~ s/acc/Od/;
	    $cotype =~ s/dat/Oi/;
	    $cotype =~ s/piv/Op/;
	    $cotype =~ s/advl/fA/;
	    $cotype =~ s/sc/Cs/;
	    $cotype =~ s/oc/Co/;
	    $cotype =~ s/sa/As/;
	    $cotype =~ s/oa/Ao/;

	    $cjt{$head} =$cotype;
	}
#	if ($func{$head}) {push (@print, "\n******id=$id syn=$syn head=$head func(head)=$func{$head}\n");}
#	if ($cjt{$head}) {push (@print, "******cjt(head)=$cjt{$head}\n");}

	$utt = " UTT STA QUE EXC COM ";
	if ($func{$head} && $func{$head} eq $syn && $cjt{$head} && ($syn =~ /^$cjt{$head}/ || $pos =~ /v-$cjt{$head}/) || $utt =~ / $syn / && $func{$head} && $utt =~ / $func{$head} / || $extra =~ /cjt/) {
	    $syn = "CJT";
	}

	$extra =~ s/cjt *//g;

### output malt
	print "\t<word id=\"$id\" form=\"$wordform\"";
	if ($base || $pos) {
	    print " base=\"$base\" postag=\"$pos\"";
	}
	if ($morf) {
	    print " morf=\"$morf\"";
	}
	if ($extra) {
	    print " extra=\"$extra\"";
	}
	print " head=\"$head\" deprel=\"$syn\"\/>\n";
    }

### punctuation

    elsif (/^\$/) {
	m/^\$(.*?)[ \t]+\#([0-9]+?)->([0-9]+)/;
	$wordform =$1;
	$id =$2;
	$head =$3;
	$wordform =~ s/\"/\&quot\;/g;
	print "\t<word id=\"$id\" form=\"$wordform\" base=\"--\" postag=\"pu\" morf=\"--\" extra=\"--\" head=\"$head\" deprel=\"PU\"\/>\n";
    }

### sentence boundaries

    elsif (/(id|ID)=\"(.*?)\"/ || /^<.*(id|ID)=\"?(.*?)\"?>/) {
	if ($wordform) {
	    print "<\/sentence>\n\n"; # sentence-end
	}
	print "<sentence id=$2>\n"; # sentence-start
    }

    elsif (! /^<\/?([sp]|it)>/) {print;}

}

