File Coverage

blib/lib/Lingua/Zompist/Cadhinor.pm

Criterion	Covered	Total	%
statement	190	202	94.0
branch	150	168	89.2
condition	201	270	74.4
subroutine	16	16	100.0
pod	13	13	100.0
total	570	669	85.2

package Lingua::Zompist::Cadhinor;

use 5.005;
use strict;

require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %verb);
@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Lingua::Zompist::Cadhinor ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = (
  'all' => [ qw(
    demeric
    scrifel
    izhcrifel
    budemeric
    buscrifel
    bubefel
    dynamic
    part
    noun
    adj
    comp
    super
    adv
  ) ],
  'verb' => [ qw(
    demeric
    scrifel
    izhcrifel
    budemeric
    buscrifel
    bubefel
    dynamic
    part
  ) ],
  'nonverb' => [ qw(
    noun
    adj
    comp
    super
    adv
  ) ],
);

@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} }, '%verb' );

@EXPORT = qw(

);
$VERSION = '0.92';

%verb = (
  static => {
    prilise => {
      demeric   => \&demeric,
      scrifel   => \&scrifel,
      izhcrifel => \&izhcrifel,
      befel     => sub { return; }, # no definite imperative
    },
    buprilise => {
      demeric   => \&budemeric,
      scrifel   => \&buscrifel,
      izhcrifel => sub { return; }, # no remote past anterior
      befel     => \&bubefel,
    },
  },
# dynamic => \&dynamic
  dynamic => {
    prilise => {
      demeric   => sub { dynamic( $_[0], 'prilise', 'demeric' ); },
      scrifel   => sub { dynamic( $_[0], 'prilise', 'scrifel' ); },
      izhcrifel => sub { dynamic( $_[0], 'prilise', 'izhcrifel' ); },
      befel     => sub { return; }, # no definite imperative
    },
    buprilise => {
      demeric   => sub { dynamic( $_[0], 'buprilise', 'demeric' ); },
      scrifel   => sub { dynamic( $_[0], 'buprilise', 'scrifel' ); },
      izhcrifel => sub { return; }, # no remote past anterior
      befel     => \&bubefel, # same for static and dynamic aspects
    },
  },
  part => \&part,
);

# Set up aliases
{
  my($aspect, $mood, $tense);

  $verb{'nuncre'} = $verb{'static'};
  $verb{'olocec'} = $verb{'dynamic'};

  for $aspect (qw(static dynamic)) {
    $verb{$aspect}{definite} = $verb{$aspect}{prilise};
    $verb{$aspect}{remote}   = $verb{$aspect}{buprilise};

    for $mood (qw(prilise buprilise)) {
      $verb{$aspect}{$mood}{'present'}       = $verb{$aspect}{$mood}{demeric};
      $verb{$aspect}{$mood}{'past'}          = $verb{$aspect}{$mood}{scrifel};
      $verb{$aspect}{$mood}{'pastanterior'}  =
      $verb{$aspect}{$mood}{'past anterior'} = $verb{$aspect}{$mood}{izhcrifel};
      $verb{$aspect}{$mood}{'imperative'}    = $verb{$aspect}{$mood}{befel};
    }

    for $tense (qw(demeric scrifel izhcrifel
                   present past pastanterior), 'past anterior') {
      $verb{$aspect}{$tense} = $verb{$aspect}{definite}{$tense};
    }

    for $tense (qw(befel imperative)) {
      $verb{$aspect}{$tense} = $verb{$aspect}{remote}{$tense};
    }
  }

  for $mood (qw(prilise buprilise definite remote)) {
    $verb{$mood} = $verb{static}{$mood};
  }

  for $tense (qw(demeric scrifel izhcrifel
                 present past pastanterior), 'past anterior') {
    $verb{$tense} = $verb{static}{definite}{$tense};
  }

  for $tense (qw(befel imperative)) {
    $verb{$tense} = $verb{static}{remote}{$tense};
  }
}


# Verbs borrowed form other languages, and thus not subject to
# stem-changing rules
my %borrowed = (
  'DEBUTAN' => 1,   # Mark says these two don't change;
  'NACITAN' => 1,   # however, I don't know why not.
  'ONOTER'  => 'Cuêzi o:inote',
);

# Fricativised versions of consonants
my %fric = (
  'T' => 'TH',
  'D' => 'DH',
  'P' => 'F',
);

my $far = qr/^FAR$/;
my $kes = qr/^KES$/;
my $nen = qr/^NEN$/;

