#!/usr/bin/perl

use v5.12;
use warnings;

use HTML::Entities qw/encode_entities/;
use Text::ParseWords qw/quotewords/;


# 1  Definitions


# 1.1  Global program state

my $empty = ''; # currently buffered empty lines
my $close = ''; # buffered closing tag for currently opened block element
my $postclose = ''; # buffered extra closing tag for opened contiguous element
my $opel = ''; # currently opened block element


# 1.2  Elements

# 1.2.1  Contiguous elements
my %ctels = (
	Qp_0 => '<blockquote>{<p>%</p>}</blockquote>',
);

# 1.2.2  Block elements
my %blels = (
	Pp_0 => '<p>%</p>',
	Pr_0 => '<pre>%</pre>',
	Sh_0 => '<h3>%</h3>',
	Sh_1 => '<h\\$1>%</h\\$1>',
	Ti_0 => '<title>%</title>',
);

# 1.2.3  Inline elements
my %inels = (
	Au_1 => '<meta name="author" content="\\$1"/>',
	Bd_1 => '<b>\\$1</b>',
	Bd_2 => '<b>\\$1</b>\\$2',
	Bd_3 => '\\$3<b>\\$1</b>\\$2',
	br_0 => '<br/>',
	Cd_1 => '<code>\\$1</code>',
	Cd_2 => '<code>\\$1</code>\\$2',
	Cd_3 => '\\$3<code>\\$1</code>\\$2',
	Cs_1 => '<meta http-equiv="Content-Type" content="text/html; charset=\\$1"/>',
	Em_1 => '<em>\\$1</em>',
	Em_2 => '<em>\\$1</em>\\$2',
	Em_3 => '\\$3<em>\\$1</em>\\$2',
	Hy_2 => '<a href="\\$2">\\$1</a>',
	Im_2 => '<img src="\\$1" alt="\\$2"/>',
	It_1 => '<i>\\$1</i>',
	It_2 => '<i>\\$1</i>\\$2',
	It_3 => '\\$3<i>\\$1</i>\\$2',
	St_1 => '<strong>\\$1</strong>',
	St_2 => '<strong>\\$1</strong>\\$2',
	St_3 => '\\$3<strong>\\$1</strong>\\$2',
	Tt_1 => '<tt>\\$1</tt>',
	Tt_2 => '<tt>\\$1</tt>\\$2',
	Tt_3 => '\\$3<tt>\\$1</tt>\\$2',
	Ul_1 => '<u>\\$1</u>',
	Ul_2 => '<u>\\$1</u>\\$2',
	Ul_3 => '\\$3<u>\\$1</u>\\$2',
);


# 1.3  Subroutines

# 1.3.1  Handle element request
sub request {
	my ($el, $args) = @_;
	my @argv = quotewords('\s+', 0, $args);
	my $n = @argv;
	my $elkey = "${el}_$n";

	if (exists $blels{$elkey} or exists $ctels{$elkey}) {
		# Clear empty line buffer
		$empty = '';

		# Close currently open block element, open new
		my ($base, $prestart, $newpostclose) = ('', '', '');
		if (exists $ctels{$elkey}) {
			$base = $ctels{$elkey};
			$prestart = prestart($base);
			$newpostclose = postclose($base);
			$base = inner($base);
		} else {
			$base = $blels{$elkey};
		}
		my $start = start($base);
		my $newclose = interpol(_close($base), @argv) . "\n";

		print $close;
		$close = $newclose;

		print $postclose if $el ne $opel;
		$postclose = $newpostclose;

		print $prestart if $el ne $opel;
		print interpol($start, @argv) . "\n";

		$opel = $el;
	} elsif (exists $inels{$elkey}) {
		print interpol($inels{$elkey}, @argv) . "\n";
	} else {
		print STDERR "Error: $el/$n not implemented\n";
		exit 1;
	}
}

# 1.3.2  Interpolate \$n parameters
sub interpol {
	my $s = shift;
	my $i = 1;
	my $arg;
	while ($arg = shift) {
		$s =~ s/\\\$$i/$arg/g;
		$i++;
	}
	return $s;
}

# 1.3.3  Retrieve opening tag of block element string
sub start {
	return (split '%', shift)[0];
}

# 1.3.4  Retrieve closing tag of block element string
sub _close {
	return (split '%', shift)[1];
}

# 1.3.5  Retrieve extra opening tag of block element string
sub prestart {
	return (split '{', shift)[0];
}

# 1.3.6  Retrieve extra closing tag of block element string
sub postclose {
	return (split '}', shift)[-1];
}

# 1.3.7  Retrieve inner block of contiguous tag
sub inner {
	my $s = shift;
	$s =~ s/^.*?\{//;
	$s =~ s/}.*?$//;
	return $s
}


# 2  Program


# 2.1  Translate source text to HTML
while (<>) {
	chomp;
	if (/^\.([A-Za-z][a-z])\s*(.*)/) {
		request($1, $2);
	} elsif ($_ eq '') {
		$empty .= "\n";
	} else {
		print $empty; $empty = '';
		print encode_entities($_) . "\n";
	}
}

# 2.2  Close currently open block element
print $close;