source: trunk/modules/output.tcl @ 1143

Revision 1135, 26.3 KB checked in by james, 4 months ago (diff)

fix narfs append, hopefully
fix failure case of nazi 3 plugin
content additions and fixes
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1#bMotion - Output functions
2#
3
4###############################################################################
5# bMotion - an 'AI' TCL script for eggdrops
6# Copyright (C) James Michael Seward 2000-2008
7#
8# This program is free software; you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation; either version 2 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful, but
14# WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16# General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program; if not, write to the Free Software
20# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21###############################################################################
22
23set bMotion_output_delay 0
24
25#
26# pick a random element from a list
27proc pickRandom { list } {
28        bMotion_putloglev 5 * "pickRandom ($list)"
29        return [lindex $list [rand [llength $list]]]
30}
31
32#
33# get the pronoun for our gender
34proc getPronoun {} {
35        bMotion_putloglev 5 * "getPronoun"
36        set gender [bMotion_setting_get "gender"]
37
38        switch $gender {
39                "male" {
40                        return "himself"
41                }
42                "female" {
43                        return "herself"
44                }
45                default {
46                        return "its"
47                }
48        }
49}
50
51#
52# get "his" or "hers" for our gender
53proc getHisHers {} {
54        bMotion_putloglev 5 * "getHisHers"
55
56        set gender [bMotion_setting_get "gender"]
57
58        switch $gender {
59                "male" {
60                        return "his"
61                }
62                "female" {
63                        return "hers"
64                }
65                default {
66                        return "its"
67                }
68        }
69}
70
71#
72# get "her" or "her" for our gender
73proc getHisHer {} {
74        bMotion_putloglev 5 * "getHisHer"
75
76        set gender [bMotion_setting_get "gender"]
77
78        switch $gender {
79                "male" {
80                        return "his"
81                }
82                "female" {
83                        return "her"
84                }
85                default {
86                        return "it"
87                }
88        }
89}
90
91#
92# get "he" or "she" for our gender
93proc getHeShe {} {
94        bMotion_putloglev 5 * "getHeShe"
95
96        set gender [bMotion_setting_get "gender"]
97
98        switch $gender {
99                "male" {
100                        return "he"
101                }
102                "female" {
103                        return "she"
104                }
105                default {
106                        return "it"
107                }
108        }
109}
110
111#
112# do a /me action
113proc mee {channel action {urgent 0} } {
114        bMotion_putloglev 5 * "mee ($channel, $action, $urgent)"
115        set channel [chandname2name $channel]
116        regsub "^\"(.+)\"?$" $action {\1} action
117        if {([string index $action 0] != ".") && (![regexp -nocase "^is" $action]) && ([rand 10] == 0)} {
118                set action "*$action*"
119        } else {
120                set action "\001ACTION $action\001"
121        }
122
123        if {$urgent} {
124                bMotion_queue_add_now $channel $action
125        } else {
126                bMotion_queue_add $channel $action
127        }
128}
129
130proc bMotion_process_macros { channel text } {
131
132        set done 0
133        set current_pos 0
134        while {$done == 0} {
135                bMotion_putloglev 1 * "macro: starting loop with $text and current pos=$current_pos"
136                set current_pos [string first "%" $text $current_pos]
137                if {$current_pos == -1} {
138                # no more matches
139                        set done 1
140                        continue
141                } 
142                bMotion_putloglev 2 * "macro: found a % at $current_pos"
143                if {$current_pos < [string length $text]} {
144                # this isn't a % at the end of the line
145                        if {[string index $text [expr $current_pos + 1]] == "|"} {
146                                set current_pos [expr $current_pos + 2]
147                                continue
148                        }
149
150                        #find the element following this %
151                        set substring [string range $text $current_pos end]
152                        if [regexp -nocase {%([a-z!=]+)} $substring matches macro] {
153                                bMotion_putloglev 2 * "macro: found macro $macro at $current_pos"
154                                set plugin [bMotion_plugin_find_output "en" "" 0 10 $macro]
155                                if {[llength $plugin] == 0} {
156                                        # oh no
157                                        bMotion_putloglev d * "macro: didn't get any plugins for $macro"
158                                }
159
160                                if {[llength $plugin] == 1} {
161                                # call plugin
162                                        bMotion_putloglev 2 * "macro: found matching plugin for macro [lindex $plugin 0]"
163                                        set result ""
164                                        catch {
165                                                set result [[lindex $plugin 0] $channel $text]
166                                                if {$result == ""} {
167                                                        bMotion_putloglev 2 * "macro: [lindex $plugin 0] returned nothing, aborting output"
168                                                        return ""
169                                                }
170                                        }
171                                        if {$result == ""} {
172                                                return ""
173                                                incr current_pos
174                                                continue
175                                        }
176
177                                        if {$text != $result} {
178                                                set text $result
179                                                # reset current pos
180                                                set current_pos 0
181                                                continue
182                                        } else {
183                                                bMotion_putloglev 1 * "macro: [lindex $plugin 0] did nothing at position $current_pos in output $text"
184                                        }
185                                } else {
186                                        bMotion_putloglev d * "macro: unexpectly got too many matching plugins back: $plugin"
187                                        incr current_pos
188                                        continue
189                                }
190
191                                incr current_pos
192                                continue
193                        } else {
194                                bMotion_putloglev d * "macro: couldn't find a macro in $substring"
195                                # skip it
196                                incr current_pos
197                                continue
198                        }
199                }
200
201                # hmm
202                bMotion_putloglev d * "macro: got to end of macro loop o_O"
203                incr current_pos
204        }
205
206        return $text
207}
208
209#
210# our magic output function
211proc bMotionDoAction {channel nick text {moreText ""} {noTypo 0} {urgent 0} } {
212        bMotion_putloglev 5 * "bMotionDoAction($channel,$nick,$text,$moreText,$noTypo,$urgent)"
213        global bMotionInfo bMotionCache bMotionOriginalInput
214        global bMotion_output_delay bMotionSettings BMOTION_SLEEP
215
216        set bMotion_output_delay 0
217
218        #check our global toggle
219        global bMotionGlobal
220        if {$bMotionGlobal == 0} {
221                return 0
222        }
223
224        set bMotionCache($channel,last) 1
225
226        # check if we're asleep
227        if {[bMotion_setting_get "asleep"] == $BMOTION_SLEEP(ASLEEP)} {
228                return 0
229        }
230
231        if [regexp "^\[#!\].+" $channel] {
232                set channel [string tolower $channel]
233                if {![channel get $channel bmotion]} {
234                        bMotion_putloglev d * "bMotion: aborting bMotionDoAction ... $channel not allowed"
235                        return 0
236                }
237        }
238
239        if {[bMotion_setting_get "silence"] == 1} { 
240                return 0 
241        }
242        catch {
243                if {$bMotionInfo(adminSilence,$channel) == 1} { 
244                        return 0 
245                }
246        }
247
248        switch [rand 3] {
249                0 { }
250                1 { set nick [string tolower $nick] }
251                2 { set nick "[string range $nick 0 0][string tolower [string range $nick 1 end]]" }
252        }
253
254        # Process macros
255
256        set original_line $text
257        set done 0
258        while {$done == 0} {
259                set text [bMotion_process_macros $channel $text]
260
261                set text [bMotionDoInterpolation $text $nick $moreText $channel]
262
263                if {$text == $original_line} {
264                        set done 1
265                } else {
266                        set original_line $text
267                        bMotion_putloglev 1 * "output: going round macro loop again"
268                }
269        }
270
271        # now the rest
272        if {$noTypo == 0} {
273                set plugins [bMotion_plugin_find_output $bMotionInfo(language) $channel 11]
274                if {[llength $plugins] > 0} {
275                        foreach callback $plugins {
276                                bMotion_putloglev 1 * "bMotion: output plugin: $callback..."
277                                set result ""
278                                catch {
279                                        set result [$callback $channel $text]
280                                } err
281                                bMotion_putloglev 3 * "bMotion: returned from output $callback ($result)"
282                                if {$result == ""} {
283                                        return 0
284                                }
285                                set text $result
286                        }
287                }
288        } else {
289                bMotion_putloglev 1 * "skipped plugin processing on $text due to noTypo being set"
290        }
291
292        # clear this in case a plugin ended up not using it in an abstract
293        bMotion_plugins_settings_set "system" "ruser_skip" $channel "" ""
294
295        #make sure the line wasn't set to blank by a plugin (may be trying to block output)
296        set line [string trim $text]
297        if {$line == ""} {
298                return 0
299        }
300
301        # Explode line into lines
302        # We map %| to NUL and split on that, since [split] can't
303        # handle multichar boundaries
304        set lines [split [string map [list "%|" \x00] $line] \x00]
305
306        foreach lineIn $lines {
307                set temp [bMotionSayLine $channel $nick $lineIn $moreText $noTypo $urgent]
308                if {$temp == 1} {
309                        bMotion_putloglev 1 * "bMotion: bMotionSayLine returned 1, skipping rest of output"
310                        #1 stops continuation after a failed %bot[n,]
311                        break
312                }
313                global bMotion_typo_mutex bMotion_typos
314
315                if {$bMotion_typo_mutex == ""} {
316                        set bMotion_typo_mutex "locked"
317                        if [llength $bMotion_typos] {
318                                set output [join $bMotion_typos]
319                                bMotionDoAction $channel $output "%VAR{typoFix}" "" 1
320                                set bMotion_typos [list]
321                        }
322                        set bMotion_typo_mutex ""
323                }
324        }
325        return 0
326}
327
328
329proc bMotion_add_typofix { fix } {
330        global bMotion_typos bMotion_typo_mutex
331
332        if {$bMotion_typo_mutex != ""} {
333                return
334        }
335
336        lappend bMotion_typos $fix
337}
338
339#
340# replace things on lines
341proc bMotionDoInterpolation { line nick moreText { channel "" } } {
342        bMotion_putloglev 5 * "bMotionDoInterpolation: line = $line, nick = $nick, moreText = $moreText, channel = $channel"
343        global botnick bMotionCache
344
345        bMotion_putloglev 4 * "doing misc interpolation processing for $line"
346        set line [bMotionInsertString $line "%%" $nick]
347        set line [bMotionInsertString $line "%2" $moreText]
348        set line [bMotionInsertString $line "%percent" "%"]
349
350        bMotion_putloglev 4 * "bMotionDoInterpolation returning: $line"
351        return $line
352}
353
354#
355# more replacements in a line
356# TODO: why was this separate?
357proc bMotionInterpolation2 { line } {
358        bMotion_putloglev 5 * "bMotionInterpolation2 ($line)"
359
360        return $line
361}
362
363#
364# Process a line
365# TODO: why is this separate or at least such a mess :)
366proc bMotionSayLine {channel nick line {moreText ""} {noTypo 0} {urgent 0} } {
367        bMotion_putloglev 5 * "bMotionSayLine: channel = $channel, nick = $nick, line = $line, moreText = $moreText, noTypo = $noTypo"
368        global mood botnick bMotionInfo bMotionCache bMotionOriginalInput
369        global bMotion_output_delay
370
371        #TODO: Put %ruser and %rbot back in here
372        # XXX: is the above TODO still valid?
373
374        #if it's a bot , put it on the queue on the remote bot
375        if [regexp -nocase {%(BOT)\[(.+?)\]} $line matches botcmd cmd] {
376                set condition ""
377                set dobreak 0
378                if {$botcmd == "bot"} {
379                #random
380                        bMotion_putloglev 1 * "bMotion: %bot detected"
381                        regexp {%bot\[([[:digit:]]+),(@[^,]+,)?(.+)\]} $line matches chance condition cmd
382                        bMotion_putloglev 1 * "bMotion: %bot chance is $chance"
383                        set dobreak 1
384                        if {[rand 100] < $chance} {
385                                set line "%BOT\[$cmd\]"
386                                set dobreak 0
387                        } else {
388                                set line ""
389                        }
390                } else {
391                #non-random
392                        regexp {%BOT\[(@[^,]+,)?(.+)\]} $line matches condition cmd
393                }
394
395                if {($condition != "") && [regexp {^@(.+),$} $condition matches c]} {
396                        set condition $c
397                } else {
398                        if {$condition != ""} {
399                                set cmd $condition
400                                set condition ""
401                        }
402                }
403
404                if {$line != ""} {
405                        set bot [bMotion_choose_random_user $channel 1 $condition]
406                        bMotion_putloglev 1 * "bMotion: queuing botcommand !$cmd! for output to $bot"
407                        bMotion_queue_add $channel "@${bot}@$cmd"
408                }
409
410                if {$dobreak == 1} {
411                        return 1
412                }
413                return 0
414        }
415
416        #if it's a %STOP, abort this
417        if {$line == "%STOP"} {
418                set line ""
419                return 1
420        }
421
422        if [regexp {%DELAY\{([0-9]+)\}} $line matches delay] {
423                set bMotion_output_delay $delay
424                bMotion_putloglev d * "Changing output delay to $delay"
425                set line ""
426        }
427
428        if {$mood(stoned) > 3} {
429                if [rand 2] {
430                        set line "$line man.."
431                } else {
432                        if [rand 2] {
433                                set line "$line dude..."
434                        }
435                }
436        }
437
438        if {[string index $line end] == " "} {
439                set line [string range $line 0 end-1]
440        }
441
442        #check if this line matches the last line said on IRC
443        global bMotionThisText
444        if [string match -nocase $bMotionThisText $line] {
445                bMotion_putloglev 1 * "bMotion: my output matches the trigger, dropping"
446                return 0
447        }
448
449        #protect this block - it'll generate an error if noone's talked yet, and then
450        #we try an admin plugin
451        if [info exists bMotionOriginalInput] {
452                if [string match -nocase $bMotionOriginalInput $line] {
453                        bMotion_putloglev 1 * "my output matches the trigger, dropping"
454                        return 0
455                }
456        }
457
458        set line [bMotionInsertString $line "%slash" "/"]
459
460        global bMotion_output_delay
461
462        if [regexp "^/" $line] {
463        #it's an action
464                mee $channel [string range $line 1 end] $urgent
465        } else {
466                if {$urgent} {
467                        bMotion_queue_add_now [chandname2name $channel] $line
468                } else {
469                        bMotion_queue_add [chandname2name $channel] $line $bMotion_output_delay
470                }
471        }
472        return 0
473}
474
475#
476# Helper function to swap one thing (like a macro) for another
477proc bMotionInsertString {line swapout toInsert} {
478        bMotion_putloglev 5 * "bMotionInsertString ($line, $swapout, $toInsert)"
479        set loops 0
480        set inputLine $line
481        while {[regexp $swapout $line]} {
482                regsub $swapout $line $toInsert line
483                incr loops
484                if {$loops > 10} {
485                        putlog "bMotion: ALERT! Bailed in bMotionInsertString with $inputLine (created $line) (was changing $swapout for $toInsert)"
486                        set line "/has a tremendous failure :("
487                        return $line
488                }
489        }
490        return $line
491}
492
493#
494# Get random chars as would be made by shift-numberkeys
495proc bMotionGetColenChars {} {
496        bMotion_putloglev 5 * "bMotionGetColenChars"
497        set randomChar "!£$%^*@#~"
498
499        set randomChars [split $randomChar {}]
500
501        set length [rand 12]
502        set length [expr $length + 5]
503
504        set line ""
505
506        while {$length >= 0} {
507                incr length -1
508                append line [pickRandom $randomChars]
509        }
510
511        regsub -all "%" $line "%percent" line
512
513        return $line
514}
515
516#
517# make a smiley representing our mood
518# TOOD: still used?
519proc makeSmiley { mood } {
520        bMotion_putloglev 5 * "makeSmiley"
521        if {$mood > 30} {
522                return ":D"
523        }
524        if {$mood > 0} {
525                return ":)"
526        }
527        if {$mood == 0} {
528                return ":|"
529        }
530        if {$mood < -30} {
531                return ":C"
532        }
533        if {$mood < 0} {
534                return ":("
535        }
536        return ":?"
537}
538
539#
540# Attempt to clean a nickname up to a proper name
541proc bMotionWashNick { nick } {
542        bMotion_putloglev 5 * "bMotionWashNick ($nick)"
543        #remove leading
544        regsub {^[|`_\[]+} $nick "" nick
545
546        #remove trailing
547        regsub {[|`_\[]+$} $nick "" nick
548
549        return $nick
550}
551
552#
553# replace a nick with one of someone's IRL names
554# TODO: no longer used? if not, delete
555proc OLDbMotionGetRealName { nick { host "" }} {
556        bMotion_putloglev 5 * "bMotion: OLDbMotionGetRealName($nick,$host)"
557
558        #is it me?
559        global botnicks
560        set first {\m}
561        set last {\M}
562        if [regexp -nocase "${first}${botnicks}$last" $nick] {
563                return "me"
564        }
565
566        #first see if we've got a handle
567        if {![validuser $nick]} {
568                bMotion_putloglev 2 * "bMotion: getRealName not given a handle, assuming $nick!$host"
569                set host "$nick!$host"
570
571                set handle [finduser $host]
572                if {$handle == "*"} {
573                #not in bot
574                        bMotion_putloglev 2 * "bMotion: no match, washing nick"
575                        return [bMotionWashNick $nick]
576                }
577        } else {
578                set handle $nick
579        }
580
581        bMotion_putloglev 2 * "bMotion: getRealName looking for handle $handle"
582
583        # found a user, now get their real name
584        set realname [getuser $handle XTRA irl]
585        if {$realname == ""} {
586        #not set
587                return [bMotionWashNick $nick]
588        }
589        bMotion_putloglev 2 * "bMotion: found $handle, IRLs are $realname"
590        return [pickRandom $realname]
591}
592
593#
594# replace a nick with one of someone's IRL names
595proc bMotionGetRealName { nick { host "" }} {
596        bMotion_putloglev 5 * "bMotion: bMotionGetRealName($nick,$host)"
597
598        if {$nick == ""} {
599                return ""
600        }
601
602        #is it me?
603        if [isbotnick $nick] {
604                return "me"
605        }
606
607        if [validuser $nick] {
608        #it's a handle already
609                set handle $nick
610        } else {
611        #try to figure it out
612                set handle [nick2hand $nick]
613                if {($handle == "") ||($handle == "*")} {
614                #not in bot
615                        bMotion_putloglev 2 * "bMotion: no match, using nick"
616                        return $nick
617                }
618        }
619
620        bMotion_putloglev 2 * "bMotion: $nick is handle $handle"
621
622        # found a user, now get their real name
623        set realname [getuser $handle XTRA irl]
624        if {$realname == ""} {
625        #not set
626                bMotion_putloglev 2 * "no IRL set, using nick"
627                return $nick
628        }
629       
630        bMotion_putloglev 2 * "bMotion: IRLs for $handle are $realname"
631       
632        set chosen_realname [pickRandom $realname]
633
634        if {[string first "%" $chosen_realname] > -1} {
635                bMotion_putloglev d * "not using $chosen_realname for $handle as it has a macro"
636                set chosen_realname $handle
637        }
638        return $chosen_realname
639}
640
641#
642#
643proc bMotionTransformNick { target nick {host ""} } {
644        bMotion_putloglev 5 * "bMotionTransformNick($target, $nick, $host)"
645        set newTarget [bMotionTransformTarget $target $host]
646        if {$newTarget == "me"} {
647                set newTarget $nick
648        }
649        return $newTarget
650}
651
652#
653#
654proc bMotionTransformTarget { target {host ""} } {
655        bMotion_putloglev 5 * "bMotionTransformTarget($target, $host)"
656        global botnicks
657        if {$target != "me"} {
658                set t [bMotionGetRealName $target $host]
659                bMotion_putloglev 2 * "bMotion: bMotionGetName in bMotionTransformTarget returned $t"
660                if {$t != "me"} {
661                        set target $t
662                }
663        } else {
664                set himself {\m(your?self|}
665                append himself $botnicks
666                append himself {)\M}
667                if [regexp -nocase $himself $target] {
668                        set target [getPronoun]
669                }
670        }
671        return $target
672}
673
674# bMotion_choose_random_user
675#
676# selects a random user or bot from a channel
677# bot = 0 if you want a user, = 1 if you want a bot
678# condition is one of:
679#               * "" - anyone
680#               * male, female - pick by gender
681#               * like, dislike - pick by if we'd do them
682#               * friend, enemy - pick by if we're friends
683#               * prev - return previously chosen user/bot
684proc bMotion_choose_random_user { channel bot condition } {
685        bMotion_putloglev 5 * "ruser: bMotion_choose_random_user ($channel, $bot, $condition)"
686        global bMotionCache
687        set users [chanlist $channel]
688        set acceptable [list]
689
690        set skip_nick [bMotion_plugins_settings_get "system" "ruser_skip" $channel ""]
691        bMotion_plugins_settings_set "system" "ruser_skip" $channel "" ""
692        if {$skip_nick != ""} {
693                bMotion_putloglev d * "ruser skipping $skip_nick"
694        }
695
696        #check if we want the previous ruser
697        if {$condition == "prev"} {
698                set what [list "" ""]
699                catch {
700                        set what [array get bMotionCache "lastruser$bot"]
701                }
702                bMotion_putloglev 4 * "ruser: accept: prev ($what)"
703                return [lindex $what 1]
704        }
705
706        foreach user $users {
707                bMotion_putloglev 4 * "ruser: eval user $user"
708                #is it me?
709                if [isbotnick $user] { 
710                        bMotion_putloglev 4 * "ruser:  that's me"
711                        continue 
712                }
713
714                if {([bMotion_setting_get "bitlbee"] == "1") && ($user == "root")} {
715                        bMotion_putloglev 4 * "ruser:  reject: bitlbee root user"
716                        continue
717                }
718
719                if {$user == $skip_nick} {
720                        bMotion_putloglev 4 * "ruser:  reject: $user is skip_user"
721                        continue
722                }
723
724                #get their handle
725                set handle [nick2hand $user $channel]
726                bMotion_putloglev 4 * "ruser:  handle: $handle"
727
728                # some people don't like interacting with the bot
729                if [matchattr $handle J] {
730                        bMotion_putloglev 4 * "ruser:  reject: user is +J"
731                        continue
732                }
733
734                #unless we're looking for any old user, we'll need handle
735                if {(($handle == "") || ($handle == "*")) && ($condition != "")} {
736                        bMotion_putloglev 4 * "ruser:  reject: no handle"
737                        continue
738                }
739
740                #else, if we're accepting anyone and they don't have a handle, and
741                #we don't want a bot, then use nick
742                if {(($handle == "") || ($handle == "*")) && ($condition == "") && ($bot == 0)} {
743                        bMotion_putloglev 4 * "ruser:  accept: $user (no handle)"
744                        lappend acceptable $user
745                        continue
746                }
747
748                #if we're looking for a bot, drop this entry if it's not one
749                if {$bot == 1} {
750                        if {![matchattr $handle b]} {
751                                bMotion_putloglev 4 * "ruser:  reject: not a bot"
752                                continue
753                        }
754                        #check we can talk to this bot
755                        global bMotion_interbot_otherbots
756                        if {[lsearch [array names bMotion_interbot_otherbots] $handle] == -1} {
757                                bMotion_putloglev 4 * "ruser:  reject: not a bmotion bot"
758                                continue
759                        }
760                        #else add them
761                        lappend acceptable $user
762                        bMotion_putloglev 4 * "ruser:  accept: bmotion bot"
763                        continue
764                }
765
766                #conversely if we're looking for a user...
767                if {($bot == 0) && [matchattr $handle b]} {
768                        bMotion_putloglev 4 * "ruser:  reject: not a user"
769                        continue
770                }
771
772                switch $condition {
773                        "" {
774                                bMotion_putloglev 4 * "ruser:  accept: any"
775                                lappend acceptable $handle
776                                continue
777                        }
778                        "male" {
779                                if {[getuser $handle XTRA gender] == "male"} {
780                                        bMotion_putloglev 4 * "ruser:  accept: male"
781                                        lappend acceptable $handle
782                                        continue
783                                }
784                        }
785                        "female" {
786                                if {[getuser $handle XTRA gender] == "female"} {
787                                        bMotion_putloglev 4 * "ruser:  accept: female"
788                                        lappend acceptable $handle
789                                        continue
790                                }
791                        }
792                        "like" {
793                                if {[bMotionLike $user [getchanhost $user]]} {
794                                        bMotion_putloglev 4 * "ruser:  accept: like"
795                                        lappend acceptable $handle
796                                        continue
797                                }
798                        }
799                        "dislike" {
800                                if {![bMotionLike $user [getchanhost $user]]} {
801                                        bMotion_putloglev 4 * "ruser:  accept: dislike"
802                                        lappend acceptable $handle
803                                        continue
804                                }
805                        }
806                        "friend" {
807                                if {[getFriendshipHandle $handle] >= 50} {
808                                        bMotion_putloglev 4 * "ruser:  accept: friend"
809                                        lappend acceptable $handle
810                                        continue
811                                }
812                        }
813                        "enemy" {
814                                if {[getFriendshipHandle $handle] < 50} {
815                                        bMotion_putloglev 4 * "ruser:  accept: enemy"
816                                        lappend acceptable $handle
817                                        continue
818                                }
819                        }
820                }
821        }
822        bMotion_putloglev 4 * "ruser: acceptable users: $acceptable"
823        if {[llength $acceptable] > 0} {
824                set user [pickRandom $acceptable]
825                set index "lastruser$bot"
826                set bMotionCache($index) $user
827                return $user
828        } else {
829                bMotion_putloglev 4 * "ruser: no acceptable users found"
830                if {$condition != ""} {
831                        bMotion_putloglev 4 * "ruser: picking a random user"
832                        return [bMotion_choose_random_user $channel $bot ""]
833                } else {
834                        bMotion_putloglev 4 * "ruser: unable to find a user, returning nothing"
835                        return ""
836                }
837        }
838}
839
840#
841# turn a name into the posessive form
842proc bMotionMakePossessive { text { altMode 0 }} {
843        bMotion_putloglev 5 * "bMotionMakePossessive ($text, $altMode)"
844        if {$text == ""} {
845                return "someone's"
846        }
847
848        if {$text == "me"} {
849                if {$altMode == 1} {
850                        return "mine"
851                }
852                return "my"
853        }
854
855        if {$text == "you"} {
856                if {$altMode == 1} {
857                        return "yours"
858                }
859                return "your"
860        }
861
862        if [regexp -nocase "s$" $text] {
863                return "$text'"
864        }
865        return "$text's"
866}
867
868#
869# Function which powers %REPEAT
870proc bMotionMakeRepeat { text } {
871        bMotion_putloglev 5 * "bMotionMakeRepeat ($text)"
872        if [regexp {([0-9]+):([0-9]+):(.+)} $text matches min max repeat] {
873                bMotion_putloglev 4 * "bMotionMakeRepeat: min = $min, max = $max, text = $repeat"
874                set diff [expr $max - $min]
875                if {$diff < 1} {
876                        set diff 1
877                }
878                set count [rand $diff]
879                set repstring [string repeat $repeat $count]
880                append repstring [string repeat $repeat $min]
881                return $repstring
882        }
883        bMotion_putloglev 4 * "bMotionMakeRepeat: no match (!), returning nothing"
884        return ""
885}
886
887#
888# remove preceeding fluff from a noun
889proc bMotion_strip_article { text } {
890        bMotion_putloglev 5 * "bMotion_strip_article ($text)"
891        regsub "(an?|the|some|his|her|their) " $text "" text
892        return $text
893}
894
895#
896# verbs a noun (like that)
897proc bMotionMakeVerb { text } {
898        bMotion_putloglev 5 * "bMotionMakeVerb ($text)"
899        if [regexp -nocase "(s|x)$" $text matches letter] {
900                return $text
901        }
902
903        if [regexp -nocase "^(.*)y$" $text matches root] {
904                set verb $root
905                append verb "ies"
906                return $verb
907        }
908
909        append text "s"
910        return $text
911}
912
913#
914# makes a word past tense... probably best only use it on verbs :P
915proc bMotion_make_past_tense { word } {
916
917        # check if we got passed a multi-part verb (sit on)
918        set extra ""
919        regexp -nocase {^(\w+)( (.+))?} $word matches verb extra
920        set newverb ""
921
922        # handle irregual verbs
923        switch $verb {
924                cut { set newverb $verb }
925                hit { set newverb $verb }
926                fit { set newverb $verb }
927                get { set newverb got }
928                sit { set newverb sat }
929                drink { set newverb drank }
930                catch { set newverb caught }
931                bring { set newverb brought }
932                buy { set newverb bought}
933                teach { set newverb taught }
934                have { set newverb had }
935                do { set newverb did }
936                ride { set newverb rode }
937                go { set newverb went }
938                make { set newverb made }
939        }
940
941        if {$newverb != ""} {
942                return "${newverb}$extra"
943        }
944
945        # verbs ending in e get -ed
946        if [string match -nocase "*e" $verb] {
947                append verb "d"
948                set newverb $verb
949        }
950
951        if {$newverb != ""} {
952                return "${newverb}$extra"
953        }
954
955        # ending in const-y get -ied
956        if [regexp -nocase {(.+[^aeiouy])y$} $verb matches a] {
957                set newverb "${a}ied"
958        }
959
960        if {$newverb != ""} {
961                return "${newverb}$extra"
962        }
963
964        # one vowel + const !wy get double const + ed
965        if [regexp -nocase {(.+[^aeiouy][aeiou])([^aeiouwy])\M} $verb matches a b] {
966                set newverb "${a}${b}${b}ed"
967        }
968
969        if {$newverb != ""} {
970                return "${newverb}$extra"
971        }
972
973        # everything else just gets -ed
974        set newverb "${verb}ed"
975
976        return "${newverb}$extra"
977}
978
979#
980# makes a word into present participle
981proc bMotion_make_present_participle { word } {
982
983        # check if we got passed a multi-part verb (sit on)
984        set extra ""
985        regexp -nocase {^(\w+)( (.+))?} $word matches verb extra
986
987        if [regexp -nocase {(.+[^i])e$} $verb matches a] {
988                return "${a}ing$extra"
989        }
990
991        if [regexp -nocase {(.+[aeiou])([^aeiouy])$} $verb matches a b] {
992                return "${a}${b}${b}ing$extra"
993        }
994
995        return "${verb}ing$extra"
996}
997
998#
999# makes a work into the simple present
1000proc bMotion_make_simple_present { word } {
1001
1002        # check if we got passed a multi-part verb (sit on)
1003        set extra ""
1004        regexp -nocase {^(\w+)( (.+))?} $word matches verb extra
1005
1006        return "${verb}s$extra"
1007}
1008
1009#
1010# not sure!
1011proc chr c {
1012        if {[string length $c] > 1 } { error "chr: arg should be a single char"}
1013        #               set c [ string range $c 0 0]
1014        set v 0
1015        scan $c %c v
1016        return $v
1017}
1018
1019#
1020# pluralise a noun by the simple rules of English
1021proc bMotionMakePlural { text } {
1022        bMotion_putloglev 5 * "bMotionMakePlural ($text)"
1023
1024        if [regexp -nocase "(ss|us|is|x|ch|sh)$" $text] {
1025                append text "es"
1026                return $text
1027        }
1028
1029
1030        if [regexp -nocase {s$} $text] {
1031                return $text
1032        }
1033
1034        if [regexp -nocase "^(.*)f$" $text matches root] {
1035                set plural $root
1036                append plural "ves"
1037                return $plural
1038        }
1039
1040        if [regexp -nocase "^(.*)y$" $text matches root] {
1041                set plural $root
1042                append plural "ies"
1043                return $plural
1044        }
1045
1046        append text "s"
1047        return $text
1048
1049}
1050
1051#
1052# get a smiley
1053proc bMotion_get_smiley { type } {
1054        set smiley_type [bMotion_setting_get "smiley_type"]
1055
1056        if {($smiley_type == "") || ($smiley_type == "auto")} {
1057                #need to auto-calculate it
1058                bMotion_auto_smiley
1059                set smiley_type [bMotion_setting_get "smiley_type"]
1060        }
1061
1062        set nose_type [bMotion_setting_get "smiley_nose"]
1063        set eyes_type [bMotion_setting_get "smiley_eyes"]
1064
1065        bMotion_putloglev d * "smiley type=$smiley_type nose=$nose_type eyes=$eyes_type"
1066
1067        switch $nose_type {
1068                none {
1069                        set nose ""
1070                }
1071
1072                dash {
1073                        set nose "-"
1074                }
1075
1076                o {
1077                        set nose "o"
1078                }
1079
1080                default {
1081                        set nose ""
1082                }
1083        }
1084
1085        switch $eyes_type {
1086                colon {
1087                        set eyes ":"
1088                }
1089
1090                equals {
1091                        set eyes "="
1092                        if {$nose == "-"} {
1093                                set nose "o"
1094                        }
1095                }
1096
1097                default {
1098                        set eyes ":"
1099                }
1100        }
1101
1102
1103        # smile, bigsmile, sad, bigsad, horror, surprise, bigsurprise,
1104        # uneasy, embarrassed, cry, cat, yum
1105        switch $smiley_type {
1106                paren {
1107                        bMotion_putloglev d * "using paren"
1108                        set smileys {)D(CDoO/x(39}
1109                }
1110
1111                bracket {
1112                        bMotion_putloglev d * "using bracket"
1113                        set smileys {]D[CDoO/x[39}
1114                }
1115
1116                angle {
1117                        bMotion_putloglev d * "using angle"
1118                        set nose ""
1119                        set smileys {>D<CDoO/x<39}
1120                }
1121
1122                default {
1123                        bMotion_putloglev d * "using default"
1124                        set smileys {)D(CDoO/x(39}
1125                }
1126        }
1127       
1128        bMotion_putloglev d * "smiley list is $smileys"
1129
1130        set reverse 0
1131        set index -1
1132        set termlist [list "smile" "bigsmile" "sad" "bigsad" "horror" "surprise" "bigsurprise" "uneasy" "embarrassed" "cry" "cat" "yum"]
1133        set index [lsearch $termlist $type]
1134        if {$index == -1} {
1135                bMotion_putloglev d * "Unable to determine smiley type for $type"
1136                return ""
1137        }
1138
1139        set smile [string range $smileys $index $index]
1140
1141        if {$type == "horror"} {
1142                set reverse 1
1143        }
1144
1145        if {$type == "cry"} {
1146                set nose "'"
1147        }
1148
1149        if {$reverse == 0} {
1150                return "${eyes}${nose}${smile}"
1151        }
1152
1153        return "${smile}${nose}${eyes}"
1154}
1155
1156
1157
1158
1159
1160
1161bMotion_putloglev d * "bMotion: output module loaded"
Note: See TracBrowser for help on using the repository browser.