my @persons = qw(SEO LET TU   TAS MUKH CAI);

my @cases = qw(nom gen acc dat abl);

my @numbers = qw(sing pl);

my %present = (
  EC  => [ qw( AO EOS ES OM OUS ONT ) ],
  AN  => [ qw( AI EIS ET AM  US ONT ) ],
  EN  => [ qw( AI EIS ET EM  ES ENT ) ],
  ER  => [ qw( U  EUS ET UM  US UNT ) ],
  IR  => [ qw( U  EUS IT UM  US INT ) ],
  dyn => [ qw( UI UIS UT IM  IS INT ) ],
);

my %past = (
  EC  => [ qw( I  IUS U   UM  US IUNT ) ],
  AN  => [ qw( IO IOS AE UOM UOS IONT ) ],
  EN  => [ qw( IO IOS AE UOM UES IONT ) ],
  ER  => [ qw( IE IES E   EM  ES IENT ) ],
  IR  => [ qw( IE IES AE  EM  ES IENT ) ],
);


my %demeric = (
  ESAN    => [ qw( SAI     SEIS   ES     ESAM    ESOS     SONT     ) ],
  EPESAN  => [ qw( EUSAI   EUSEIS EPES   EPESAM  EPESOS   EUSONT   ) ],
  CTANEN  => [ qw( CTAI    CTES   CTET   CTANAM  CTANUS   CTANONT  ) ],
# FAR     => [ qw( FAEO    FAES   FAET   FASCOM  FASCOUS  FASCONT  ) ],
  FAR     => [ qw( FAEU    FAES   FAET   FASCOM  FASCOUS  FASCONT  ) ],
  IUSIR   => [ qw( IUSU    IUS    IUT    IUSUM   IUSUS    IUINT    ) ],
  LIUBEC  => [ qw( LIUO    LIUOS  LIUS   LIUBOM  LIUBOUS  LIUBONT  ) ],
  KETHEN  => [ qw( KETHUI  KETHUS KETHUT KETHEM  KETHES   KENT     ) ],
  CULLIR  => [ qw( CULLU   CULS   CULT   CULLUM  CULLUS   CULLINT  ) ],
  OHIR    => [ qw( OHU     UIS    UIT    OHUM    OHUS     OHINT    ) ],
  SCRIFEC => [ qw( SCRIFAO SCRIS  SCRIT  SCRIFOM SCRIFOUS SCRIFONT ) ],
  NEN     => [ qw( NEI     NIS    NIT    NESEM   NESES    NENT     ) ],
  KES     => [ qw( KEAI    KIES   KIET   KEHAM   KEHUS    KEHONT   ) ],
# VOLIR   => [ qw( VULU    VUIS   VUIT   VOLUM   VOLUS    VOLINT   ) ],
  VOLIR   => [ qw( VULU    VULS   VULT   VOLUM   VOLUS    VOLINT   ) ],
  FAUCIR  => [ qw( FAU     FEUS   FEUT   FAUCUM  FAUCUS   FAUCINT  ) ],
  FAILIR  => [ qw( FAILU   FELS   FELT   FAILUM  FAILUS   FAILINT  ) ],
);

sub demeric {
  my $verb = shift;
  my $stem = $verb;
  my $table;

  return $demeric{$verb} if exists $demeric{$verb};

ENDING:
  for my $ending ( keys %present ) {
    if(substr($stem, -2, 2) eq $ending) {
      substr($stem, -2, 2) = '';
      $table = [ map "$stem$_", @{$present{$ending}} ];
      last ENDING;
    }
  }

  # Stem change
  if($verb =~ /[AEIOU][TDP][IE]R$/ && !exists $borrowed{$verb} &&
     ($verb !~ /ATIR$/ || $verb eq 'CLATIR')) {
    for(@$table) {
      s/([TDP])(U(?:[MS]|NT)?)$/$fric{$1}$2/;
    }
  }

  return $table;
}

