#!/usr/bin/perl -w

use strict;

=cut

Skript pro transformaci seznamu slovíček na TeXovský zdroják, po jehož
překladu dostaneme soubor s tabulkami "kartiček". Skript je pro latinu, v
případě použití pro jiná slovíčka by se musely smazat tři řádky za
komentářem "# Změna čárek na vodorovné" (a případně nahradit něčím
specifickým pro daný jazyk).

Na vstupu očekává soubor v následujícím formátu: Jednotlivá slovíčka jsou na
samostatných řádcích, vlevo cizí slovo (s případnými gramatickými
informacemi), pak tabelátor a za ním český ekvivalent. Jednotlivé lekce jsou
od sebe odděleny volným řádkem, na začátku každé lekce je komentář (uvozený
znakem #), který bude použit jako její jméno. Pokud text slovíčka, resp.
českého překladu obsahuje zpětné lomítko, bude v tomto místě rozdělen na dva
řádky (nutné u textů, které by přesáhly délku kartičky). Je možné použít
pouze jedno zpětné lomítko. Pro vysázení znaku zpětného lomítka je nutné jej
zdvojit, není možné chtít vysázet zpětné lomítko těsně před nebo za zlomem
řádku.

Na výstup je vypsán příslušný soubor pro (csplain/pdfcsplain) TeX. Slovíčka
jsou vypisována po lekcích, v rámci lekcí náhodně, důvody viz www.

Specifické pro latinu: délka v latinských slovech se vyznačuje normální
(šikmou) čárkou. V případě nějakého českého vysvětlujícího textu na levé
straně od tabelátoru je vhodné volit slova bez dlouhých samohlásek, tyto by
byly převedeny na "latinské".

=cut

# Dřívější verze zřejmě neumějí (?<!...) v RE 
require 5.6.1;

# Začátek TeXovského souboru
print <<'EOF';
% Soubor kartiček se slovíčky, generováno automaticky, více viz skript
% slovicka.pl a www.
%
% Soubor je tvořen dvojicemi stránek, vždy stránka s tabulkou (dvěma
% tabulkami) cizích slovíček a odpovídající stránka s tabulkou (dvěma
% tabulkami) českých slovíček. Každá dvojice se bude tisknout na dvě strany
% jednoho papíru, který musí být možné rozstříhat na kartičky. Umístění
% tabulek tedy musí být shodné v obou stranách každé dvojice. Připomínáme,
% že oboustranný tisk je podle kratší strany, stránky jsou tedy navzájem
% "naopak".
%
% Na začátek každé stránky cizích slovíček a případně i uvnitř stránky při
% změně lekce chceme pro přehlednost tisknout jméno lekce. Protože česká
% stránka je "naopak", odpovídající prostor je POD odpovídající tabulkou a
% nemá tedy smysl do něj také tisknout jméno lekce, ale musí zůstat prázdný.
% Aby byl zachována přesnost soutisku, je nutné zjistit, jakou výšku má
% jméno lekce na první stránce, aby bylo možné vynechat přesně stejný
% prostor i na stránce druhé. Proto je před tiskem jména lekce počítána jeho
% výška a ukládána do \dimen1 případně \dimen2. \dimen0 má zřejmě nějaký
% speciální význam, protože nezvládlo být globální.
%
% Nepřišel jsem na jiný způsob tisku do přesného středu, než roztažení
% stránky na celou A4 a tisku do \vboxů resp. \hboxů velikosti \vsize resp.
% \hsize a použití \vfil resp. \hfil. \offinterlineskip musíme použít, aby
% se TeX nesnažil upravovat mezery mezi řádky.
\voffset -1in
\hoffset -1in
\hsize 210mm
\vsize 297mm
%
% Čísla stránek nechceme
\nopagenumbers
%
% "Na" první stránce budeme nastavovat proměnné \dimen1 případně \dimen2,
% jejichž hodnoty budeme chtít použít "na" druhé stránce. Abychom nemuseli
% před každou změnou hodnoty psát \global, použijeme:
\globaldefs = 1
%
EOF

# Začátek českých (druhých) stránek
sub zacatek_ceske_stranky ($) {
	my $cislo_stranky = shift;
	my $sablona = <<'EOF';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% STRANKA. česká stránka (CELKEM. celkem)
%
\vbox to \vsize {
\offinterlineskip
\vfil
EOF
	$sablona =~ s/STRANKA/$cislo_stranky/s;
	$sablona =~ s/CELKEM/$cislo_stranky * 2/se;
	return $sablona;
	}

my $konec_stranky = "\\vfil}\n\\eject\n%\n";

# Rozměry políčka tabulky/kartičky
my $height = "0.425in";
my $width = "1.8in";

my $zacatek_tabulky = <<'EOF';
\hrule
\hbox to \hsize {
	\hfil
	\vbox{\offinterlineskip \halign{\vrule
		\vbox to HEIGHT {\vfill \hbox to WIDTH {\hfill \bf #\hfill }\vfill }\vrule &
		\vbox to HEIGHT {\vfill \hbox to WIDTH {\hfill \bf #\hfill }\vfill }\vrule &
		\vbox to HEIGHT {\vfill \hbox to WIDTH {\hfill \bf #\hfill }\vfill }\vrule &
		\vbox to HEIGHT {\vfill \hbox to WIDTH {\hfill \bf #\hfill }\vfill }\vrule \cr
EOF

$zacatek_tabulky =~ s/HEIGHT/$height/sg;
$zacatek_tabulky =~ s/WIDTH/$width/sg;

my $konec_tabulky = "\t}}\n\t\\hfil}\n";

# Pokud argument obsahuje zpětné lomítko, rozdělíme podle něj řádky a
# vrátíme je ve tvaru příslušného TeXovského vstupu.
sub rozdel_radky ($) {
	my $text = shift;

	# Argument žádné zpětné lomítko neobsahuje, neděláme nic
	return $text unless $text =~ /\\/;

	# Argument obsahuje jen zdvojená zpětná lomítka, nahradíme
	unless ($text =~ /[^\\]\\[^\\]/) {
		$text =~ s/\\\\/\$\\backslash\$/g;
		return $text;
		}

	# Chceme dělit na dva řádky
	die "$_: nelze dělit na více než dva řádky\n"
		if $text =~ /[^\\]\\(?!\\)(?:[^\\]|\\\\)+(?<=\\)\\[^\\]/;
	my ($prvni, $druhy) = split /(?<!\\)\\(?!\\)/, $text;
	$prvni =~ s/\\\\/\$\\backslash\$/g;
	$druhy =~ s/\\\\/\$\\backslash\$/g;

	# Vracíme vbox se dvěma hboxy, musíme ho roztáhnout na rozměry
	# políčka a dělat *fill teprve uvnitř, protože bez pevných rozměrů
	# by *fill neměl žádaný efekt (TeX udělá box veliký, jak je potřeba,
	# a nic nenatahuje).
	return "\\vbox to $height {\\vfill " .
		"\\hbox to $width {\\hfill $prvni\\hfill}" . 
		"\\hbox to $width {\\hfill $druhy\\hfill}" .
		"\\vfill}";
	}

# Při změně těchto konstant bude patrně potřeba změnit i velikost "buněk" se
# slovíčky o pár řádků výše
my $slovicek_na_karticku = 3;
my $karticek_na_radek = 4;
my $radku_na_stranku = 8;

my $slovicek_na_radek = $karticek_na_radek * $slovicek_na_karticku;
my $volnych_radku = $radku_na_stranku;

# První stránku budeme tisknout rovnou, druhou si musíme pamatovat (tvoříme
# ji od konce).
my $druha = '';

# Abychom mohli slovíčka vypisovat náhodně, musíme načítat po lekcích.
$/ = "\n\n";

# Tato proměnná bude indikovat začátek stránky nebo lekce a tedy potřebu
# tisknout jméno lekce
my $tisknout_jmeno_lekce = 1;

# Počitadlo stránek, pro zpřehlednění výstupu
my $cislo_stranky = 1;

while (<STDIN>) {
	s/\s*$//s;

	# Jméno lekce nesmí chybět
	s/^#\s*([^\n]*)\n//s or die;
	my $jmeno_lekce = $1;

	my (@cizi, @ceska);
	foreach (split /\n/, $_) {
		my ($cizi, $ceske) = split /\t/;
		die $cizi unless defined $ceske;

		$cizi = rozdel_radky $cizi;
		$ceske = rozdel_radky $ceske;

		# Změna čárek na vodorovné, specifické pro latinu
		$cizi =~ s/([áéíóúý])/\\=$1/g;
		$cizi =~ tr/áéóúý/aeouy/;
		$cizi =~ s/í/\\i /g;

		push @cizi, $cizi;
		push @ceska, $ceske;
		}
	
	# V tomto cyklu zmenšeno odsazování...
	while (@cizi) {

	    # Začíná buďto nová stránka nebo nová lekce
	    if ($tisknout_jmeno_lekce) {

		# Začínáme novou stránku
		if ($volnych_radku == $radku_na_stranku) {
		    my $sablona = <<'EOF';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% STRANKA. cizí stránka (CELKEM. celkem)
%
\vbox to \vsize {
\offinterlineskip
\vfil
\setbox1 = \hbox {\bf LEKCE}
\dimen1 = \dp1
\advance\dimen1\ht1
\advance\dimen1 1pt
\hbox to \hsize {\hfil \box1 \hfil}
\vskip 1pt
EOF
		    $sablona =~ s/STRANKA/$cislo_stranky/s;
		    $sablona =~ s/CELKEM/$cislo_stranky * 2 - 1/se;
		    $sablona =~ s/LEKCE/$jmeno_lekce/s;
		    print $sablona;
		    $druha = "\\vskip \\dimen1\n$konec_stranky";
		    }

		# Pokračujeme ve staré
		else {
		    my $sablona = <<'EOF';
\vskip 1pt
\setbox2 = \hbox {\bf LEKCE}
\dimen2 = \dp2
\advance\dimen2\ht2
\advance\dimen2 2pt
\hbox to \hsize {\hfil \box2 \hfil}
\vskip 1pt
EOF
		    $sablona =~ s/LEKCE/$jmeno_lekce/s;
		    print $sablona;
		    $druha = "\\vskip \\dimen2\n$druha";
		    }

		# V každém případě začínáme novou tabulku
		print $zacatek_tabulky;
		$druha = "$konec_tabulky$druha";

		$tisknout_jmeno_lekce = 0;
		}

	    # Tvorba jednoho řádku
	    my (@cizi_radek, @cesky_radek);
	    my $kolikata_karticka_radku = 1;
	    while ($kolikata_karticka_radku <= $karticek_na_radek) {

		# Tvorba jedné kartičky
		my $kolikate_slovicko_karticky = 1;
		while ($kolikate_slovicko_karticky <= $slovicek_na_karticku) {

		    # Náhodný výběr. Pokud dojdou slovíčka uprostřed řádku
		    # či kartičky, budeme pokračovat prázdnými políčky
		    my $dalsi = @cizi ? int rand @cizi : 0;
		    my $cizi = @cizi ? splice(@cizi, $dalsi, 1) : '';
		    my $ceske = @ceska ? splice(@ceska, $dalsi, 1) : '';

		    # Česká slovíčka by se měla dávat naopak (jako index by
		    # se mělo vzít 4 - $kolikate_slovicko_karticky). Pak by
		    # si políčka tabulky přesně odpovídaly (propíchnu papír
		    # špendlíkem a jsem vždy na odpovídajícím překladu). My
		    # ale chceme mít na kartičce tři slovíčka tak, že po
		    # otočení jsou stále ve stejném pořadí (tedy jen
		    # prostřední půjde "propíchnout špendlíkem"). Proto se
		    # česká slovíčka dávají ve stejném pořadí jako cizí.
		    my $tmp;
		    $tmp = \$cizi_radek[$kolikate_slovicko_karticky];
		    $$tmp .= (defined $$tmp ? '&' : '') . $cizi;
		    $tmp = \$cesky_radek[$kolikate_slovicko_karticky];
		    $$tmp .= (defined $$tmp ? '&' : '') . $ceske;

		    $kolikate_slovicko_karticky++;
		    }
		$kolikata_karticka_radku++;
		}

	    # Ukončení řádku
	    foreach (1 .. $slovicek_na_karticku) {
		$cizi_radek[$_]
			= "\t$cizi_radek[$_]\\cr \\noalign{\\hrule}\n";
		$cesky_radek[$_]
			= "\t$cesky_radek[$_]\\cr \\noalign{\\hrule}\n";
		}

	    # Tisk vytvořeného řádku (musíme indexovat, jinak bychom tiskli
	    # nedefinovaný nultý prvek
	    print join '', @cizi_radek[1 .. $slovicek_na_karticku];
	    $druha = (join '', @cesky_radek[1 .. $slovicek_na_karticku])
			. $druha;

	    $volnych_radku--;

	    # Pokud jsme na konci strany, musíme ukončit tabulku i stránku
	    if ($volnych_radku == 0) {
		print "$konec_tabulky$konec_stranky";
		print zacatek_ceske_stranky $cislo_stranky;
		print "$zacatek_tabulky$druha";
		$cislo_stranky++;
		$tisknout_jmeno_lekce = 1;
		$volnych_radku = $radku_na_stranku;
		}
	    }		

	# Tabulku musíme ukončit, pokud jsme tak již neučinili koncem stránky
	if ($volnych_radku != $radku_na_stranku) {
		print $konec_tabulky;
		$druha = "$zacatek_tabulky$druha";
		}

	$tisknout_jmeno_lekce = 1;
	}

# Musíme ukončit stránku (a flushnout druhou), pokud jsme tak již neučinili
if ($volnych_radku != $radku_na_stranku) {
	print $konec_stranky;
	print zacatek_ceske_stranky $cislo_stranky;
	print $druha;
	}

# Konec TeXovského souboru
print "\\end\n";
