Posted to tcl by hypnotoad at Mon Oct 22 18:16:29 GMT 2018view raw
- 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
- }