my %scrifel = (
  ESAN   => [ qw( FUIO       FUIOS   FUAE FUOM    FUOS    FUNT     ) ],
  EPESAN => [ qw( EUSIO      EUSIOS  EPAE EUSUOM  EUSUOS  EUSIONT  ) ],
# KETHEN => [ qw( KIO/KETHIO KETHIOS KIAE KETHUOM KETHUES KIONT    ) ],
  KETHEN => [ qw( KIO/KETHIO KETHIOS KIAE KETHUOM KETHUES KETHIONT ) ],
  NEN    => [ qw( NIO        NIOS    NAE  NESUOM  NESUES  NIONT    ) ],

  # semi-regular: FAR is like FASCEC, KES like KAIVAN
  FAR    => [ qw( FASCI  FASCIUS FASCU  FASCUM  FASCUS  FASCIUNT ) ],
  KES    => [ qw( KAIVIO KAIVIOS KAIVAE KAIVUOM KAIVUOS KAIVIONT ) ],
);

sub scrifel {
  my $verb = shift;
  my $stem = $verb;
  my $table;

  return $scrifel{$verb} if exists $scrifel{$verb};

ENDING:
  for my $ending ( keys %past ) {
    if(substr($stem, -2, 2) eq $ending) {
      substr($stem, -2, 2) = '';
      $table = [ map "$stem$_", @{$past{$ending}} ];
      last ENDING;
    }
  }

  # Stem change
  if($verb =~ /[AEIOU][TDP]EC$/ && !exists $borrowed{$verb}) {
    for(@$table) {
      s/([TDP])(U[MS]?)$/$fric{$1}$2/;
    }
  }

  return $table;
}

my %izhcrifel = (
  ESAN   => [ qw( FURIO   FURIOS   FURAE  FUROM   FUROS   FURIONT ) ],
  EPESAN => [ qw( EUSERIO EUSERIOS EPERAE EUSEROM EUSEROS EUSERIONT ) ],
);

sub izhcrifel {
  my $verb = shift;
  my $stem = $verb;
  my $table;

  return $izhcrifel{$verb} if exists $izhcrifel{$verb};

  if($stem =~ s/$far/FASCER/o ||
     $stem =~ s/([BPDTGKCFVRSZMNL]|[TDK]?H)REC$/$1$1ER/ ||
     $stem =~ s/EC$/ER/) {
    $table = [ map "$stem$_", @{$past{EC}} ];
  } elsif($stem =~ s/$kes/KAIVER/o ||
          $stem =~ s/([BPDTGKCFVRSZMNL]|[TDK]?H)RAN$/$1$1ER/ ||
          $stem =~ s/AN$/ER/) {
    $table = [ map "$stem$_", @{$past{AN}} ];
    for(@$table) {
      s/UOM$/OM/;
      s/UOS$/OS/;
    }
  } elsif($stem =~ s/$nen/NESER/o ||
          $stem =~ s/([BPDTGKCFVRSZMNL]|[TDK]?H)REN$/$1$1ER/ ||
          $stem =~ s/EN$/ER/) {
    $table = [ map "$stem$_", @{$past{EN}} ];
    for(@$table) {
      s/UOM$/OM/;
      s/UES$/ES/;
    }
  } elsif($stem =~ s/([BPDTGKCFVRSZMNL]|[TDK]?H)RER$/$1$1IR/ ||
          $stem =~ s/ER$/IR/) {
    $table = [ map "$stem$_", @{$past{ER}} ];
    s/U(O[SM])$/$1/ for @$table;
  } elsif($stem =~ s/([BPDTGKCFVRSZMNL]|[TDK]?H)RIR$/$1$1IR/ ||
          $stem =~ m/IR$/) {
    $table = [ map "$stem$_", @{$past{IR}} ];
    s/U(ES|OM)$/$1/ for @$table;
  } else {
    return;
  }

  return $table;
}

