#
# 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]