#
#       tkMOO
#       ~/.tkMOO-lite/plugins/speak_weirdly.tcl
#

# tkMOO-light is Copyright (c) Andrew Wilson 1994,1995,1996,1997,1998,
#                                            1999,2000
#
#       All Rights Reserved
#
# Permission is hereby granted to use this software for private, academic
# and non-commercial use. No commercial or profitable use of this
# software may be made without the prior permission of the author.
#
# THIS SOFTWARE IS PROVIDED BY ANDREW WILSON ``AS IS'' AND ANY
# EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL ANDREW WILSON BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

client.register speak_weirdly start 90

proc speak_weirdly.start {} {
    global speak_weirdly_ran
    edittriggers.trigger \
        -regexp {^([^,]+) says, "(.*)"$} \
        -directive UseSpeakWeirdly \
        -continue \
        -command { 
            set line [speak_weirdly.say $m2 $m1]
        } \
        -priority 80

    edittriggers.trigger \
        -regexp {^(You) say, "(.*)"$} \
        -directive UseSpeakWeirdly \
        -continue \
        -command { 
            set line [speak_weirdly.say $m2 [worlds.get_generic {} {} {} Login]]
        } \
        -priority 80

    edittriggers.register_alias speak_weirdly.say speak_weirdly.say
    edittriggers.register_alias speak_weirdly.random speak_weirdly.random

    preferences.register speak_weirdly {Special Forces} {
        { {directive UseSpeakWeirdly}
            {type boolean}
            {default On}
            {display "Speak weirdly"} }
    }

    set speak_weirdly_ran [pid]
}

proc speak_weirdly.random {range} {
  global speak_weirdly_ran
  set speak_weirdly_ran [expr ($speak_weirdly_ran * 9301 + 49297) % 233280]
  set rv [expr int($range * ($speak_weirdly_ran / double(233280)))]
  return $rv
} 

proc speak_weirdly.say {str who {towho ""}} {
    set my_name $who
    set oq "\`"
    set cq "\'"
    set random [speak_weirdly.random 5]
    if { $random == 0 } {
        set quest [string first "? " $str]
        set excla [string first "! " $str]
        set perio [string first ". " $str]
        set first 999
        if { ($quest != -1) && $quest < $first } { set first $quest }
        if { ($excla != -1) && $excla < $first } { set first $excla }
        if { ($perio != -1) && $perio < $first } { set first $perio }
        if { $first == 999 } { set first -1 }
        set says says
        if { $first != -1 } {
            set a [string range $str 0 $first]
            set b [string trimleft [string range $str [expr $first +1] end]]
            set comma ""
            if { [regexp {([\!\?])$} $a all punct] == 0 } {
                set comma ","
                set a [string trimright $a]
                set a [string trimright $a "."]
            } {
                if { $punct == "!" } {
                    set says exclaims
                } {
                    set says asks
                }
            }
            if { $towho != "" } { set towho " to $towho" }
            return "$oq$a$comma$cq $says $my_name$towho.  $oq$b$cq"
        } {
            # if the sentence ends with punctuation, !? then leave as is
            # else replace the punc with ','
            set comma ""
            if { [regexp {([\!\?])$} $str all punct] == 0 } {
                set comma ","
                set str [string trimright $str]
                set str [string trimright $str "."]
            } {
                if { $punct == "!" } {
                    set says exclaims
                } {
                    set says asks
                }
            }
            if { $towho != "" } { set towho "to $towho" }
            return "$oq$str$comma$cq $says $my_name$towho."
        }
    } {
        if { $towho != "" } {
        return "$my_name \[to $towho\]: $str";
        } {
        return "$my_name says, $oq$str$cq";
        }
    }
}