sub budemeric {
  my $verb = shift;
  my $stem = $verb;

  return [ map "EST$_", qw( AO EIS ES OM OS ONT ) ] if $verb eq 'ESAN';

  if($stem =~ s/$far/FASS/o ||
     $stem =~ s/^CURREC$/CORS/) {
    return [ map "$stem$_", @{$present{EC}} ];
  } elsif($stem =~ s/^METTAN$/MESS/ ||
          $stem =~ s/^DAN$/DON/ ||
          $stem =~ s/^PU([GH])AN$/PO$1/ ||
          $stem =~ s/^BRIGAN$/BROG/ ||
          $stem =~ s/^SUBRAN$/SOBR/ ||
          $stem =~ s/^LEGAN$/LOG/ ||
          $stem =~ s/^LAUDAN$/LOD/ ||
          $stem =~ s/^KUSAN$/KOSS/) {
    return [ map "$stem$_", @{$present{AN}} ];
  } elsif($stem =~ s/^([DKL]E|TO)SCEN$/$1SS/ ||
          $stem =~ s/^(DES|FER)IEN$/$1S/ ||
          $stem =~ s/^LEILEN$/LELS/ ||
          $stem =~ s/^KETHEN$/KOTH/) {
    return [ map "$stem$_", @{$present{EN}} ];
  } elsif($stem =~ s/^([SV])ALTER$/$1ELS/ ||
          $stem =~ s/^STERER$/STERS/ ||
          $stem =~ s/^NOER$/NOS/) {
    return [ map "$stem$_", @{$present{ER}} ];
  } elsif($stem =~ s/^MERIR$/MERS/ ||
          $stem =~ s/^NURIR$/NORS/ ||
          $stem =~ s/^AMARIR$/AMERS/ ||
          $stem =~ s/^DUCIR$/DOC/ ||
          $stem =~ s/^IUSIR$/IOSS/) {
    return [ map "$stem$_", @{$present{IR}} ];
  } elsif($stem =~ s/EC$/ET/) {
    return [ map "$stem$_", qw( AO EIS ES OM OS ONT ) ];
  } elsif($stem =~ s/$kes/KAIVEM/o ||
          $stem =~ s/AN$/EM/) {
    return [ map "$stem$_", qw( AI ES  ET AM US ONT ) ];
  } elsif($stem =~ s/$nen/NESEM/o ||
          $stem =~ s/EN$/EM/) {
    return [ map "$stem$_", qw( AI ES  ET EM ES ENT ) ];
  } elsif($stem =~ s/ER$/ET/) {
    return [ map "$stem$_", qw( U  OS  IS UM US UNT ) ];
  } elsif($stem =~ s/IR$/ET/) {
    return [ map "$stem$_", qw( U  OS  IS UM US INT ) ];
  } else {
    return;
  }
}

sub buscrifel {
  my $verb = shift;
  my $stem = $verb;

  return [ map "ESC$_", qw( AO EIS ES OM OS ONT ) ] if $verb eq 'ESAN';

  if($stem =~ s/$far/FASS/o ||
     $stem =~ s/^CURREC$/CORS/) {
    return [ map "$stem$_", @{$past{EC}} ];
  } elsif($stem =~ s/^METTAN$/MESS/ ||
          $stem =~ s/^DAN$/DON/ ||
          $stem =~ s/^PU([GH])AN$/PO$1/ ||
          $stem =~ s/^BRIGAN$/BROG/ ||
          $stem =~ s/^SUBRAN$/SOBR/ ||
          $stem =~ s/^LEGAN$/LOG/ ||
          $stem =~ s/^LAUDAN$/LOD/ ||
          $stem =~ s/^KUSAN$/KOSS/) {
    return [ map "$stem$_", @{$past{AN}} ];
  } elsif($stem =~ s/^([DKL]E|TO)SCEN$/$1SS/ ||
          $stem =~ s/^(DES|FER)IEN$/$1S/ ||
          $stem =~ s/^LEILEN$/LELS/ ||
          $stem =~ s/^KETHEN$/KOTH/) {
    return [ map "$stem$_", @{$past{EN}} ];
  } elsif($stem =~ s/^([SV])ALTER$/$1ELS/ ||
          $stem =~ s/^STERER$/STERS/ ||
          $stem =~ s/^NOER$/NOS/) {
    return [ map "$stem$_", @{$past{ER}} ];
  } elsif($stem =~ s/^MERIR$/MERS/ ||
          $stem =~ s/^NURIR$/NORS/ ||
          $stem =~ s/^AMARIR$/AMERS/ ||
          $stem =~ s/^DUCIR$/DOC/ ||
          $stem =~ s/^IUSIR$/IOSS/) {
    return [ map "$stem$_", @{$past{IR}} ];
  } elsif($stem =~ m/EC$/) {
    return [ map "$stem$_", qw( AO EIS ES OM OS ONT ) ];
  } elsif($stem =~ s/$kes/KAIVIN/o ||
          $stem =~ s/AN$/IN/) {
    return [ map "$stem$_", qw( AI ES  ET AM US ONT ) ];
  } elsif($stem =~ s/$nen/NESIN/o ||
          $stem =~ s/EN$/IN/) {
    return [ map "$stem$_", qw( AI ES  ET EM ES ENT ) ];
  } elsif($stem =~ s/([BPDTGKCFVRSZMNL]|[TDK]?H)RER$/$1$1IR/ ||
          $stem =~ s/ER$/IR/) {
    return [ map "$stem$_", qw( U  OS  IS UM US UNT ) ];
  } elsif($stem =~ s/([BPDTGKCFVRSZMNL]|[TDK]?H)RIR$/$1$1IR/ ||
          $stem =~ m/IR$/) {
    return [ map "$stem$_", qw( U  OS  IS UM US INT ) ];
  } else {
    return;
  }
}

