Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help?? 
#!/usr/bin/perl -w
#conjugate.pl, v.1.0
#Created by John T. Wodder II
#Last edited: 21 Sept 2006 by John Wodder
#This script will create a synopsis of a Latin verb & output it as a L
+aTeX
#document.
use strict;
use Switch;

my($tmp, $base, $vowel, $vowel2, $stemTwo, $stemThree, $conj, $trans, 
+$first, $subj, $extPerson, $person, $personal, $passive, $perfect, $s
+um, $adj);

my %short = ('\\=o', 1, 'm', 1, 's', 0, 't', 1, 'mus', 0, 'tis', 0, 'n
+t', 1, 'r', 1, 'ris/re', 0, 'tur', 0, 'mur', 0, 'min\\=\\i', 0, 'ntur
+', 1, 'or', 1, 'te', 0);
my $word = qr/[[:alpha:]\\={}]+/;
my $long = qr/\\=\{?\\?([aeio])\{?\}?/i;
my $lineTerm = " \\\\\n";

sub append {
 my($pre, $post, $opt) = @_;
 # Bits guide for $opt:
 # 1 - Use 'm' instead of '\=o'
 # 2 - Use -i\=o & -iunt endings (Use is determined at runtime)
 # 4 - Use -int instead of -unt (only applies to fut. perf. act. indic
+.)
 $opt = 0 unless defined $opt;
 $post = 'm' if $post eq '\\=o' && ($opt & 1);
 if ($pre =~ /$long$/o) {
  $pre =~ s/$long$/$1/o if $short{$post};
  $pre =~ s/i$/iu/io if $post =~ /^nt/o && ($opt & 2);
  $pre =~ s/a$//io if $post =~ /^(\\=)?o/o;
 } else {
  $pre =~ s/e$/i/io;
  if ($post =~ /^nt/) {
   if ($opt & 2) {
    $pre =~ s/i$/iu/o;
   } elsif (!($opt & 4)) { # 4 applies to the fut. perf. act. indic.
    $pre =~ s/i$/u/o;
   }
  } elsif ($post =~ /^(\\=)?o/o && !($opt & 2)) {
   $pre =~ s/i$//o;
  } elsif ($post eq 'ris/re') {
   $pre =~ s/i$/e/io;
  }
 }
 print $pre, $post;
}

print "Enter the four principal parts of the verb you wish to conjugat
+e,\nseparated by spaces, with macrons denoted LaTeX-style:\nEnter `qu
+it' to exit.\n> ";
VERB: while (<STDIN>) {
 if (/^(($word)([ie]?)\\=o),?\s+\2(e|$long)re,?\s+($word)\\=\{?\\i\{?\
+}?,?\s+($word)us$/io) { # (\\=ur|\\=\{u\}r)?
  ($first, $base, $vowel, $stemTwo, $stemThree) = ($1, $2, $4, $6, $7)
+;
  $trans = $7 !~ /(\\=ur|\\=\{u\}r)$/i;
  $stemThree =~ s/(\\=ur|\\=\{u\}r)$//i unless $trans;
  switch ($vowel) {
   case m/^\\=\{?a\}?$/i {$conj = 1; $subj = '\\=e'; $vowel2 = '\\=a';
+ }
   case m/^\\=\{?e\}?$/i {$conj = 2; $subj = 'e\\=a'; $vowel2 = '\\=e'
+; }
   case m/^e$/i {($conj, $subj, $vowel2) = $3 ? (4, 'i\\=a', 'i\\=e') 
+: (3, '\\=a', '\\=e'); }
   case m/^\\=\{?\\i\{?\}?$/i {$conj = 5; $subj = 'i\\=a'; $vowel2 = '
+i\\=e'; }
   else {die("An error has occurred in parsing the stem vowel.\n"); }
  }
  last VERB;
 } elsif (/^($word)\\=\{?o\}?$/io) {
  my $a = $1;
  print 'Is the verb a standard first-conjugation verb? (y/n): ';
  $tmp = <STDIN>;
  if ($tmp =~ /^y/i) {
   ($base, $conj, $vowel, $subj, $trans, $stemTwo, $stemThree, $first,
+ $vowel2) = ($a, 1, '\\=a', '\\=e', 1, $a.'\\=av', $a.'\\=at', $a.'\\
+=o', '\\=a');
   last VERB;
  } else {print "Enter the four principal parts.\n"; }
 } elsif (/^q(uit)?$/io) {exit; }
 elsif ($_ eq "`quit'\n") {print "I didn't mean that literally.\n"; }
 else {print "Quid?\n"; }
 print '> ';
}

