Random Word Generator

package provide pheme_random 0.1
#package require pheme
namespace eval ::pheme {}
namespace eval ::randomword {}

# Adapted from https://www.dwheeler.com/totro.pl.txt

namespace eval ::randomword {}

proc ::randomword::lrandom list {
  set len [llength $list]
  set idx [expr int(rand()*$len)]
  return [lindex $list $idx]
}

proc ::randomword::lshuffle list {
  set len [llength $list]
  set idx [expr int(rand()*$len)]
  return [lindex $list $idx]
}

proc ::randomword::table {pattern type table} {
  foreach {letter frequency rule} $table {
    for {set x 0} {$x < $frequency} {incr x} {
      dict set cards [incr cardnum] [list $letter $rule]
    }
  }
  set body {}
  append body \n "  " [list set cards $cards]
  append body {
  set srule [yield [info coroutine]]
  while 1 {
    set idxlist [dict keys $cards]
    set N [llength $idxlist]
    set order {}
    foreach id $idxlist {
      set idx [expr {int(floor(rand()*[llength $order]))}]
      set order [::linsert $order $idx $id]
    }
    foreach id $order {
      lassign [dict get $cards $id] letter lrule
      #puts [list $letter $lrule | $srule] ;
      if {$srule && ($srule & $lrule)==0} {  continue }
      set srule [yield $letter]
    }
    if {$srule & 1} { yield {} }

  }
  }
  coroutine ::randomword::${pattern}_$type apply [list {} $body]
}

###
# Syllable Rules
#
# 1 - Can be at ending
# 2 - Can be at beginning
# 4 - Can be in the middle
# 8 - "strong" syllable
# 16 - "sonerant" syllable
###

###
# Build a table of vowels for generic words
###
::randomword::table generic vowel {
  a 12 7
  e 12 7
  i 12 7
  o 12 7
  u 12 7
  ae 1 7
  ai 1 7
  ao 1 7
  aa 1 7
  ay 2 7
  ea 1 7
  ei 3 7
  eo 1 7
  eu 1 7
  ee 1 7
  eau 1 7
  ia 1 7
  io 1 7
  iu 1 7
  ii 1 7
  oa 1 7
  oe 1 7
  oi 1 7
  ou 1 7
  oo 1 7
  ua 2 7
  '  1 4
  y 1 7
}

###
# Build a table of consonants for generic words
###
::randomword::table generic consonant {
  b 3 7
  br 2 6
  c 3 7
  ch 1 7
  ck 1 5
  cl 1 6
  cr 1 6
  d 3 7
  df 1 6
  dr 2 7
  f 3 7
  fl 1 6
  fr 2 6
  g 3 7
  gh 1 7
  gl 1 6
  gr 2 6
  h 3 7
  j 3 7
  k 3 7
  kl 1 6
  kr 2 6
  l 3 7
  ll 1 6
  m 3 7
  n 3 7
  nk 1 5
  p 3 7
  ph 1 7
  pl 1 6
  pr 1 6
  qu 1 6
  r 3 7
  rk 1 5
  s 3 7
  sc 1 7
  sh 1 7
  sk 1 7
  sl 1 6
  sr 1 6
  ss 1 5
  st 1 7
  str 1 6
  t 3 7
  th 1 7
  tr 1 6
  v 3 7
  w 3 7
  wh 1 6
  wk 1 0
  x 1 7
  y 1 7
}

###
# Build a table of vowels for female words
###
###
# Syllable Rules
#
# 1 - Can be at ending
# 2 - Can be at beginning
# 4 - Can be in the middle
# 8 - "strong" syllable
# 16 - "sonerant" syllable
###