sub bubefel {
  my $verb = shift;
  my $stem = $verb;

  if($stem =~ s/$far/FASS/o ||
     $stem =~ s/^CURREC$/CORS/ ||
     $stem =~ s/EC$//) {
    return [ undef, map ( "$stem$_", qw( E UAS  ) ),
             undef, map ( "$stem$_", qw( EL UANT ) ) ];
  } elsif($stem =~ s/$kes/KAIV/o ||
          $stem =~ s/^METTAN$/MESS/ ||
          $stem =~ s/^DAN$/DON/ ||
          $stem =~ s/^PU([GH])AN$/PO$1/ ||
          $stem =~ s/^BRIGAN$/BROG/ ||
          $stem =~ s/^SUBRAN$/SOBR/ ||
          $stem =~ s/^LEGAN$/LOG/ ||
          $stem =~ s/^LAUDAN$/LOD/ ||
          $stem =~ s/^KUSAN$/KOSS/ ||
          $stem =~ s/AN$//) {
    return [ undef, map ( "$stem$_", qw( I UAT ) ),
             undef, map ( "$stem$_", qw( IL UANT ) ) ];
  } elsif($stem =~ s/$nen/NES/o ||
          $stem =~ s/^([DKL]E|TO)SCEN$/$1SS/ ||
          $stem =~ s/^(DES|FER)IEN$/$1S/ ||
          $stem =~ s/^LEILEN$/LELS/ ||
          $stem =~ s/^KETHEN$/KOTH/ ||
          $stem =~ s/EN$//) {
    return [ undef, map ( "$stem$_", qw( I UAT ) ),
             undef, map ( "$stem$_", qw( IL UANT ) ) ];
  } elsif($stem =~ s/^([SV])ALTER$/$1ELS/ ||
          $stem =~ s/^STERER$/STERS/ ||
          $stem =~ s/^NOER$/NOS/ ||
          $stem =~ s/ER$//) {
    return [ undef, map ( "$stem$_", qw( U AS ) ),
             undef, map ( "$stem$_", qw( UL ANT ) ) ];
  } elsif($stem =~ s/^MERIR$/MERS/ ||
          $stem =~ s/^NURIR$/NORS/ ||
          $stem =~ s/^AMARIR$/AMERS/ ||
          $stem =~ s/^DUCIR$/DOC/ ||
          $stem =~ s/^IUSIR$/IOSS/ ||
          $stem =~ s/IR$//) {
    return [ undef, map ( "$stem$_", qw( U UAT ) ),
             undef, map ( "$stem$_", qw( UL UANT ) ) ];
  } else {
    return;
  }
}


my %dyntense = (
  demeric => 'demeric',
  present => 'demeric',

  scrifel => 'scrifel',
  past    => 'scrifel',

  izhcrifel       => 'izhcrifel',
  pastanterior    => 'izhcrifel',
  'past anterior' => 'izhcrifel',

  befel      => 'befel',
  imperative => 'befel',
);

my %dynmood = (
  prilise  => 'prilise',
  definite => 'prilise',

  buprilise => 'buprilise',
  remote    => 'buprilise',
);

