#!/usr/bin/perl
#
# BNCweb: A user-friendly interface to the British National Corpus - Version 4.3
# Copyright (C) 2005-10 Hoffmann/Evert/Lehmann
#
# Updates and information available at http://www.bncweb.info
#
# This file is part of BNCweb.
# 
# BNCweb is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# 
# BNCweb is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

#
# based on BNCweb Version 2.0:
# © 1996/2004 Lehmann/Hoffmann/Schneider
#

### no longer supported -- check if some regexps need //m modifier
# $*=1; 
use DBI;

use lib "../lib_files";
use bncLibCQPXML;


$username = $ENV{'REMOTE_USER'};

# connect to mysql
$bncHandle = DBI->connect("DBI:mysql:$bwMYSQLtable:$bwMYSQLhost:$bwMysqlPort", "$bwMysqlUser", "$bwMysqlPwd");

# file info setup
$thisFile = "context.pl";
$fileInfoCgi = "fileInfo.pl";
$settingFile = "setting.pl";
$speakerInfoCgi = "speakerInfo_new.pl";
$mainFile = "main.pl";

# colour setup
$countColour='<FONT COLOR="#006600">';
$tagColour='<FONT COLOR="#374447">';
$overlapColour='<FONT COLOR="#FF0507">';
$shiftColour='<FONT COLOR="#3E2103">';
$brown='<FONT COLOR="#663300">';
$blue='<FONT COLOR="#0000DD">';
$yellow='<FONT COLOR="#CC9900">';
$pink='<FONT COLOR="#FF33CC">';
$red='<FONT COLOR="#DD0000">';
$orange='<FONT COLOR="#FF6633">';
$teal='<FONT COLOR="teal">';
$olive='<FONT COLOR="olive">';
$aqua='<FONT COLOR="aqua">';
$green='<FONT COLOR="green">';
	
unless (getParams($ENV{'QUERY_STRING'})) {
	barkFull("incomplete transmition of URL<BR>This problem is likely to occur in combination with proxy servers<BR>turn off your web-proxy and try again");
}

undef $params{urlTest};

$filename = uc($params{text});
$filename =~s/O/0/g;
setParam("text", "$filename");

$browseRef = 1 if ($params{qname} eq "nosol");

# get the user-defined view settings from mysql if the referer is not this program and mysql is used.
$immediateReferer=$ENV{'HTTP_REFERER'};
unless ($immediateReferer=~m/($thisFile)/) {
	$sqlQuery = "SELECT disp_tags, disp_lines, disp_color FROM settings where user='$username'";
	$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
	$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
	@rowArray=$sth->fetchrow_array;
	setParam("tag", "$rowArray[0]");
	$interval=$rowArray[1] + 1;
	setParam("interval", "$interval");
	setParam("color", "$rowArray[2]");
}


$substract = int($params{interval} / 2);

$sqlQuery = "SELECT sunit, sunit_internal FROM bnc_s_unit_pos where filename='$params{text}' order by sunit_internal desc limit 1";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
@rowArray=$sth->fetchrow_array;
$lastSunit = $rowArray[0];
$lastSunit_internal = $rowArray[1];

$sqlQuery = "SELECT sunit, sunit_internal FROM bnc_s_unit_pos where filename='$params{text}' order by sunit_internal asc limit 1";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
@rowArray=$sth->fetchrow_array;
$firstSunit = $rowArray[0];
$firstSunit_internal = $rowArray[1];

$s_number = $params{begin};
$s_number = $lastSunit if ($params{begin} > $lastSunit);
$s_number = $firstSunit if ($params{begin} < 1);

$sqlQuery = "SELECT sunit_internal FROM bnc_s_unit_pos where filename = '$filename' and sunit = $s_number";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
@rowArray=$sth->fetchrow_array;
$internal_target = $rowArray[0];

$internal_begin = $internal_target - $substract;
$internal_begin = $lastSunit_internal if ($lastSunit_internal < $internal_begin);
if ($firstSunit_internal > $internal_begin) {
	$internal_begin = $firstSunit_internal;
	$first = 1;
}