print "In what person & number do you wish to conjugate this verb?\n> 
+";
PERSON: while(defined($extPerson = <STDIN>)) {
 switch ($extPerson) {
  case /^(1(st)?|first)(\s*person)?,?\s*s(ing(\.|ular)?)?$/io {
   ($person, $personal, $passive, $perfect, $sum, $adj) = (0, '\\=o', 
+'r', '\\=\\i', 'sum', 'us/a/um');
   last PERSON;
  } case /^(2(nd)?|second)(\s*person)?,?\s*s(ing(\.|ular)?)?$/io {
   ($person, $personal, $passive, $perfect, $sum, $adj) = (1, 's', 'ri
+s/re', 'ist\\=\\i', 'es', 'us/a/um');
   last PERSON;
  } case /^(3(rd)?|third)(\s*person)?,?\s*s(ing(\.|ular)?)?$/io {
   ($person, $personal, $passive, $perfect, $sum, $adj) = (2, 't', 'tu
+r', 'it', 'est', 'us/a/um');
   last PERSON;
  } case /^(1(st)?|first)(\s*person)?,?\s*p(l(\.|ur(\.|al)?)?)?$/io {
   ($person, $personal, $passive, $perfect, $sum, $adj) = (3, 'mus', '
+mur', 'imus', 'sumus', '\\=\\i/ae/a');
   last PERSON;
  } case /^(2(nd)?|second)(\s*person)?,?\s*p(l(\.|ur(\.|al)?)?)?$/io {
   ($person, $personal, $passive, $perfect, $sum, $adj) = (4, 'tis', '
+min\\=\\i', 'istis', 'estis', '\\=\\i/ae/a');
   last PERSON;
  } case /^(3(rd)?|third)(\s*person)?,?\s*p(l(\.|ur(\.|al)?)?)?$/io {
   ($person, $personal, $passive, $perfect, $sum, $adj) = (5, 'nt', 'n
+tur', '\\=erunt', 'sunt', '\\=\\i/ae/a');
   last PERSON;
  } case /^q(uit)?$/io {exit; }
  else {print "Quid?\n"; }
 }
 print '> ';
}

my $file = $first;
$file =~ s/[\\={}]//g;
open(FILE, '>', "$file.tex");
select FILE;

print "\\documentclass{article}\\begin{document}\\title{Synopsis of \\
+emph{$first}, $extPerson}\\author{\\texttt{conjugate.pl}, v.1.0}\\mak
+etitle\n\\begin{center}\\begin{tabular}{l ", ($trans ? "c c}\n & \\te
+xtbf{Active} & \\textbf{Passive} \\\\ \\hline\n\\multicolumn{3" : "c}
+\n\\multicolumn{2"), "}{c}{\\textbf{Indicative Mood}} \\\\ \\hline\n"
+;

print 'Present & ', $base; 
append($vowel, $personal, ($conj>3) ? 2 : 0);
if ($trans) {
 print ' & ', $base;
 append($vowel, ($person==0) ? 'or' : $passive, ($conj>3) ? 2 : 0);
}

print $lineTerm, 'Imperfect & ', $base, $vowel2;
append('b\\=a', $personal, 1);
if ($trans) {
 print ' & ', $base, $vowel2;
 append('b\\=a', $passive);
}

print $lineTerm, 'Future & ', $base;
if ($conj < 3) {
 print $vowel;
 append('bi', $personal);
} else {
 append(($person==0) ? $subj : $vowel2, $personal, 1);
}
if ($trans) {
 print ' & ', $base;
 if ($conj < 3) {
  print $vowel;
  append('bi', ($person==0) ? 'or' : $passive);
 } else {
  append(($person==0) ? $subj : $vowel2, $passive);
 }
}

print $lineTerm, 'Perfect & ', $stemTwo, $perfect;
print ' & ', $stemThree, $adj, ' ', $sum if $trans;

print $lineTerm, 'Pluperfect & ', $stemTwo;
append('er\\=a', $personal, 1);
if ($trans) {
 print ' & ', $stemThree, $adj, ' ';
 append('er\\=a', $personal, 1);
}

print $lineTerm, 'Future Perfect & ', $stemTwo;
append('eri', $personal, 4);
if ($trans) {
 print ' & ', $stemThree, $adj, ' ';
 append('eri', $personal);
}

print $lineTerm, '\\multicolumn{', $trans+2, "}{c}{\\textbf{Subjunctiv
+e Mood}} \\\\ \\hline\n Present & ", $base;
append($subj, $personal, 1);
if ($trans) {
 print ' & ', $base;
 append($subj, $passive);
}

print $lineTerm, 'Imperfect & ', $base, $vowel;
append('r\\=e', $personal, 1);
if ($trans) {
 print ' & ', $base, $vowel;
 append('r\\=e', $passive);
}

print $lineTerm, 'Perfect & ', $stemTwo;
append('er\\=\\i{}', $personal, 1);
if ($trans) {
 print ' & ', $stemThree, $adj, ' ';
 append('s\\=\\i{}', $personal, 1);
}

print $lineTerm, 'Pluperfect & ', $stemTwo;
append('iss\\=e', $personal, 1);
if ($trans) {
 print ' & ', $stemThree, $adj, ' ';
 append('ess\\=e', $personal, 1);
}

print $lineTerm, '\\multicolumn{', $trans+2, "}{c}{\\textbf{Infinitive
+s}} \\\\ \\hline\n Present & ", $base, $vowel, 're';
print ' & ', $base, ($conj != 3 && $conj != 4) ? ($vowel, 'r\\=\\i') :
+ '\\=\\i' if $trans;

