source: tags/start/modules/output.tcl @ 1143

Revision 2, 19.2 KB checked in by jamesoff, 9 years ago (diff)

Initial revision
  • 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# $Id$
4#
5
6###############################################################################
7# bMotion - an 'AI' TCL script for eggdrops
8# Copyright (C) James Michael Seward 2000-2002
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful, but
16# WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18# General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23###############################################################################
24
25proc pickRandom { list } {
26  return [lindex $list [rand [llength $list]]]
27}
28
29proc getPronoun {} {
30  global bMotionInfo
31  if {$bMotionInfo(gender) == "male"} { return "himself" }
32  if {$bMotionInfo(gender) == "female"} { return "herself" }
33  return "itself"
34}
35
36proc getHisHers {} {
37  global bMotionInfo
38  if {$bMotionInfo(gender) == "male"} { return "his" }
39  if {$bMotionInfo(gender) == "female"} { return "hers" }
40  return "its"
41}
42
43proc getHisHer {} {
44  global bMotionInfo
45  if {$bMotionInfo(gender) == "male"} { return "his" }
46  if {$bMotionInfo(gender) == "female"} { return "her" }
47  return "it"
48}
49
50
51proc getHeShe {} {
52  global bMotionInfo
53  if {$bMotionInfo(gender) == "male"} { return "he" }
54  if {$bMotionInfo(gender) == "female"} { return "she" }
55  return "it"
56}
57
58
59proc mee {channel action} {
60  #puthelp "PRIVMSG $channel :\001ACTION $action\001"
61  global bMotionQueue
62  bMotionQueueCheck
63  lappend bMotionQueue "PRIVMSG $channel :\001ACTION $action\001"
64
65}
66
67
68## bMotionDoAction ###########################################################
69proc bMotionDoAction {channel nick text {moreText ""} {noTypo 0}} {
70  bMotion_putloglev 4 * "bMotion: bMotionDoAction($channel,$nick,$text,$moreText,$noTypo)"
71  global bMotionInfo bMotionCache
72  set bMotionCache($channel,last) 1
73  set bMotionCache(typos) 0
74  set bMotionCache(typoFix) ""
75
76  set channel [string tolower $channel]
77  if {[lsearch $bMotionInfo(randomChannels) [string tolower $channel]] < 0} {
78    bMotion_putloglev d * "bMotion: aborting bMotionDoAction ... $channel not allowed"
79    return 0
80  }
81
82  if {$bMotionInfo(silence) == 1} { return 0 }
83  if {$bMotionInfo(adminSilence,$channel) == 1} { return 0 }
84
85  set chance [rand 3]
86  switch [rand 3] {
87    0 { }
88    1 { set nick [string tolower $nick] }
89    2 { set nick "[string range $nick 0 0][string tolower [string range $nick 1 end]]" }
90  } 
91
92  #choose a remote bot
93  if [regexp -nocase "%bot" $text] {
94    set thisBot [bMotionChooseRandomBot $channel]
95    bMotion_putloglev d * "bMotion: Chosen bot $thisBot"
96    set bMotionCache(remoteBot) $thisBot
97    if {$thisBot == ""} {
98      putlog "bMotion: ALERT! While trying to say !$text! to $channel couldn't find a bot to talk to. Lost entire output."
99      return 0
100    }
101  }
102
103  #choose a remote user
104  if [regexp -nocase "%ruser" $text] {
105    set ruser [bMotionChooseRandomUser $channel]
106    bMotion_putloglev d * "bMotion: Chosen user $ruser"
107    set bMotionCache(randomUser) $ruser
108  }
109
110
111  #do this first now
112  set text [bMotionDoInterpolation $text $nick $moreText $channel]
113
114  set multiPart 0
115  if [string match "*%|*" $text] {
116    set multiPart 1
117    # we have many things to do
118    set thingsToSay ""
119    set loopCount 0
120    set blah 0
121   
122    #make sure we get the last section
123    set text "$text%|"
124
125    while {[string match "*%|*" $text]} {
126      set sentence [string range $text 0 [expr [string first "%|" $text] -1]]
127      if {$sentence != ""} { 
128        if {$blah == 0} {
129          set thingsToSay [list $sentence] 
130          set blah 1
131        } else {
132          lappend thingsToSay $sentence
133        }
134      }
135      set text [string range $text [expr [string first "%|" $text] + 2] end]
136      incr loopCount
137      if {$loopCount > 20} { 
138        putlog "bMotion ALERT! Bailed in bMotionDoAction with $text. Lost output."
139        return 0
140      }
141    }
142  }
143
144  if {$multiPart == 1} {
145    foreach lineIn $thingsToSay {
146      set temp [bMotionSayLine $channel $nick $lineIn $moreText $noTypo]
147      if {$temp == 1} {
148        bMotion_putloglev 1 * "bMotion: bMotionSayLine returned 1, skipping rest of output"
149        #1 stops continuation after a failed %bot[n,]
150        break
151      }
152    }
153    set typosDone [bMotion_plugins_settings_get "output:typos" "typosDone" "" ""]
154    bMotion_putloglev 2 * "bMotion: typosDone (multipart) is !$typosDone!"
155    if {$typosDone != ""} {
156      bMotion_plugins_settings_set "output:typos" "typosDone" "" "" ""
157      bMotion_plugins_settings_set "output:typos" "typos" "" "" ""     
158      if [rand 2] {
159        bMotionDoAction $channel "" "%VAR{typoFix}" "" 1
160      }
161
162    }
163    return 0
164  }
165
166  bMotionSayLine $channel $nick $text $moreText $noTypo
167  set typosDone [bMotion_plugins_settings_get "output:typos" "typosDone" "" ""]
168  bMotion_putloglev 2 * "bMotion: typosDone is !$typosDone!"
169  if {$typosDone != ""} {
170    bMotion_plugins_settings_set "output:typos" "typosDone" "" "" ""
171    bMotion_plugins_settings_set "output:typos" "typos" "" "" ""   
172    if [rand 2] {
173      bMotionDoAction $channel "" "%VAR{typoFix}" "" 1
174    }
175  }
176
177  return 0
178}
179
180proc bMotionDoInterpolation { line nick moreText { channel "" } } {
181  global botnick sillyThings bMotionCache
182
183  #drop out immediately if this is a %BOT
184  #if [regexp -nocase "^%BOT" $line] {
185  #  return $line
186  #}
187
188  set loops 0
189  while {[regexp "%VAR\{(.+?)\}" $line matches BOOM]} {
190    global $BOOM
191    incr loops
192    if {$loops > 10} {
193      putlog "bMotion: ALERT! looping too much in %VAR code with $line"
194      set line "/has a tremendous error while trying to sort something out :("
195    }
196    set var [subst $$BOOM]
197    set line [bMotionInsertString $line "%VAR\{$BOOM\}" [pickRandom $var]]
198  }
199
200  set loops 0
201  while {[regexp "%SETTING\{(.+?)\}" $line matches settingString]} {
202    if [regexp {([^:]+:[^:]+):([^:]+):([^:]+):([^:]+)} $settingString matches plugin setting ch ni] {
203      set var [bMotion_plugins_settings_get $plugin $setting $ch $ni]
204    }
205    incr loops
206    if {$loops > 10} {
207      putlog "bMotion: ALERT! looping too much in %SETTING code with $line"
208      set line "/has a tremendous error while trying to infer the meaning of life :("
209    }
210    set line [bMotionInsertString $line "%SETTING{$settingString}" $var]
211  }
212 
213  set line [bMotionInsertString $line "%%" $nick]
214  set line [bMotionInsertString $line "%pronoun" [getPronoun]]
215  set line [bMotionInsertString $line "%me" $botnick]
216  set line [bMotionInsertString $line "%noun" [pickRandom $sillyThings]]
217  set line [bMotionInsertString $line "%colen" [bMotionGetColenChars]]
218  set line [bMotionInsertString $line "%hishers" [getHisHers]]
219  set line [bMotionInsertString $line "%heshe" [getHeShe]]
220  set line [bMotionInsertString $line "%hisher" [getHisHer]]
221  set line [bMotionInsertString $line "%2" $moreText]
222  set line [bMotionInsertString $line "%percent" "%"]
223  #ruser moved
224  #rbot moved
225  return $line
226}
227
228proc bMotionSayLine {channel nick line {moreText ""} {noTypo 0}} {
229  global mood botnick bMotionInfo sillyThings bMotionCache
230
231  #choose a new bot?
232  if [regexp {^%PICKBOT\[(.+)?\]} $line matches conditions] {
233    #pick a bot
234    set thisBot [bMotionChooseRandomBot $channel $conditions]
235    bMotion_putloglev d * "bMotion: Chosen new bot $thisBot"
236    set bMotionCache(remoteBot) $thisBot
237    if {$thisBot == ""} {
238      putlog "bMotion: ALERT! Can't find a bot matching conditions !$conditions! in $channel to talk to. Lost output."
239      return 1
240    }
241    return 0
242  }
243
244  #choose a new user?
245  if [regexp {^%PICKUSER\[(.+)?\]} $line matches conditions] {
246    set ruser [bMotionChooseRandomUser $channel $conditions]
247    bMotion_putloglev d * "bMotion: Chosen new user $ruser"
248    set bMotionCache(randomUser) $ruser
249    return 0
250  }
251
252  #safe to do these here
253  #try to get sensible names
254  set uhost [getchanhost $bMotionCache(randomUser)]
255  set ruser [bMotionGetRealName $bMotionCache(randomUser) $uhost]
256  set line [bMotionInsertString $line "%ruser" $ruser]
257
258  set uhost [getchanhost $bMotionCache(remoteBot)]
259  putloglev 3 * "bMotion: remote bothost = $uhost"
260  set rbot [bMotionGetRealName $bMotionCache(remoteBot) $uhost]
261  putloglev 3 * "bMotion: remote bot nick = $rbot"
262  set line [bMotionInsertString $line "%rbot" $rbot]
263
264  #owners
265  set loops 0
266  while {[regexp -nocase "%OWNER\{(.+?)\}" $line matches BOOM]} {
267    incr loops
268    if {$loops > 10} {
269      putlog "bMotion: ALERT! looping too much in %OWNER code with $line"
270      set line "/has a tremendous error while trying to sort something out :("
271    }
272    set line [bMotionInsertString $line "%OWNER\{$BOOM\}" [bMotionMakePossessive $BOOM]]
273  }
274
275
276  #if it's a bot , put it on the queue with no more processing
277  if [regexp -nocase {%(BOT)\[(.+?)\]} $line matches botcmd cmd] {
278    set dobreak 0
279    if {$botcmd == "bot"} {
280      #random
281      bMotion_putloglev 1 * "bMotion: %bot detected"
282      regexp {%bot\[([[:digit:]]+),(.+)\]} $line matches chance cmd
283      bMotion_putloglev 1 * "bMotion: %bot chance is $chance"
284      set dobreak 1
285      if {[rand 100] < $chance} {
286        set line "%BOT\[$cmd\]"
287        set dobreak 0
288      } else {
289        set line ""
290      }
291    }
292
293    if {$line != ""} {
294      global bMotionQueue
295      bMotionQueueCheck
296      append line " $bMotionCache(remoteBot)"
297      bMotion_putloglev 1 * "bMotion: queuing botcommand !$cmd! for output"
298      lappend bMotionQueue "$channel $line"
299    }
300
301    if {$dobreak == 1} {
302      return 1
303    }
304    return 0
305  }
306
307  #if it's a %STOP, abort this
308  if {$line == "%STOP"} {
309    set line ""
310    return 1
311  }
312
313
314  if {$mood(stoned) > 3} {
315    if [rand 2] {
316      set line "$line man.."
317    } else {
318      if [rand 2] {
319        set line "$line dude..."
320      }
321    }
322  }
323
324  # Run the plugins :D
325
326  if {$noTypo == 0} {
327    set plugins [bMotion_plugin_find_output $bMotionInfo(language)]
328    if {[llength $plugins] > 0} {
329      foreach callback $plugins {
330        bMotion_putloglev d * "bMotion: output plugin: $callback..."
331        catch {
332          set result [$callback $channel $line]
333        } err
334        bMotion_putloglev 3 * "bMotion: returned from output $callback ($result)"
335        if [regexp "1Š(.+)" $result matches line] {
336          break
337        }
338        set line $result
339      }
340    }
341  }
342
343  if [regexp "^/" $line] {
344    set line [bMotionInsertString $line "%slash" "/"]
345    #it's an action
346    mee $channel [string range $line 1 end]
347  } else {
348    global bMotionQueue
349    set line [bMotionInsertString $line "%slash" "/"]
350    bMotionQueueCheck
351    bMotion_putloglev 1 * "bMotion: queuing !PRIVMSG $channel :$line! for output"
352    lappend bMotionQueue "PRIVMSG $channel :$line"
353  }
354  return 0
355}
356
357proc bMotionInsertString {line swapout toInsert} {
358  set loops 0
359  set inputLine $line
360  while {[regexp $swapout $line]} {
361    regsub $swapout $line $toInsert line
362    incr loops
363    if {$loops > 10} {
364      putlog "bMotion: ALERT! Bailed in bMotionInsertString with $inputLine (created $line) (was changing $swapout for $toInsert)"
365      set line "/has a tremendous failure :("
366      return $line
367    }
368  }
369  return $line
370}
371
372proc bMotionGetColenChars {} {
373  set randomChar "!£$%^*@#~"
374
375  set randomChars [split $randomChar {}]
376
377  set length [rand 12]
378  set length [expr $length + 5]
379
380  set line ""
381
382  while {$length >= 0} {
383    incr length -1
384    append line [pickRandom $randomChars]
385  }
386
387  regsub -all "%%" $line "%percent" line
388
389  return $line
390}
391
392proc makeSmiley { mood } {
393  if {$mood > 30} {
394    return ":D"
395  }
396  if {$mood > 0} {
397    return ":)"
398  }
399  if {$mood == 0} {
400    return ":|"
401  }
402  if {$mood < -30} {
403    return ":C"
404  }
405  if {$mood < 0} {
406    return ":("
407  }
408  return ":?"
409}
410
411## Wash nick
412#    Attempt to clean a nickname up to a proper name
413#
414proc bMotionWashNick { nick } {
415  # strip numbers off the nick
416  #putlog "Examining $nick"
417  if [regexp -nocase {^([[:digit:]]+)?([[:alpha:]]+)([[:digit:]]{2,})?$} $nick matches numbers1 stem numbers2] {
418    #putlog "Stripping surrounding numbers"
419    set nick $stem
420  }
421
422  #strip `'- and |s off beginning and end
423  if [regexp -nocase {^[\|`\'\-\_^\[\]\{\}]?([[:alnum:]]+)[\|`\'\-\_^\[\]\{\}]?$} $nick matches stem] {
424    #putlog "Stripping surrounding |s"
425    set nick $stem
426  }
427
428  #try for numbers again, just in case
429  if [regexp -nocase {^([[:digit:]]+)?([[:alpha:]]+)([[:digit:]]{2,})?$} $nick matches numbers1 stem numbers2] {
430    #putlog "Stripping surrounding numbers again"
431    set nick $stem
432  }
433
434  #slice after `'-^_ and |
435  if [regexp -nocase {^([[:alnum:]]+)[`\'\|\-^_\[\]\{\}].*} $nick matches stem] {
436    set nick $stem
437  }
438
439  return $nick
440}
441
442proc bMotionGetRealName { nick { host "" }} {
443  bMotion_putloglev 4 * "bMotion: bMotionGetRealName($nick,$host)"
444
445  #is it me?
446  global botnicks
447  set first {[[:<:]]}
448  set last {[[:>:]]}
449  if [regexp -nocase "${first}${botnicks}$last" $nick] {
450    return "me"
451  }
452
453  #first see if we've got a handle
454  if {![validuser $nick]} {
455    bMotion_putloglev 2 * "bMotion: getRealName not given a handle, assuming $nick!$host"
456    set host "$nick!$host"
457
458    set handle [finduser $host]
459    if {$handle == "*"} {
460      #not in bot
461      bMotion_putloglev 2 * "bMotion: no match, washing nick"
462      return [bMotionWashNick $nick]
463    }
464  } else {
465    set handle $nick
466  }
467
468  bMotion_putloglev 2 * "bMotion: getRealName looking for handle $handle"
469
470  # found a user, now get their real name
471  set realname [getuser $handle XTRA irl]
472  if {$realname == ""} {
473    #not set
474    return [bMotionWashNick $nick]
475  }
476  putloglev 2 * "bMotion: found $handle, IRLs are $realname"
477  return [pickRandom $realname]
478}
479
480proc bMotionTransformNick { target nick {host ""} } {
481  set newTarget [bMotionTransformTarget $target $host]
482  if {$newTarget == "me"} {
483    set newTarget $nick
484  }
485  return $newTarget
486}
487
488proc bMotionTransformTarget { target {host ""} } {
489  global botnicks
490  if {$target != "me"} {
491    set t [bMotionGetRealName $target $host]
492    bMotion_putloglev 2 * "bMotion: bMotionGetName in bMotionTransformTarget returned $t"
493    if {$t != "me"} {
494      set target $t
495    }
496  } else {
497    set himself {[[:<:]](your?self|}
498    append himself $botnicks
499    append himself {)[[:>:]]}
500    if [regexp -nocase $himself $target] {
501      set target [getPronoun]
502    }
503  }
504  return $target
505}
506
507proc bMotionProcessQueue { } {
508  global bMotionQueue bMotionQueueTimer
509  set bMotionQueueTimer 0
510  if {[llength $bMotionQueue] > 0} {
511    set next [lindex $bMotionQueue 0]
512      bMotion_putloglev 1 * "bMotion: processing queue, [llength $bMotionQueue] items remaining !$next!"
513    #maximum of 15 items in queue
514    set bMotionQueue [lrange $bMotionQueue 1 15]
515    set done 0
516
517    #check if it needs to go to a bot
518    if [regexp {(#[^ ]+) %BOT\[(.+?)\] (.+)} $next matches channel cmd bot] {
519      bMotion_putloglev 2 * "bMotion: matched 100% bot command for channel $channel -> $cmd"
520      global bMotionQueue
521      #bMotionQueueCheck
522      bMotionSendSayChan $channel $cmd $bot
523      set done 1
524    }
525
526    if [regexp {(#[^ ]+) %bot\[([[:digit:]]+),(.+?)\] (.+)} $next matches channel chance cmd bot] {
527      #push to a bot
528      bMotion_putloglev 2 * "bMotion: matched $chance% bot command for channel $channel -> $cmd"
529      if {[rand 100] < $chance} {
530        bMotionSendSayChan $channel $cmd $bot
531      }
532      set done 1
533    }
534    if {$done == 0} { puthelp $next }
535    if {[llength $bMotionQueue] == 0} {
536      bMotion_putloglev 1 * "bMotion: done queue"
537      return 0
538    }   
539
540    set next [lindex $bMotionQueue 0]
541    set delay [expr round([string length $next] / 5)]
542    if [string match -nocase "%bot*" $next] {
543      set delay 5
544    }
545    if {$delay > 7} {
546      set delay 6
547    }
548    bMotion_putloglev d * "bMotion: delay for next line: $delay (+ random)"
549
550    set bMotionQueueTimer 1
551    utimer [expr [rand 3] + $delay] bMotionProcessQueue
552  } else {
553    #0-length queue!
554    putlog "bMotion: WARNING! bMotionProcessQueue ran with no queue (possibly result of a .bmotion flush queue)"
555  }
556}
557
558proc bMotionQueueCheck { { initialDelay 2 } } {
559  #called just before an output function queues something
560  #if the timer needs to be run, run it
561  global bMotionQueue bMotionQueueTimer
562  if {([llength $bMotionQueue] == 0) && ($bMotionQueueTimer == 0)} {
563    bMotion_putloglev 1 * "bMotion: starting queue timer ($initialDelay)"
564    utimer $initialDelay bMotionProcessQueue
565    set bMotionQueueTimer 1
566  }
567}
568
569proc bMotionChooseRandomUser { channel { conditions ""}} {
570  bMotion_putloglev 2 * "bMotion: looking for a $conditions user"
571  global botnick
572  set users [chanlist $channel]
573  if {[llength $users] < 2} {
574    return $botnick
575  }
576
577  set userslist [list]
578  foreach user $users {
579    set handle [nick2hand $user]
580    if [matchattr $handle b] {
581      continue
582    }
583    if {$conditions != ""} {
584      if [string match -nocase [getuser $handle XTRA gender] $conditions] {
585        lappend userslist $user
586        bMotion_putloglev 1 * "bMotion: accepting user $handle for gender $conditions"
587      } else {
588        if {($conditions == "like") && [bMotionLike $user [getchanhost $user]]} {
589          lappend userslist $user
590        } else {
591          bMotion_putloglev 2 * "bMotion: rejecting $handle on gender" 
592        }
593      }
594    } else {
595      lappend userslist $user
596    }
597  }
598  bMotion_putloglev 1 * "bMotion: found [llength $userslist] users in $channel, $userslist"
599  set users $userslist
600  if {[llength $users] == 0} {
601    return ""
602  }
603
604  if {[llength $users] == 1} {
605    return [lindex $users 0]
606  }
607
608  set ruser $botnick
609  while {$ruser == $botnick} {
610    set ruser [lindex $users [rand [llength $users]]]
611  }
612  return $ruser
613}
614
615proc bMotionChooseRandomBot { channel { conditions "" }} {
616  bMotion_putloglev 1 * "bMotion: checking $channel"
617  global botnick bMotionInfo
618  set bots [chanlist $channel]
619  set botslist [list] 
620  foreach bot $bots {
621    if [isbotnick $bot] { continue }
622    set handle [nick2hand $bot $channel]
623    bMotion_putloglev 1 * "bMotion: checking $bot ($handle)"
624    if [matchattr [nick2hand $bot $channel] b&K $channel] {
625      if {$conditions != ""} {
626        if [string match -nocase [getuser $handle XTRA gender] $conditions] {
627          lappend botslist $bot
628        } else {
629          if {($conditions == "like") && [bMotionLike $bot [getchanhost $bot]]} {
630            lappend botslist $bot
631          } else {
632            bMotion_putloglev 1 * "bMotion: bot $handle's gender doesn't match"
633          }
634        }
635      } else {
636        lappend botslist $bot
637      }
638    }
639  }
640  set bots $botslist
641  bMotion_putloglev 1 * "bMotion: found [llength $bots] bots in $channel, $bots"
642  #one or fewer means we only found us (or noone)
643  if {[llength $bots] == 0} {
644    return ""
645  }
646
647  set rbot $botnick
648  while {$rbot == $botnick} {
649    set rbot [lindex $bots [rand [llength $bots]]]
650  }
651  return $rbot
652}
653
654proc bMotionMakePossessive { text { altMode 0 }} {
655  if {$text == "me"} {
656    if {$altMode == 1} {
657      return "mine"
658    }
659    return "my"
660  }
661
662  if {$text == "you"} {
663    if {$altMode == 1} {
664      return "yours"
665    }
666    return "your"
667  }
668
669  if [regexp -nocase "s$" $text] {
670    return "$text'"
671  }
672  return "$text's"
673}
674
675
676bMotion_putloglev d * "bMotion: events module loaded"
Note: See TracBrowser for help on using the repository browser.