if ($internal_begin < 0) {
	### First s-unit of corpus. How do we solve this?
	$internal_begin = 0;
}
$internal_end = $internal_begin + $params{interval} - 1;
if ($lastSunit_internal < $internal_end) {
	$internal_end = $lastSunit_internal;
	$last = 1;
}

$random = int(rand(1000000000));
$tempName = $username . "_" . $random . "_disp";
$tempName2 = $tempName . "2";

$sqlQuery = "select beginPosition, endPosition INTO OUTFILE '/$bwMySQLTempPath/$tempName' from bnc_s_unit_pos where sunit_internal between $internal_begin and $internal_end";
$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
$numOfSolutions=$sth->rows;

# connect to CQP
CQPconnect(full);

qx{echo $numOfSolutions | cat - '/$bwTempPath/$tempName' > '/$bwTempPath/$tempName2'};
unlink("/$bwTempPath/$tempName") if -f "/$bwTempPath/$tempName";

$CQP->exec("undump $tempName2 < '/$bwTempPath/$tempName2'");

unlink("/$bwTempPath/$tempName2") if -f "/$bwTempPath/$tempName2";

$CQP->exec("set DataDirectory '/$bwTempPath/'");
$CQP->exec("$bwCorpus");

$CQP->exec("set LD ''");
$CQP->exec("set RD ''");
$CQP->exec("set Context 1 s");
$CQP->exec("show -cpos +word +pos +space_after +tags_before +tags_after +type");

$batch_end = $numOfSolutions - 1;
@kwic = $CQP->exec("cat $tempName2 0 $batch_end");
@table = $CQP->dump("$tempName2", "0", $batch_end); # table of corpus positions
	
$n = @kwic;	
$text = "";

foreach $i (0 .. $n-1) {
	$sunit = $kwic[$i];

	#warn $sunit;
	@words = split(/ /, $sunit);
	
	foreach $whole (@words) {
		($word, $space, $tag_before, $tag_after) = split(/\/\/\x{A0}/, $whole);
		$word=~s/\x{A0}/ /g;
		$tag_before=~s/\x{A0}/ /g;
		$tag_after=~s/\x{A0}/ /g;
				
		$word=~m/\A(.*)\/(.*?)\/(w|c|x)\Z/;
		$word = $1;
		$tag = $2;
		$attribute = $3;
		if ($space) {
			$space = " ";
		} else {
			$space = "";
		}
		if ($attribute eq "x") {
			$text .= $tag_before . $space . $tag_after;
		} else {
			$text .= $tag_before . "<t>" . $word . "<t $tag>" . $space . $tag_after;
		}
	}
	
	if ($spoken{$params{text}}) {
		($match, $dummy, $dummy, $dummy) = @{$table[$i]}; 
		$u_who = $U_WHO->cpos2str($match);
		$num = $S_N->cpos2str($match);
		$spids{$num} = $u_who;
		$num_first = $num if ($i == 0);
	}
}

$text=~s/<p >/<p>/g;

$file = $text;

$originalBegin=$params{begin};

$substract = int($params{interval} / 2);
$begin = $params{begin};
$begin -= $substract;
$begin = 1 if ($begin <= 1);
setParam("first", "");
setParam("begin", "$begin");

$end = $params{begin} + $params{interval};

$file=~s/(<s ([^>]+\s)?n="$params{hitSunit}">(.*?<t [^>]+>){$params{token_offset}})((.*?<t [^>]+>){$params{nodeCount}})/$1<FONT COLOR="#8D090C"><B>$4<\/B><\/FONT>/ unless ($browseRef);

$showend = $end - 1;

if (($end - 1) < $lastSunit) {
	$showend .= " (of a total of $lastSunit &lt;s&gt;-units)";
} else {
	$showend = "$lastSunit (end of text)";	
}


$chunk = $file;

# print html header
print "Content-type: text/html\n\n";
print <<END;

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<HEAD>