print $lineTerm, 'Perfect & ', $stemTwo, 'isse';
print ' & ', $stemThree, 'us/a/um esse' if $trans;

print $lineTerm, 'Future & ', $stemThree, '\\=urus/a/um esse';
print ' & ---' if $trans;

print $lineTerm, '\\multicolumn{', $trans+2, "}{c}{\\textbf{Participle
+s}} \\\\ \\hline\n Present & ", $base, $vowel2, 'ns, -';
$vowel2 =~ s/\\=//;
print $vowel2, 'ntis';
print ' & ---' if $trans;

print $lineTerm, 'Perfect & ---';
print ' & ', $stemThree, 'us/a/um' if $trans;

print $lineTerm, 'Future & ', $stemThree, '\\=urus/a/um';
print ' & ', $base, $vowel2, 'ndus/a/um' if $trans;

print $lineTerm, '\\multicolumn{', $trans+2, "}{c}{\\textbf{Imperative
+s}} \\\\ \\hline\n & ", $base, $vowel, ', ', $base;
append($vowel, 'te');
if ($trans) {
 print ' & ', $base, $vowel, 're, ', $base;
 append($vowel, 'min\\=\\i');
}

if ($trans) {
 print <<EOT;
$lineTerm & \\textbf{Gerunds} & \\textbf{Supines} \\\\ \\hline
Genitive & $base${vowel2}nd\\=\\i & --- \\\\
Dative & $base${vowel2}nd\\=o & --- \\\\
Accusative & $base${vowel2}ndum & ${stemThree}um \\\\
Ablative & $base${vowel2}nd\\=o & ${stemThree}\\=u \\\\
EOT
} else {
 print <<EOT;
$lineTerm \\multicolumn{2}{c}{\\textbf{Gerunds}} \\\\ \\hline
Genitive & $base${vowel2}nd\\=\\i \\\\
Dative & $base${vowel2}nd\\=o \\\\
Accusative & $base${vowel2}ndum \\\\
Ablative & $base${vowel2}nd\\=o \\\\
\\multicolumn{2}{c}{\\textbf{Supines}} \\\\ \\hline
Accusative & ${stemThree}um \\\\
Ablative & ${stemThree}\\=u \\\\
EOT
}

print '\\end{tabular}\\end{center}\\end{document}';
close; select STDOUT;
print "Done!\nThe synopsis has been saved to $file.tex.\nWould you lik
+e to typeset it now? (y/n): ";
$tmp = lc getc;
if ($tmp eq 'y') {
 system("pdflatex $file.tex"); # NOT pdfetex
 system("open $file.pdf") unless $?;
}

[download]

In reply to Latin Verb Conjugator by Minimiscience

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
    • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Domain Nodelet?

    www.com | www.net | www.org
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? • Last hour • Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (4)
    As of 2024-09-14 21:59 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      The PerlMonks site front end has:





      Results (21 votes). Check out past polls.
      Notices?
      • erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.