sub dynamic {
  my($verb, $mood, $tense) = @_;
  my $stem = $verb;
  my $table;

  if($stem =~ s/$far/FASC/o ||
     $stem =~ s/$nen/NES/o  ||
     $stem =~ s/$kes/KAIV/o ||
     $stem =~ s/(?:EC|[AE]N|[EI]R)$//) {
    if($dynmood{$mood} eq 'prilise') {
      return unless $dyntense{$tense} eq 'demeric' ||
                    $dyntense{$tense} eq 'scrifel' ||
                    $dyntense{$tense} eq 'izhcrifel';
      $stem .= 'EV' if $dyntense{$tense} eq 'scrifel';
      $stem .= 'ER' if $dyntense{$tense} eq 'izhcrifel';
      $table = [ map "$stem$_", @{$present{dyn}} ];
    } elsif($dynmood{$mood} eq 'buprilise') {
      return unless $dyntense{$tense} eq 'demeric' ||
                    $dyntense{$tense} eq 'scrifel' ||
                    $dyntense{$tense} eq 'befel';
      if($dyntense{$tense} eq 'demeric') {
        $table = [ map "$stem$_", qw( I IS UAT UAM UAS UANT ) ];
      } elsif($dyntense{$tense} eq 'scrifel') {
        $stem .= 'IS';
        $table = [ map "$stem$_", qw( I US AT AM AS ANT ) ];
      } elsif($dyntense{$tense} eq 'befel') {
        # imperative is the same for static and dynamic forms
        $table = bubefel($verb);
      } else {
        return;
      }
    } else {
      return;
    }
  } else {
    return;
  }

  # Stem change
  if($dyntense{$tense} ne 'befel' && # imperative endings don't trigger
                                     # sound changes
     $verb =~ /[AEIOU][TDP](?:[IE]R|[AE]N|EC)$/ && !exists $borrowed{$verb} &&
     ($verb !~ /ATIR$/ || $verb eq 'CLATIR')) {
    for(@$table) {
      # UI UIS UT UAT UAM UAS UANT
      s/([TDP])(U(?:IS?|T|A(?:[SMT]|NT)))$/$fric{$1}$2/;
    }
  }

  return $table;
}

sub part {
  my $verb = shift;
  for($verb) {
    s/$far/FASCEC/o;
    s/$nen/NESEN/o;
    s/$kes/KAIVAN/o;
  }

  my($present, $past, $gerund) = ($verb) x 3;

  return unless $verb =~ /(?:EC|[AE]N|[EI]R)$/;

  for($present) {
    s/EC$/ILES/ || s/IR$/IC/ || s/(?:ER|[AE]N)$/EC/;
  }

  for($past) {
    s/E[CR]$/EL/ || s/(?:[AE]N|IR)$/UL/;
  }

  for($gerund) {
    s/E[CR]$/IM/ || s/(?:[AE]N|IR)$/AUM/;
  }

  return wantarray ? ($present, $past, $gerund) : [ $present, $past, $gerund ];
}



my %masc = (
);

my %neut = (
  ATITRIS     => 'atüchy',
  CRENIS      => 'iscreniy',
  DACTIS      => 'dazhy',
  DROGIS      => 'drozhy',
  FILIS       => 'fiy',
  FUELIS      => 'föy',
  ISCRENILIS  => 'iscreniy',
  IULIS       => 'zhuy',
  KATTIS      => 'katy',
  KILIS       => 'ciy',
  KRAIS       => 'rhay',
  LENTILIS    => 'lëtiy',
  LITIS       => 'lichy',
  LOIS        => 'loy',
  MEIS        => 'mey',
  MIHIS       => 'miy',
  MILGIS      => 'mily',
  MITIS       => 'michy',
  NACUIS      => 'nacuy',
  NMURTHANIS  => 'múrtany',
  NOTHONIS    => 'nodhony',
  OBELIS      => 'obly',
  ORAIS       => 'oray',
  PENGIS      => 'peny',
  PLASIS      => 'plasy',
  RAIS        => 'ray',
  SABLIS      => 'sably',
  SCRAIS      => 'shray',
  SEGLIS      => 'segly',
  SPAIS       => 'sfay',
  SUIS        => 'suy',
  VELAIS      => 'vlay',
  ZURRIS      => 'zury',
);

