The Shakespearean Insult Generator, by ccbbaa and his dutiful scribe PYK, equips thee with flames to heave at thy foes.
# # Shakespearean insult sheet from dm, article, typed down by me plp 2019/10 # # v0: original typed from image in article, plp 2019 # source this file into your tcl program, then call the procedure: # ::Scuss::scuss # return: { {the cuss words} key } - use key to obtain the same cuss again # status: tested, works # # original image link, the data below typed down from image: # https://i.dailymail.co.uk/1s/2019/10/04/10/19290426-7537209-Helping_hand_A_class_in_an_unknown_location_is_given_a_Shakespea-a-47_1570182111335.jpg # original instructions: # - combine one word from the 1st colum, one from the 2nd, one from 3rd, # prefaced with 'Thou' namespace eval ::Scuss { # please do not delete, add new strings below instead. variable Version { "v0: initial revision plp 2019" } variable col0 { artless bawdy beslubbering bootless churlish cockered clouted craven currish dankish dissembling droning errant fawning fobbing froward frothy gleeking goatish gorbellied impertinent infectious jarring loggerheaded lumpish mammering mangled } variable col1 { base-court bat-fowling beef-witted beetle-headed boil-brained clapper-clawed clay-brained common-kissing crock-pated dismal-dreaming dizzy-eyed doghearted dread-bolted earth-vexing elf-skinned fat-kidneyed fen-sucked flap-mouthed fly-bitten folly-fallen fool-born full-gorged guts-gripping half-faced hasty-witted hedge-born hell-hated } variable col2 { apple-john baggage barnacle bladder boar-pig bugbear bum-bailey canker-blossom clack-dish clotpole coxcomb codpiece death-token dewberry flap-dragon flax-wench flirt-gill floot-licker fustilarian giglet gudgeon haggard harpy hedge-pig horn-beast hugger-mug joithead twat } variable prep "Thou" # some state vars variable c0 -1 ;# count of items in the 3 columns variable c1 -1 variable c2 -1 variable prev -1_-1_-1 ;# key of previously issued cuss # returns a list {"cuss" key}, the key can be used to retrieve the exact same # cuss again or to check if it was just issued before and ask for another, by # the caller. If the passed in key has an invalid format an error is printed # to stderr and the returned list is empty. # Example return: {Thou impertinent hedge-born clotpole} 20_25_9 proc scuss {{key -1}} { vars c0 c1 c2 col0 col1 col2 prep prev if {$c0 == -1} { ;# init set c0 [llength $col0] set c1 [llength $col1] set c2 [llength $col2] } set key0 [regsub -all {_} $prev { }] ;# un-armor to list if {$key == -1} { ;# get a new random key while 1 { ;# should never fail to exit the loop after a few iterations set key [list \ [expr { int( floor( rand() * $c0 ) ) }] \ [expr { int( floor( rand() * $c1 ) ) }] \ [expr { int( floor( rand() * $c2 ) ) }] \ ] set flg 0 ;# assume will not need to recalculate random key for {set i 0} {$i < 3} {incr i} { ;# ensure all keys differ from prev. if {[lindex $key $i] == [lindex $key0 $i]} {set flg 1; break} } if {!$flg} {break} ;# loop again if needed } ;# while } else { ;# user input key, check valid set flg [regexp {^([0-9]+)_([0-9]+)_([0-9]+)$} $key dummy k1 k2 k3] if {$flg} { if { ( ($k1 < 0)||($k1 >= $c0) ) \ || ( ($k2 < 0)||($k2 >= $c1) ) \ || ( ($k3 < 0)||($k3 >= $c2) ) \ } {set flg 0} } if {!$flg} { puts stderr "error: ::Scuss::scuss : user supplied key '$key' invalid" return {} } set key [list $k1 $k2 $k3] } set cuss $prep for {set i 0} {$i < 3} {incr i} { append cuss { } [lindex [subst $[subst col$i]] [lindex $key $i]] } set key [regsub -all { } $key {_}] set prev $key return [list $cuss $key] } proc vars args { ::tailcall ::try [join [lmap name $args { lindex "variable [list $name]" }] {;}] } }
puts [::Scuss::scuss]