::randomword::table female vowel {
  a 12 7
  e 12 7
  i 12 7
  o 12 6
  u 12 6
  ae 1 6
  ai 1 7
  ao 1 6
  aa 1 7
  ah 6 7
  ay 2 7
  ea 1 6
  ei 3 7
  eo 1 6
  eu 1 6
  ee 1 7
  eau 1 6
  ia 1 7
  io 1 6
  iu 1 6
  ii 1 7
  oa 1 6
  oe 1 6
  oi 1 6
  ou 1 6
  oo 1 6
  ua 2 6
  '  1 4
  y 1 7
}

::randomword::table female consonant {
  b 3 6
  br 2 6
  c 3 6
  ch 1 6
  ck 1 5
  cl 1 6
  cr 1 6
  d 3 6
  df 1 6
  dr 2 6
  f 3 6
  fl 1 6
  fr 2 6
  g 3 6
  gh 1 7
  gl 1 6
  gr 2 6
  h 3 6
  j 3 6
  k 3 6
  kl 1 6
  kr 2 6
  l 3 7
  ll 1 7
  m 3 7
  n 3 7
  nk 1 5
  ng 1 6
  p 3 6
  ph 1 7
  pl 1 6
  pr 1 6
  qu 1 6
  r 3 7
  rk 1 5
  s 3 6
  sc 1 6
  sh 1 6
  sk 1 6
  sl 1 6
  sr 1 6
  ss 1 5
  st 1 6
  str 1 6
  t 3 6
  th 1 6
  tr 1 6
  v 3 6
  w 3 6
  wh 1 6
  wk 1 0
  x 1 6
  y 1 7
}

###
# Build a table of vowels for male words
###
::randomword::table male vowel {
  a 12 7
  e 12 7
  i 12 7
  o 12 7
  u 12 7
  ae 1 7
  ai 1 7
  ao 1 7
  aa 1 7
  ay 2 7
  ea 1 7
  ei 3 7
  eo 1 7
  eu 1 7
  ee 1 7
  eau 1 7
  ia 1 7
  io 1 7
  iu 1 7
  ii 1 7
  oa 1 7
  oe 1 7
  oi 1 7
  ou 1 7
  oo 1 7
  ua 2 7
  '  1 4
  y 1 7
}

::randomword::table male consonant {
    b 3 7
    br 2 6
    c 3 7
    ch 1 7
    ck 1 5
    cl 1 6
    cr 1 6
    d 3 7
    df 1 6
    dr 2 7
    f 3 7
    fl 1 6
    fr 2 6
    g 3 7
    gh 1 7
    gl 1 6
    gr 2 6
    h 3 7
    j 3 7
    k 3 7
    kl 1 6
    kr 2 6
    l 3 7
    ll 1 6
    m 3 7
    n 3 7
    nk 1 5
    p 3 7
    ph 1 7
    pl 1 6
    pr 1 6
    qu 1 6
    r 3 7
    rk 1 5
    s 3 7
    sc 1 7
    sh 1 7
    sk 1 7
    sl 1 6
    sr 1 6
    ss 1 5
    st 1 7
    str 1 6
    t 3 7
    th 1 7
    tr 1 6
    v 3 7
    w 3 7
    wh 1 6
    wk 1 0
    x 1 7
    y 1 7
}

proc ::randomword::word {{pattern generic} {length 0}}  {
  if {$length <=0 } {
    set length [expr {3+int(rand()*10)}]
  }
  set vowel [expr {rand()>0.5}]
  set word {}
  for {set i 0} {$i < $length} {incr i} {
    if {$i==0} {
      # Pattern cannot be at the start of a word
      set srule 2
    } elseif {$i==($length-1)} {
      # Pattern cannot be at the end of a word
      set srule 1
    } else {
      # Pattern cannot be in the middle of a word
      set srule 4
    }
    if {$vowel} {
      set chars [${pattern}_vowel $srule]
      #[lrandom $::randomword::vowels($pattern)]
    } else {
      set chars [${pattern}_consonant $srule]
      #set letter [lrandom $::randomword::consonants($pattern)]
    }
    append word $chars
    set vowel [expr {$vowel ^ 1}]
  }
  return $word
}