my %noun = (
  # personal pronouns
  SEO  => [ qw( SEO EAE  ETH SEON ED     TAS  TAIE TAIM TAUN TAD   ) ],
  LET  => [ qw( LET LEAE EK  LUN  LETH   MUKH MUIE MUIM MUIN MUOTH ) ],
  TU   => [ qw( TU  TUAE TUA TUN  TOTH   CAI  CAIE CAIM CAIN CAITH ) ],
  ZE   => [ undef, qw( ZEHIE ZETH  ZEHUN ZEHOTH ),
            undef, qw( ZAHIE ZAHAM ZAHAN ZAHATH ) ],
  TAS  => [ qw( TAS  TAIE TAIM TAUN TAD   ), (undef) x 5 ],
  MUKH => [ qw( MUKH MUIE MUIM MUIN MUOTH ), (undef) x 5 ],
  CAI  => [ qw( CAI  CAIE CAIM CAIN CAITH ), (undef) x 5 ],
  ZA   => [ undef, qw( ZAHIE ZAHAM ZAHAN ZAHATH ), (undef) x 5 ],

  # possessive adjectives:
  # SEO  -> ERIS
  # LET  -> LERIS
  # TU   -> TURIS
  # TAS  -> TANDES
  # MUKH -> MUNDES
  # CAI  -> CAIRIS

  # pointers
  AELU => [ qw( AELU AELUI AELETH AELUN AELOTH ), (undef) x 5 ],
  AELO => [ qw( AELO AELOI AELOR  AELON AELOTH ), (undef) x 5 ],
  AELA => [ qw( AELA AELAE AELEA  AELAN AELAD  ), (undef) x 5 ],

  ILLU => [ qw( ILLU ILLUI ILLETH ILLUN ILLOTH ), (undef) x 5 ],
  ILLO => [ qw( ILLO ILLOI ILLO   ILLON ILLOTH ), (undef) x 5 ],
  ILLA => [ qw( ILLA ILLAE ILLEA  ILLAN ILLAD  ), (undef) x 5 ],

  AETTOS => [ qw( AETTOS AETTEI AETTOT AETTAN AETTOTH ), (undef) x 5 ],
  # TOTOS actually conjugates like a regular masculine noun, but I'm keeping
  # it here with its relatives
  TOTOS  => [ qw( TOTOS  TOTEI  TOT    TOTAN  TOTOTH  ), (undef) x 5 ],

  # AECTA and CESTA are like feminine nouns

  # question words
  KAE => [ qw( KAE KAIE KAETH KAEN KAETH   KAHE KAHIE KAHAM KAHAN KAHATH ) ],
  KETTOS => [ qw( KETTOS KETTEI KETTOT KETTAN KETTOTH ), (undef) x 5 ],
  # older forms:
  # KESTU => [ qw( KESTU KEISE KEISAM KEISAN KEISE ), (undef) x 5 ],
  KEDIE => [ qw( KEDIE KEDIEI KEDIA KEDIEN KEDID ), (undef) x 5 ],

  # quantity words
  NIKTOS => [ qw( NIKTOS NIKTEI NIKTOT NIKTAN NIKTOTH ), (undef) x 5 ],
  NISIOS => [ qw( NISIOS NISIEI NISIOT NISIAN NISIOTH ), (undef) x 5 ],
  THISIOS => [ qw( THISIOS THISIEI THISIOT THISIAN THISIOTH ), (undef) x 5 ],

  PSIAT => [ qw( PSIAT PSIE PSIAT PSIAN PSIAD ), (undef) x 5 ],

  NIES  => [ qw( NIES  NIEI  NIET  NIEN  NIETH  ), (undef) x 5 ],
  PSIES => [ qw( PSIES PSIEI PSIET PSIEN PSIETH ), (undef) x 5 ],

  THIKEDIE => [ qw( THIKEDIE THIKEDIEI THIKEDIA THIKEDIEN THIKEDID ), (undef) x 5 ],

  # NIKUDA and PSUDA are like feminine nouns
);

sub noun {
  my $noun = shift;
  my $stem = $noun;
  my $type = 'fem';
  my $table;

  $type = 'masc' if exists $masc{$noun};
  $type = 'neut' if exists $neut{$noun};

  return $noun{$noun} if exists $noun{$noun};

  if($stem =~ s/OS$//) {
    $table = [ map "$stem$_", 'OS', 'EI', '', qw( AN OTH   IT IE I IN ITH ) ];
  } elsif($stem =~ s/AS$//) {
    $table = [ map "$stem$_", qw( AS AI A  AN ATH   AIT AIE AI  AIN AITH ) ];
  } elsif($stem =~ s/O$//) {
    $table = [ map "$stem$_", qw( O  OI OM ON OTH   OI  OIE OIM OIN OITH ) ];
  } elsif($stem =~ s/U$//) {
    $table = [ map "$stem$_", qw( U  UI UM UN UTH   UI  UIE UIM UIN UITH ) ];
  } elsif($type eq 'neut' && $stem =~ s/IS$//) {
    $table = [ map "$stem$_", qw( IS II IM IN ITH   UI  UIE UIM UIN UITH ) ];
  } elsif($stem =~ s/US$//) {
    $table = [ map "$stem$_", qw( US OI O  UN UTH   UIT UIE UI  UIN UITH ) ];
  } elsif($stem =~ s/A$//) {
    $table = [ map "$stem$_", qw( A  AE AA AN AD    ET  EIE EIM EIN EID  ) ];
  } elsif($stem =~ s/E$//) {
    $table = [ map "$stem$_", qw( E  EI EA EN ED    ET  EIE EIM EIN EID  ) ];
  } elsif($type eq 'fem' && $stem =~ s/IS$//) {
    $table = [ map "$stem$_", qw( IS IE IA IN ID    IAT IAE IAM IAN IAD  ) ];
  } elsif($stem =~ m/[PBTDHCGKFVSZMNLR]$/) {
    $table = [ map "$stem$_", '', 'EI', '', qw( AN OTH   IT IE I IN ITH ) ];
  } else {
    return;
  }

  return $table;
}