<TITLE>BNC Corpus Display</TITLE>
<META NAME="generator" CONTENT="BBEdit 4.5">
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<TABLE BORDER="0" CELLPADDING="2" CELLSPACING="2" WIDTH="100%">
	<TR WIDTH="100%">
		<TD HEIGHT="26" COLSPAN="5" BGCOLOR="#CCCCFF">
			<P ALIGN="LEFT"><B>$params{text}: &lt;s&gt;-units $params{begin} to $showend</B>
		</TD>
	</TR>
	<TR>
END

# do some stuff if division boundary falls within the range displayed.
# but what?
$divisionBoundary=0;
$hit=$chunk=~m/<div /;
if ($hit) {
	$divisionBoundary=1;
	$chunk=~s/<div (?!level="(2|3|4)")[^>]+>/<HR>/g;
}


$result=$params{theShowData};
for ($l=0; $l<length($result); $l++) {
	$char=substr($result,$l,1);
	$char=quotemeta($char);
	$result1.= '(\s)?(<[^>]+>)*(\s)?' if $l>0;
	$result1.=$char;
}

unless ($browseRef) {
	# colour other occurrences of the query result 
	$blurb1='<FONT COLOR="#06295B">';
	$blurb= '<FONT COLOR="#8D090C">';
	$chunk=~s/>($result1)</>${blurb1}${1}<\/FONT></gi;
	$chunk=~s/${blurb}<B>( *<t>)${blurb1}($result1)<\/FONT>/${blurb}<B>$1$2/;
}
createLinks();

