﻿#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use open qw(:std :utf8);
use integer;


# Song_lb-einfuegen.pl
# 2010-10-20
# Wolfgang Schmidle


my $width = 21;


# text input

my @text;
while(<>) { push @text, $_; }


# go through the text

my $inP = 0;
my $i = 0;
my $vor = "";
my $s = "";
my $nach = "";
my $nurZeichen = "";
my $zaehler = 0;
my $zeichenInZeile = 0;

my $inSm = 0;

LINE: foreach (@text) {

	$i++;

	if (m!<p[ >]!) { 
		$inP = 1; 
		$zaehler = 0;
		print;
		next; 
	}
	
	if (m!</p>!) { $
		inP = 0; 
		print;
		next;
	}
	
	unless ($inP) {
		print;
		next;
	}
	
	# Hack für small text
	
	if (m!<s>\(</s>!) {
		$inSm = 1;
		print;
		next;
	}
	if (m!<s>\)</s>!) {
		$inSm = 0;
		if ($zaehler % 2 == 1) { $zaehler++; }
		print;
		next;
	}
	
	# <pb> in eigener Zeile, also zwischen zwei <s>:
	
	if (m!\t<pb!) {
		unless ($zaehler == 0) { die "falsche Zeilenlänge: $zaehler\n"; }
		$zaehler = 0;
		print;
		next;
	}
	
	if (m/^[ \t]*<!--/) {
		print;
		next;
	}
	
	if (m/<anchor /) {
		print;
		next;
	}
	
	chomp;

	# Schließe Absätze aus, die nicht geradlinig sind 

	if (m!<lb/>!) { die "(p mit lb)\n\n"; }
	if (m!style="sm"!) { die "(p mit style=\"sm\")\n\n"; }
	unless (m!<s[^>]*>.+</s>!) { die "(seltsam geformter Absatz)\n\n"; }
	
	m!(^.*<s[^>]*>)(.+?)(</s>.*$)!;
	
	$vor = $1;
	$s = $2;
	$nach = $3;
	$nurZeichen = $s;
	$nurZeichen =~ s!<place [^>]+>!!g;
	$nurZeichen =~ s!</place>!!g;
	$nurZeichen =~ s!<reg [^>]+>!!g;
	$nurZeichen =~ s!</reg>!!g;
	$nurZeichen =~ s![。！？，、：；《》“”\x{200B}., ]!!g;
	$nurZeichen =~ s!\[(.)V\]!$1!g;
	$nurZeichen =~ s!\[(.)R\]!$1!g;

	if ($nurZeichen =~ m!(.+)<pbfile="X0601\d\d\d[AB]"[^>]+>(.+)!) {

		my $laenge = length $1;
		unless ($inSm) { $laenge *= 2; } 
		unless (($zaehler + $laenge + 1) / 2 == $width) { die "falsche Zeilenlänge: ($zaehler + $laenge) / 2\n"; }
		$zaehler = length $2;
		unless ($inSm) { $zaehler *= 2; } 		
		print "$_\n";
		next;
	}

#	if ($s =~ m!<!) { die "Unterelement in <s>\n"; }
# <place> ist erlaubt
	
	
	$zeichenInZeile = length $nurZeichen;
	unless ($inSm) { $zeichenInZeile *= 2; }
	
	if ($zeichenInZeile >= 2 * $width) { die "zu langes <s>:\n$nurZeichen\n"; }
	
#	if ($zaehler + $zeichenInZeile < 2 * $width) {

	my $lastLineInSm = (($inSm && $text[$i] =~ m!<s>\)</s>!) ? 1 : 0);

	if (($lastLineInSm == 0 && $zaehler + $zeichenInZeile < 2*$width) ||
		($lastLineInSm == 1 && $zaehler + $zeichenInZeile + 1 < 2*$width)) {
		$zaehler += $zeichenInZeile;
		print "$_\n";
		next;
	}
	
	if (($lastLineInSm == 0 && $zaehler + $zeichenInZeile == 2*$width) ||
		($lastLineInSm == 1 && $zaehler + $zeichenInZeile == 2*$width) ||
		($lastLineInSm == 1 && $zaehler + $zeichenInZeile + 1 == 2*$width)) {
		$zaehler = 0;
		unless ($text[$i] =~ m!\t<pb!) {
			s!</s>!<lb/></s>!;
		}
		print "$_\n";
		next;
	}

	# We have identified a line where <lb/> needs to be inserted; now identify the correct position.

	$s = "<lb/>" . $s;
	
	while ($zaehler < 2 * $width) {
		next if $s =~ s!<lb/>([。！？，、：；《》“”\x{200B}., \[\]VR])!$1<lb/>!;
		next if $s =~ s!<lb/>(<place [^>]+>|</place>)!$1<lb/>!;
		next if $s =~ s!<lb/>(<reg [^>]+>|</reg>)!$1<lb/>!;
		
		$s =~ s!<lb/>(.)!$1<lb/>!;
		$zaehler++;
		unless ($inSm) { $zaehler++; }
		$zeichenInZeile--;
		unless ($inSm) { $zeichenInZeile--; }		
	}
	1 while ($s =~ s!<lb/>([。！？，、：；》”\x{200B}., \]VR]|</place>|</reg>)!$1<lb/>!); # without “,《, [, <place, <reg
	print "$vor$s$nach\n";
	$zaehler = $zeichenInZeile;	

# 	while ($s =~ m!([^。！？，、：；《》“”\x{200B}., \]\]VR]|<place [^>]+>|</place>|<reg [^>]+>|</reg>)!g) { 
# 		$zaehler++;
# 		unless ($inSm) { $zaehler++; }
# 		$zeichenInZeile--;
# 		unless ($inSm) { $zeichenInZeile--; }
# 		if ($zaehler == 2 * $width) {
# 			substr ($s, pos $s, 0) = "<lb/>";
# 			1 while ($s =~ s!<lb/>([。！？，、：；《》“”\x{200B}., \]\]VR]|</place>|</reg>)!$1<lb/>!);
# 			print "$vor$s$nach\n";
# 			$zaehler = $zeichenInZeile;	
# 			next LINE;
# 		}	
# 	}

}

# TO DO:
# figures im Absatz, z.B. Absatz Seite 39 - 46
# <pb> zwischen <s>: erledigt
# unnötiger <lb/> am Ende eines Absatzes, wenn die Zeile genau aufgeht: muss man bisher am Ende per Hand korrigieren

# Zeichen einfügen/löschen sollte idealerweise im Rohtext gehen, und die Änderungen werden dann automatisch in das XML übertragen
# Unterfunktion des Skriptes, mit dem man interatkiv Textänderungen in eine bestehende XML-Struktur einfügen kann,
# siehe neues OCR des Abruzzen-Textes
# Schwierigkeiten: neues Zeichen im oder nach <place>? was passiert, wenn das einzige Zeichen in <place> gelöscht wird? etc.

# Rohtext erstellen: optimal wäre eine senkrechte Anzeige der Spalten!

# Lücke in small text: etwas anderes als Satzkringel verwenden!

# Seite 41: 4 small Zeichen (statt 2) im Platz von einem großen Zeichen (hinter N400764); das bringt die Rohtextanzeige durcheinander,
# und die <lb> können nicht gut automatisch eingefügt werden. Das Problem wäre in manchen Büchern sogar noch schlimmer.
# immerhin: wenn sie mal drin sind, ist es okay, weil das Anzeigesystem halt da Zeilenumbrüche macht, wo ein <lb> ist