my %adj = (
  AELU => [ [ qw( AELU AELUI AELETH AELUN AELOTH ), (undef) x 5 ],
            [ qw( AELO AELOI AELOR  AELON AELOTH ), (undef) x 5 ],
            [ qw( AELA AELAE AELEA  AELAN AELAD  ), (undef) x 5 ], ],

  ILLU => [ [ qw( ILLU ILLUI ILLETH ILLUN ILLOTH ), (undef) x 5 ],
            [ qw( ILLO ILLOI ILLO   ILLON ILLOTH ), (undef) x 5 ],
            [ qw( ILLA ILLAE ILLEA  ILLAN ILLAD  ), (undef) x 5 ], ],
);

sub adj {
  my $adj = shift;
  my $stem = $adj;
  my $table;

  return $adj{$adj} if exists $adj{$adj};

  if($stem =~ s/ES$//) {
    $table = [ [ map "$stem$_", qw( ES  EI  E  EN ETH   EIT EIE EI  EIN EITH ) ],
               [ map "$stem$_", qw( E   EI  EM EN ETH   EI  EIE EIM EIN EITH ) ],
               [ map "$stem$_", qw( IES IAE EA EN ED    ET  EIE EIM EIN EID  ) ] ];
  } elsif($stem =~ s/IS$//) {
    $table = [ [ map "$stem$_", qw( IS II I  IN ITH   UIT UIE UI  UIN UITH ) ],
               [ map "$stem$_", qw( IS II IM IN ITH   UI  UIE UIM UIN UITH ) ],
               [ map "$stem$_", qw( IS IE IA IN ID    IAT IAE IAM IAN IAD  ) ] ];
  } elsif($stem =~ m/[PBTDHCGKFVSZMNLR]$/) {
    $table = [ [ map "$stem$_", '', 'EI', '', qw( AN OTH   IT IE I IN ITH ) ],
               [ map "$stem$_", qw( O OI OM ON OTH   OI OIE OIM OIN OITH ) ],
               [ map "$stem$_", qw( A AE AA AN AD    ET EIE EIM EIN EID  ) ] ];
  } else {
    return;
  }

  return $table;
}


my %comp = (
  MELIS => 'MELIOR',
  DURENGES => 'AVECOR',
);

sub comp {
  my $adj = shift;
  my $stem = $adj;

  return $comp{$adj} if exists $comp{$adj};

  if($stem =~ s/ES$//) {
    return $stem . 'EDHES';
  } elsif($stem =~ s/IS$//) {
    return $stem . 'IOR';
  } elsif($stem =~ m/[PBTDHCGKFVSZMNLR]$/) {
    return $stem . 'OR';
  } else {
    return;
  }
}


my %super = (
  MELIS => 'MELASTES',
  DURENGES => 'AVESTES',
);

sub super {
  my $adj = shift;
  my $stem = $adj;

  return $super{$adj} if exists $super{$adj};

  if($stem =~ s/ES$//) {
    return $stem . 'ASCES';
  } elsif($stem =~ s/IS$//) {
    return $stem . 'ISCES';
  } elsif($stem =~ m/[PBTDHCGKFVSZMNLR]$/) {
    return $stem . 'ASTES';
  } else {
    return;
  }
}


my %adv = (
  MELIS => 'MELIO',
  DURENGES => 'AVECUE',
);

sub adv {
  my $adj = shift;
  my $stem = $adj;

  return $adv{$adj} if exists $adv{$adj};

  if($stem =~ s/ES$//) {
    return $stem . 'ECUE';
  } elsif($stem =~ s/IS$//) {
    return $stem . 'ICUE';
  } elsif($stem =~ m/[PBTDHCGKFVSZMNLR]$/) {
    return $stem . 'A';
  } else {
    return;
  }
}


1;
__END__