# prepare sentences for output in HTML
&output();
# output result as table if spoken text
print "<TR><TD COLSPAN=\"5\">";
if ($spoken{$params{text}}) {
	# get speakernames

	print "<TABLE CELLPADDING=5>\n";
		
	@array=split(/#b#/,$chunk);
	foreach $speaker (@array) {
		next if (!$speaker);
		($spid, $lines) = split (/#e#/, $speaker);
		unless ($name{spid}) {
			$sqlQuery = "SELECT nameFull FROM speakers where spid='$spid'";
			$sth = $bncHandle->prepare($sqlQuery) or bark("Can't prepare $sqlQuery:" . $bncHandle::errstr);
			$sth->execute or bark("Can't execute $sqlQuery: $sth::errstr");
			@rowArray=$sth->fetchrow_array;
			if ($rowArray[0] eq "N/A") {
				$name{$spid}="$spid";
			} else {
				$name{$spid} = $rowArray[0];
			}
			
		}
		
		if (($name{$spid} ne $spid) && ($name{$spid})) {
			$names=1;
		}
		if ($params{spids}) {
			if ($name{$spid}) {
				print "<TR><TD VALIGN=TOP><A HREF=\"/$bwCGIalias/${speakerInfoCgi}?text=$paramsEnc{text}&spid=$spid&urlTest=yes\"<B>$name{$spid}</B></A></TD>\n";
			} else {
				print "<TR><TD VALIGN=TOP>$spid</TD>\n";
			}
		} else {
			if ($spid eq "Note") {
				print "<TR><TD VALIGN=TOP>Note</TD>\n";
			} else {
				print "<TR><TD VALIGN=TOP><A HREF=\"/$bwCGIalias/${speakerInfoCgi}?text=$paramsEnc{text}&spid=$spid&urlTest=yes\"<B>$spid</B></A></TD>\n";
			}
		}
		@array2 = split (/#c#/, $lines);
		$countrow=0;
		foreach $utterance (@array2) {
			next if ($utterance=~m/\A\s+\Z/);
			$countrow++;
			print "<TR><TD> </TD>" if ($countrow > 1);
			($counter, $content) = split (/#g#/, $utterance);
			if (!$content) {
				$content=$counter;
				$counter="";
			}
			print "<TD VALIGN=TOP>$counter</TD><TD VALIGN=TOP>$content</TD></TR>\n";
		}
	}
	print "</TABLE>\n";
} else {
	$chunk=~s/(#g#|#c#)//g;
	print "$chunk\n";
}
#warn $chunk;
print "</TD></TR></TABLE>";

# print end of HTML
&printFooter();
&CQPdisconnect() unless $browseRef;
exit(0);

# subroutines
sub output {
	# take care of punctuation marks that are first on a new line but should have a
	# whitespace after the preceding item.
	#$chunk=~s/\n((<c PUQ>&bquo)|(<c PUL>))/\n $1/gm;
		
	# remove multiple spaces and new-lines
	$chunk=~s/\n/ /g;
	$chunk=~s/\s+/ /g;
		
	if ($params{color}) {
		# This also colours the actual match - do something about this...
		$chunk=~s/<t>[^<]+<t (N[NP].|ZZ0)[^>]*>/${brown}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t V\w{2}[^>]*>/${blue}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t (AJ.|CRD|DT0|ORD)[^>]*>/${yellow}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t (AV.|XX0)[^>]*>/${pink}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t (DPS|DT[SQ]|EX0|PN.)[^>]*>/${red}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t (PR.|TO0)[^>]*>/${teal}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t ITJ[^>]*>/${olive}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t CJ.[^>]*>/${aqua}$&<\/FONT>/g;
		$chunk=~s/<t>[^<]+<t AT0[^>]*>/${green}$&<\/FONT>/g;
	}
	
	# colour tags for display if needed
	if ($params{showTheTag}) {
		$chunk=~s/\<t ([^\>]*)\>/${tagColour}&lt\;$1&gt\;<\/FONT>/g;
	} else {
		$chunk=~s/\<(t [^\>]*)\>//g;
	}
	$chunk=~s/<\/(w|c|s)>//g;
	$chunk=~s/<t>//g;
		
	# rendition codes
	# this is slightly problematic because it does not cover multiple rendition codes
	# such as a line that is in italics and has one word in boldface...
	$chunk=~s/\<hi r[^\=]*\=(\")?it(\")?[^\>]*>(.*?)<\/hi>/<I>$3<\/I>/go;
	$chunk=~s/\<hi r[^\=]*\=(\")?bo(\")?[^\>]*>(.*?)<\/hi>/<B>$3<\/B>/go;
	$chunk=~s/\<hi r[^\=]*\=(\")?hi(\")?[^\>]*>(.*?)<\/hi>/<SUP>$3<\/SUP>/go;
	$chunk=~s/\<hi r[^\=]*\=(\")?lo(\")?[^\>]*>(.*?)<\/hi>/<SUB>$3<\/SUB>/go;
	$chunk=~s/\<hi r[^\=]*\=(\")?qt(\")?[^\>]*>(.*?)<\/hi>/<TT>$3<\/TT>/go;
	$chunk=~s/\<hi r[^\=]*\=(\")?st(\")?[^\>]*>(.*?)<\/hi>/<S>$3<\/S>/go;
	$chunk=~s/\<hi r[^\=]*\=(\")?ul(\")?[^\>]*>(.*?)<\/hi>/<U>$3<\/U>/go;
	
	$chunk=~s/<lb>/<BR>/go;
	$chunk=~s/\<gap([^\>\/]*)\/>/&lt\;gap${1}&gt\;/go;


	$chunk=~s/\<corr sic="([^"]+)".*?>/<FONT COLOR="#BBBBBB">\[orig: $1\] <\/FONT>/go;
	
	# assign heading 2 to heads
	$replace1=$chunk=~s/\<head[^>]*\>/<H2 ALIGN=LEFT>/go;
	$replace2=$chunk=~s/\<\/head[^>]*\>/<\/H2>/go;
	if (($replace1) || ($replace2)) {
		if ($replace1 > $replace2) {
			$chunk .= "<\/H2>";
		} elsif ($replace2 > $replace1) {
			$chunk = "<H2 ALIGN=LEFT>" . $chunk;
		} else {
			$chunk=~/(.*?)<\/H2>/o;
			$bef=$1;
			$hit=$bef=~m/<H2 ALIGN=LEFT>/;
			if (!$hit) {
				$chunk = "<H2 ALIGN=LEFT>" . $chunk;
				$chunk .= "<\/H2>";
			}
		}
	}
	
	# assign heading 3 to captions
	$replace1=$chunk=~s/\<caption[^>]*\>/<H3 ALIGN=LEFT>/go;
	$replace2=$chunk=~s/\<\/caption[^>]*\>/<\/H3>/go;
	
	if (($replace1) || ($replace2)) {
		if ($replace1 > $replace2) {
			$chunk .= "<\/H3>";
		} elsif ($replace2 > $replace1) {
			$chunk = "<H3 ALIGN=LEFT>" . $chunk;
		} else {
			$chunk=~/(.*?)<\/H3>/o;
			$bef=$1;
			$hit=$bef=~m/<H3 ALIGN=LEFT>/;
			if (!$hit) {
				$chunk = "<H3 ALIGN=LEFT>" . $chunk;
				$chunk .= "<\/H3>";
			}
		}
	}

	# assign citation to quotes
	$replace1=$chunk=~s/\<quote[^>]*\>/<CITE>/go;
	$replace2=$chunk=~s/\<\/quote[^>]*\>/<\/CITE>/go;
	
	if (($replace1) || ($replace2)) {
		if ($replace1 > $replace2) {
			$chunk .= "<\/CITE>";
		} elsif ($replace2 > $replace1) {
			$chunk = "<CITE>" . $chunk;
		} else {
			$chunk=~/(.*?)<\/CITE>/o;
			$bef=$1;
			$hit=$bef=~m/<CITE>/;
			if (!$hit) {
				$chunk = "<CITE>" . $chunk;
				$chunk .= "<\/CITE>";
			}
		}
	}
	
	# lists
	$hit1=$chunk=~m/\<list[^>]*\>/;
	$hit2=$chunk=~m/\<\/list[^>]*\>/;
	
	if (($hit1) || ($hit2)) {
		$hit=$chunk=~m/\<(\/)?label[^>]*\>/;
		
		if (!$hit) {
			$replace1=$chunk=~s/\<list[^>]*\>/<UL TYPE\=DISC>/go;
			$replace2=$chunk=~s/\<\/list[^>]*\>/<\/UL>/go;
			$chunk=~s/\<item[^>]*\>/<LI>/go;
			
			if (($replace1) || ($replace2)) {
				

				if ($replace1 > $replace2) {
					$chunk .= "<\/UL>";
					$chunk=~s/<LI>((<[^\>]+\>)*)(<\/UL>)\Z/${1}${3}/;
				} elsif ($replace2 > $replace1) {
					$chunk = "<UL TYPE\=DISC>" . $chunk;
					$chunk=~/(.*?)<LI>/;
					$bef=$1;
					$hit=$bef=~m/<s ([^>]+\s)?n=\"?(\d+)\"?( \w=\S+)*>/;
					if ($hit) {
						$chunk=~s/\A(<UL TYPE\=DISC>)/$1<LI>/;
					}
				} else {
					$chunk=~/(.*?)<\/UL>/;
					$bef=$1;
					$hit=$bef=~m/<UL TYPE\=DISC>/;
					if (!$hit) {
						$chunk = "<UL TYPE\=DISC>" . $chunk;
						$chunk=~/(.*?)<LI>/;
						$bef=$1;
						$hit=$bef=~m/<s ([^>]+\s)?n=\"?(\d+)\"?( \w=\S+)*>/;
						if ($hit) {
							$chunk=~s/\A(<UL TYPE\=DISC>)/$1<LI>/;
						}
						$chunk .= "<\/UL>";
					}
				}
				$chunk=~/(.*?)<\/UL>/;
				$bef=$1;
				$hit=$bef=~m/<UL TYPE\=DISC>/;
				if (!$hit) {
					$chunk = "<UL TYPE\=DISC>" . $chunk;
					$chunk=~/(.*?)<LI>/;
					$bef=$1;
					$hit=$bef=~m/<s ([^>]+\s)?n=\"?(\d+)\"?( \w=\S+)*>/;
					#$chunk=~s/\A(<UL TYPE\=DISC>)/$1<LI>/;
					$chunk .= "<\/UL>";
				}
				
				$chunk=~m/(.*)<\/item>/;
				$aft=$'; # ' 
				$hit=$aft=~/<\/UL>/;
				if (!$hit) {
					$chunk .= "<\/UL>";
				}
				$replace1=$chunk=~s/<UL TYPE\=DISC>/$&/go;
				$replace2=$chunk=~s/<\/UL>/$&/go;
				if ($replace1 > $replace2) {
					$chunk .= "<\/UL>";
				}
				$chunk=~s/<LI>(<UL[^\>]*\>)/$1<LI>/go;
				$chunk=~s/<LI>(<p>)?<\/UL>/<\/UL>/go;
			}
		} else {
			$replace1=$chunk=~s/\<list[^>]*\>/<TABLE>/go;
			$replace2=$chunk=~s/\<\/list[^>]*\>/<\/TABLE>/go;
			$chunk=~s/\<label[^>]*\>/<TR><TD VALIGN=TOP>/go;
			$chunk=~s/\<\/label[^>]*\>/<\/TD>/go;
			$chunk=~s/\<item[^>]*\>/<TD VALIGN=TOP>/go;
			$chunk=~s/\<\/item[^>]*\>/<\/TD><\/TR>/go;
			if (($replace1) || ($replace2)) {
				if ($replace1 > $replace2) {
					$chunk .= "<\/TABLE>";
				} elsif ($replace2 > $replace1) {		
					$chunk = "<TABLE>" . $chunk;
					$hit=$chunk=~m/\A<TABLE>(.*?)<TD VALIGN=TOP>/;
					if ($hit) {
						$betw=$1;
						$hit=$betw=~m/<TR>/;
						if ($hit) {
							$chunk=~s/\A<TABLE>/<TABLE><TR><TD><\/TD><TD VALIGN=TOP>/;
						}
					}
				} else {
					$chunk=~/(.*?)<\/TABLE>/;
					$bef=$1;
					$hit=$bef=~m/<TABLE>/;
					if (!$hit) {
						$chunk=~/(.*?)<\/TR>/;
						$bef=$1;
						$hit=$bef=~s/<\/TD>/$&/g;
						if ($hit == 1) {
							$chunk = "<TABLE><TD><\/TD><TD VALIGN=TOP>" . $chunk;
						} else {
							$chunk = "<TABLE><TD VALIGN=TOP>" . $chunk;
						}
						$chunk .= "<\/TABLE>";
					}
				}
				$chunk=~/(.*?)<\/TABLE>/;
				$bef=$1;
				$hit=$bef=~m/<TABLE>/;
				$bef="";
				if (!$hit) {
					$hit=$chunk=~/(.*?)<\/TR>/;
					$bef=$1;
					$hit=$bef=~s/<\/TD>/$&/g;
					if ($hit == 1) {
						$chunk = "<TABLE><TD><\/TD><TD VALIGN=TOP>" . $chunk;
					} else {
						$chunk = "<TABLE><TD VALIGN=TOP>" . $chunk;
					}
					$chunk .= "<\/TABLE>";
				}
				$replace1=$chunk=~s/<TABLE>/$&/go;
				$replace2=$chunk=~s/<\/TABLE>/$&/go;
				if ($replace1 > $replace2) {
					$chunk .= "<\/TABLE>";
				}
			}
		}
	}
	# mark up spoken texts
	if ($spoken{$params{text}}) {
		
		$chunk=~s/<unclear (who=\"?([^>\"]+)\"?>)/<u $1<unclear>/g;
		$chunk=~s/<unclear (dur=\"?\d+\"?) (who=\"?([^>\"]+)\"?>)/<u ${2}<unclear ${1}>/g;
		
		$chunk=~s/<u(\s)?([^>]+\s)?who=\"?([^>\"]+)\"?>/#b#${3}#e#/g;
		$chunk =~m/\A(.*?)<s /;
		$before_sunit = $1;
		$chunk=~s/(.*?)(<s n="(\d+)">)/#b#$spids{$3}#e#$&/ unless ($before_sunit=~m/#b#/);
		
		$hit1=$chunk=~m/(.*)#b#/;
		if ($hit1) {
			$before=$1;
			$after=$';
			$hit=$after=~m/<s (\S+\s)?n=\"?(\d+)\"?( \w=\"?\S+)*>/;
			$chunk=$before if (!$hit);
		}
		
		
		$chunk=~s/\<pause([^\>\/]*)\/>/ &lt\;pause${1}&gt\; /go;
		$bla = $chunk=~s/<\/trunc>/#t#-- /go;
		$chunk=~s/(\s)?#t#--/--/go;
		$chunk=~s/\<vocal (.*?)desc="([^\"]+)"(.*?)\/>/ &lt\;${2}&gt\;/go;
		$chunk=~s/\<event (.*?)desc=("([^"]+)")(.*?)\/>/ &lt\;event: ${1}${2}&gt\;/go;

		$chunk=~s/\<unclear([^\>\/]*)\/\>/&lt\;unclear$1&gt\; /go;
		$chunk=~s/\<align with="[^"]+"\/>/ ${overlapColour}&lt\;-\|-&gt\;<\/FONT> /go;
		
		# colour and mark <shift> tags
		$replace1=$chunk=~s/\<shift new=\"?([^>\"]*)\"?\/\>/${shiftColour}&lt\;voice quality: $1&gt\;<\/FONT>/go;
		$replace2=$chunk=~s/\<shift\/\>/${shiftColour}&lt\;end of voice quality&gt\;<\/FONT>/go;		
	}
	
	
	# colour sentence counter
	if ($spoken{$params{text}}) {
		$chunk=~s/<s ([^>]+\s)?n=\"?(\d+)\"?( \w=\S+)*>/ #c#${countColour}<TT>$2<\/TT><\/FONT>#g# /g;
	} else {
		$chunk=~s/<s ([^>]+\s)?n=\"?(\d+)\"?( \w=\S+)*>/ ${countColour}<FONT SIZE=3><TT>$2<\/TT><\/FONT><\/FONT>#c# /g;
	}

}



sub createLinks {

	$startFont="<FONT SIZE=3 FACE=\"Arial, Helvetica\"><B>";
	$endFont="</B></FONT>";
	$navBar="";
	
	
	$oldbegin=$originalBegin;
	
	unless ($first) {
		$begin = $originalBegin - $params{interval};
		setParam("begin", "$begin");
		$theURL = getURLparams();
		$thing = '<A HREF="/' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes">';
		$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${thing}$startFont&nbsp;&lt;&lt;&nbsp;$endFont</A></TD>";
	} else {
		$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">$startFont&nbsp;&lt;&lt;&nbsp;$endFont</TD>";
	}


	$begin=$oldbegin;
	unless ($last) {
		$begin = $originalBegin + $params{interval};
		setParam("begin", "$begin");
		$theURL = getURLparams();
		$thing = '<A HREF="/' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes">';
		$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">${thing}$startFont&nbsp;&gt;&gt;&nbsp;$endFont</A></TD>";
	} else {
		$navBar.= "<TD WIDTH=\"3%\" BGCOLOR=\"#DDDDDD\" NOWRAP><P ALIGN=\"CENTER\">$startFont&nbsp;&gt;&gt;&nbsp;$endFont</TD>";
	}
	$optionSelector="";
	
	setParam("begin", "$originalBegin");
	
	$thing = 'Location: /' . $bwCGIalias . '/' . ${fileInfoCgi} . '?text=' . $paramsEnc{text} . '&urlTest=yes';
	$optionSelector .= "<OPTION VALUE=\"$thing\">File info for $params{text}";
	
	$originalSpids = $params{spids};
	if ($spoken{$params{text}}) {
		if (!$params{spids}) {
			setParam("spids", "1");
			$theURL = getURLparams();
			$thing = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
			$optionSelector .= "<OPTION VALUE=\"$thing\">Show names";
		} else {
			setParam("spids", "0");
			$theURL = getURLparams();
			$thing = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
			$optionSelector .= "<OPTION VALUE=\"$thing\">Hide names";
		}
		setParam("spids", "$originalSpids");
	}
	
	
	$originalTag = $params{showTheTag};
	if (!$params{showTheTag}) {
		setParam("showTheTag", "1");
		$theURL = getURLparams();
		$button1 = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
		$text1="Show POS-tags";
	} else {
		setParam("showTheTag", "0");
		$theURL = getURLparams();
		$button1 = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
		$text1="Hide tags";
	}
	setParam("showTheTag", "$originalTag");
	
	$originalColor = $params{color};
	if (!$params{color}) {
		setParam("color", "1");
		$theURL = getURLparams();
		$button2 = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
		$text2="Colour wordclass";
	} else {
		setParam("color", "0");
		$theURL = getURLparams();
		$button2 = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
		$text2="Don\'t colour wordclass";
	}
	setParam("color", "$originalColor");
	
	# restrict maximum context view - to make download of entire text in one go impossible.
	$originalInterval=$params{interval};
	$originalBegin=$params{begin};
	
	if ($params{interval} < 50) {
		$interval=$params{interval} + 10;
		setParam("interval", "$interval");
		
		$begin = $params{begin};
		$begin -= 5;
		$begin = 1 if ($begin <= 1);
		setParam("begin", "$begin");

		$theURL = getURLparams();
		$thing = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
		$optionSelector .= "<OPTION VALUE=\"$thing\">More context";
	}
	setParam("begin", "$originalBegin");
	
	if ($originalInterval > 11) {
		$interval=$originalInterval - 10;
		setParam("interval", "$interval");
		$begin = $params{begin};
		$begin += 5;
		setParam("begin", "$begin");
		$theURL = getURLparams();
		$thing = 'Location: /' . $bwCGIalias . '/' . ${thisFile} . '?' . $theURL . '&urlTest=yes';
		$optionSelector .= "<OPTION VALUE=\"$thing\">Less context";
	}
	setParam("interval", "$originalInterval");
	setParam("begin", "$originalBegin");
		
	if ($spoken{$params{text}}) {
		if (!$divisionBoundary) {
			$theURL = getURLparams();
			$thing = 'Location: /' . $bwCGIalias . '/' . ${settingFile} . '?text=' . $params{text} . '&begin=' . $num_first . '&end=' . $num . '&urlTest=yes';
			$optionSelector .= "<OPTION VALUE=\"$thing\">Show setting";
		}
	}

	unless ($params{qname} eq "nosol") {
		$message="Back to BNC Query Result";
		$theURL = getURLparams();
		$thing = 'Location:/' . $bwCGIalias . '/' . ${mainFile} . '?' . $theURL . '&urlTest=yes';
	} else {
		$message="Back to BNC Text Browser";
		$thing = 'Location:/' . $bwCGIalias . '/BNCquery.pl?theQuery=browse&urlTest=yes';
	}
	$optionSelector .= "<OPTION VALUE=\"$thing\">$message" if ($message);

	$thing = 'Location: /' . $bwCGIalias . '/BNCquery.pl?theQuery=search&urlTest=yes';
	$optionSelector .= "<OPTION VALUE=\"$thing\">New Query";
	

	print <<END;
		$navBar
		<FORM ACTION="/$bwCGIalias/dlogs2.pl" METHOD=GET>
		<TD BGCOLOR="#DDDDDD">
			
				<SELECT NAME="selected">
					$optionSelector
				</SELECT>
			<INPUT TYPE="SUBMIT" VALUE="Go!">
		</TD>
		</FORM>
		<FORM ACTION="/$bwCGIalias/dlogs2.pl" METHOD=GET>
		<TD BGCOLOR="#DDDDDD">
			<INPUT TYPE="hidden" NAME="selected" VALUE="$button1">
			<INPUT TYPE="submit" VALUE="$text1">
		</TD>
		</FORM>
		<FORM ACTION="/$bwCGIalias/dlogs2.pl" METHOD=GET>
		<TD BGCOLOR="#DDDDDD">
			<INPUT TYPE="hidden" NAME="selected" VALUE="$button2">
			<INPUT TYPE="submit" VALUE="$text2">
		</TD>
		</FORM>
		
		<TR><TD></TD></TR>
END
}


