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

Revision 2, 17.6 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 - System function
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
25# this function cleans the CVS string to get the version out of it
26proc bMotionCleanCVSString { cvs } {
27  if [regexp {\$[I][d].+?,(.+) Exp \$} $cvs matches core] {
28    return $core
29  }
30  return $cvs
31}
32set cvsinfo [bMotionCleanCVSString {$Id$}]
33set randomsinfo [bMotionCleanCVSString $randomsVersion]
34
35#Set up the binds
36bind msg m bmotion msg_bmotioncommand
37bind join - *!*@* bMotion_event_onjoin
38bind mode - * bMotion_event_mode
39#bind pub - "!sites" interactive:lamersites
40bind pub - !bmadmin bMotionAdminHandler
41bind pubm - * bMotion_event_main
42bind dcc m mood moodhandler
43bind dcc m bmotion* dcc_bmotioncommand
44bind dcc m bmadmin* bMotion_dcc_command
45bind dcc m bmhelp bMotion_dcc_help
46bind sign - *!*@* bMotion_event_onquit
47bind nick - * bMotion_event_nick
48
49if {$bMotionSettings(needI) == 1} {
50  ## binds for +I mode
51  bind part I *!*@* bMotion_event_onpart
52  bind pub I "!mood" pubm_moodhandler
53  bind ctcp I ACTION bMotion_event_action
54  bind pub I "!bminfo" bMotionInfo
55} else {
56  ## everyone can do stuff
57  bind part - *!*@* bMotion_event_onpart
58  bind pub - "!mood" pubm_moodhandler
59  bind ctcp - ACTION bMotion_event_action
60  bind pub - "!bminfo" bMotionInfo
61}
62
63foreach chan $bMotionInfo(randomChannels) {
64  set bMotionLastEvent($chan) [clock seconds]
65  set bMotionInfo(adminSilence,$chan) 0
66  #set to 1 when the bot says something, and 0 when someone else says something
67  #used to make the bot a bit more intelligent (perhaps) at conversations
68  set bMotionCache($chan,last) 0
69  #channel mood tracker
70  set bMotionCache($chan,mood) 0
71}
72
73
74proc bMotionInfo {nick host handle channel text} {
75  global bMotionInfo botnicks bMotionSettings cvsinfo randomsinfo
76  set timezone [clock format [clock seconds] -format "%Z"] 
77  set status "I am running bMotion under TCL [info patchlevel]: botGender $bMotionInfo(gender)/$bMotionInfo(orientation) : balefire $bMotionInfo(balefire) : pokemon $bMotionInfo(pokemon) : timezone $timezone : randomStuff $bMotionInfo(minRandomDelay), $bMotionInfo(maxRandomDelay), $bMotionInfo(maxIdleGap) : botnicks $botnicks : melMode $bMotionSettings(melMode) : needI $bMotionSettings(needI) : cvs $cvsinfo : randoms $randomsinfo"
78  if {$bMotionInfo(silence)} { set status "$status : silent (yes)" }
79  putchan $channel $status
80}
81
82proc doRandomStuff {} {
83  global bMotionInfo mood stonedRandomStuff bMotionInfo
84  global bMotionLastEvent
85  set timeNow [clock seconds]
86  set saidChannels ""
87  set silentChannels ""
88
89  #do this first now
90  set upperLimit [expr $bMotionInfo(maxRandomDelay) - $bMotionInfo(minRandomDelay)]
91  set temp [expr [rand $upperLimit] + $bMotionInfo(minRandomDelay)]
92  timer $temp doRandomStuff
93  bMotion_putloglev d * "bMotion: randomStuff next ($temp minutes)";
94
95
96  #not away
97
98  #find the most recent event
99  set mostRecent 0
100  set line "comparing idle times: "
101  foreach channel $bMotionInfo(randomChannels) {
102    append line "$channel=$bMotionLastEvent($channel) "
103    if {$bMotionLastEvent($channel) > $mostRecent} {
104      set mostRecent $bMotionLastEvent($channel)
105    }
106  }
107  bMotion_putloglev 1 * "bMotion: most recent: $mostRecent .. timenow $timeNow .. gap [expr $bMotionInfo(maxIdleGap) * 10]"
108 
109  set idleEnough 0
110
111  if {($timeNow - $mostRecent) > ([expr $bMotionInfo(maxIdleGap) * 10])} {
112    set idleEnough 1
113  }
114
115  if {$idleEnough} {
116    if {$bMotionInfo(away) == 1} {
117      #away, don't do anything
118      return 0
119    }
120
121    #channel is quite idle
122    putlog "bMotion: All channels are idle, going away"
123    if {[rand 4] == 0} {
124      bMotionSetRandomAway
125      return 0
126    }
127  }
128
129  #not idle
130 
131  #set back if away
132  if {$bMotionInfo(away) == 1} {
133    bMotionSetRandomBack
134  }
135
136  #we didn't set ourselves away, let's do something random
137  foreach channel $bMotionInfo(randomChannels) {
138    if {($timeNow - $bMotionLastEvent($channel)) < ($bMotionInfo(maxIdleGap) * 60)} {
139      set saidChannels "$saidChannels $channel"
140      bMotionSaySomethingRandom $channel
141    } else {
142      set silentChannels "$silentChannels $channel"
143    }
144  }
145  bMotion_putloglev d * "bMotion: randomStuff said ($saidChannels) silent ($silentChannels)"
146}
147
148proc bMotionSaySomethingRandom {channel} {
149  global randomStuff stonedRandomStuff randomStuffMale randomStuffFemale mood bMotionInfo
150 
151  set myRandomStuff $randomStuff
152
153  if {$mood(stoned) > 9} {
154    set myRandomStuff [concat $myRandomStuff $stonedRandomStuff]
155  }
156  if {$bMotionInfo(gender) == "male"} {
157    set myRandomStuff [concat $myRandomStuff $randomStuffMale]
158  } else {
159    set myRandomStuff [concat $myRandomStuff $randomStuffFemale]
160  }
161
162  if [rand 2] {
163    bMotionDoAction $channel "" [pickRandom $myRandomStuff]
164  }
165
166  return 0
167}
168
169proc bMotionSetRandomAway {} {
170  #set myself away with a random message
171  global randomAways bMotionInfo
172
173  set awayReason [pickRandom $randomAways]
174  foreach channel $bMotionInfo(randomChannels) {
175    bMotionDoAction $channel $awayReason "/is away: %%"
176  }
177  putserv "AWAY :$awayReason"
178  set bMotionInfo(away) 1
179  set bMotionInfo(silence) 1
180  bMotion_putloglev d * "bMotion: Set myself away: $awayReason"
181  bMotion_putloglev d * "bMotion: Going silent"
182}
183
184proc bMotionSetRandomBack {} {
185  #set myself back
186  global bMotionInfo
187
188  set bMotionInfo(away) 0
189  set bMotionInfo(silence) 0
190  foreach channel $bMotionInfo(randomChannels) {
191    bMotionDoAction $channel "" "/is back"
192  }
193  putserv "AWAY"
194
195  #elect cos we're available now
196  bMotion_interbot_next_elect
197
198  return 0
199}
200
201## bMotionTalkingToMe ########################################################
202proc bMotionTalkingToMe { text } {
203  global botnicks
204  if [regexp -nocase "(^${botnicks}:?|${botnicks}\\?$)" $text] {
205    return 1
206  }
207  return 0
208}
209
210proc bMotionSilence {nick host channel} {
211  # We've been told to shut up :(
212  # Let's be silent for 5 minutes
213  global bMotionInfo silenceAways
214  if {$bMotionInfo(silence) == 1} {
215    #I already am :P
216    putserv "NOTICE $nick :I already am silent :P"
217    return 0
218  }
219  timer 5 bMotionUnSilence
220  putlog "bMotion: Was told to be silent for 5 minutes by $nick in $channel"
221  set awayStuff [pickRandom $silenceAways]
222  bMotionDoAction $channel $nick $awayStuff
223  putserv "AWAY :bbi5 ($nick $channel)"
224  set bMotionInfo(silence) 1
225  set bMotionInfo(away) 1
226}
227
228proc bMotionUnSilence {} {
229  # Timer for silence expires
230  putserv "AWAY"
231  putlog "bMotion: No longer silent."
232  global bMotionInfo
233  set bMotionInfo(silence) 0
234  set bMotionInfo(away) 0
235}
236
237proc bMotionLike {nick { host "" }} {
238  global bMotionInfo mood bMotionSettings
239  if {$host == ""} {
240    set host [getchanhost $nick]
241  }
242
243  set host "$nick!$host"
244
245  if {$bMotionSettings(melMode) == 1} {
246    return 1
247  }
248
249  set handle [finduser $host]
250  if {$handle == "*"} {
251    # couldn't find a match
252    #if i'm stoned enough, i'll sleep with anyone
253    if {$mood(stoned) > 20} {
254      return 1
255    }
256
257    #if i'm horny enough, i'll sleep with anyone
258    if {$mood(horny) > 10} {
259      return 1
260    }
261    #else they can get lost
262    return 0
263  }
264
265  #don't like people who aren't my friends
266  if {![bMotionIsFriend $nick]} { return 0 }
267
268  # we're friends, now get their gender
269  set gender [getuser $handle XTRA gender]
270  if {$gender == ""} {
271    # they don't have a gender. let's assume we'd have sex with them too
272    return 1
273  }
274  if {$gender == $bMotionInfo(gender)} {
275    #they're my gender
276    if {($bMotionInfo(orientation) == "bi") || ($bMotionInfo(orientation) == "gay") || ($bMotionInfo(orientation) == "lesbian")} {
277      return 1
278    }
279    return 0
280  }
281  #they're not my gender. what now?
282  if {($bMotionInfo(orientation) == "bi") || ($bMotionInfo(orientation) == "straight")} {
283    return 1
284  }
285  # that only leaves lesbian and gay who won't sleep with the opposite gender
286  return 0
287}
288
289proc bMotionGetGender { nick host } {
290  set host "$nick!$host"
291  set handle [finduser $host]
292  if {$handle == "*"} {
293    return "unknown"
294  }
295  # found a user, now get their gender
296  return [getuser $handle XTRA gender]
297}
298
299proc pastWatershedCheck { nick } {
300  return 1
301  set hour [getHour]
302  global bMotionInfo
303  if {($hour < $bMotionInfo(upperWatershed)) && ($hour > $bMotionInfo(lowerWatershed))} {
304    global bMotionInfo
305    putserv "NOTICE $nick :I'd love to, but it's before the watershed so I'm not allowed to do that. Try asking me again after $bMotionInfo(upperWatershed):00"
306    return 0
307  }
308  return 1
309}
310
311proc loldec {} {
312  global bMotionCache
313  if {$bMotionCache(LOLcount) > 0} {
314    incr bMotionCache(LOLcount) -1
315  }
316  utimer 5 loldec
317}
318
319proc getHour {} {
320  return [clock format [clock seconds] -format "%H"]
321}
322
323proc bMotion_dcc_command { handle idx arg } {
324  global bMotionInfo
325  bMotion_putloglev 2 * "bMotion: admin command $arg from $handle"
326  set info [bMotion_plugin_find_admin $arg $bMotionInfo(language)]
327  if {$info == ""} {
328    putidx $idx "What? You need .bmhelp!"
329    return 1
330  }
331
332  set blah [split $info "Š"]
333  set flags [lindex $blah 0]
334  set callback [lindex $blah 1]
335
336  if {![matchattr $handle $flags]} {
337    putidx $idx "What? You need more flags :)"
338    return 1
339  }
340
341  bMotion_putloglev d * "bMotion: admin callback matched, calling $callback"
342
343  #strip the first command
344  regexp {[^ ]+( .+)?} $arg {\1} arg
345
346  #run the callback :)
347  set arg [join $arg]
348  set arg [string trim $arg]
349  catch {
350    if {$arg == ""} {
351      $callback $handle $idx
352    } else {
353      $callback $handle $idx $arg
354    }
355  } err
356  if {($err != "") && ($err != 0)} {
357    putlog "bMotion: ALERT! Callback failed for .bmadmin: $callback ($handle $idx $arg)"
358    putidx $idx "Sorry :( Running your callback failed ($err)\r"
359  }
360}
361
362proc bMotion_dcc_help { handle idx arg } {
363  putidx $idx "Commands available: (Some may not be accessible by you)\r"
364
365  set cmds ""
366 
367  global bMotion_plugins_admin
368  set s [array startsearch bMotion_plugins_admin]
369  while {[set key [array nextelement bMotion_plugins_admin $s]] != ""} {
370    if {$key == "dummy"} { continue }
371    append cmds "$key     "
372  }
373
374  putidx $idx "$cmds\r"
375  array donesearch bMotion_plugins_admin $s
376}
377
378proc dcc_bmotioncommand { handle idx arg } {
379  if [regexp -nocase "redo botnicks" $arg] {
380    putidx $idx "!bMotion! now redoing botnicks..."
381    global botnicks botnick bMotionSettings
382    set botnicks "($botnick|$bMotionSettings(botnicks)) ?"
383    putidx $idx "!bMotion! botnicks are now: $botnicks"
384    return 1
385  }
386
387  if [regexp -nocase "reload" $arg] {
388    putidx $idx "!bMotion! reloading randoms file"
389    source scripts/bMotionSettings.tcl
390    return 1
391  }
392
393  if [regexp -nocase "unsilence" $arg] {
394    global bMotionInfo
395    putserv "AWAY"
396    putidx $idx "No longer silent."
397    set bMotionInfo(silence) 0
398    set bMotionInfo(away) 0   
399    return 1
400  }
401
402  if [regexp -nocase "unbind votes" $arg] {
403      putidx $idx "Unbinding vote commands...\n"
404      unbind pub - "!innocent" bMotionVoteHandler
405      unbind pub - "!guilty" bMotionVoteHandler
406      unbind pubm - "!innocent" bMotionVoteHandler
407      unbind pubm - "!guilty" bMotionVoteHandler
408      putidx $idx "ok\n"
409      return 1
410  }
411 
412  return 1
413}
414
415proc bMotionAdminHandler {nick host handle channel text} {
416  global bMotionAdminFlag botnicks bMotionInfo botnick bMotionSettings
417
418  if {![matchattr $handle $bMotionAdminFlag $channel]} {
419    return 0
420  }
421
422  #first, check botnicks (this is to get round empty-nick-on-startup
423  if {$botnicks == ""} {
424    # need to set this
425    set botnicks "($botnick|$bMotionSettings(botnicks)) ?"
426  }
427
428  if [regexp -nocase "$botnicks (shut up|silence|quiet)" $text] {
429    set bMotionInfo(adminSilence,$channel) 1
430    puthelp "NOTICE $nick :OK, silent in $channel until told otherwise"
431    return 1
432  }
433
434  if [regexp -nocase "$botnicks (end|cancel|stop) (shut up|silence|quiet)" $text] {
435    set bMotionInfo(adminSilence,$channel) 0
436    puthelp "NOTICE $nick :No longer silent in $channel"
437    return 1
438  }
439
440  if [regexp -nocase "$botnicks washnick (.+)" $text matches bn nick2] {
441    bMotionDoAction $channel $nick "%%: %2" [bMotionWashNick $nick2]
442    return 1
443  }
444
445  if [regexp -nocase "$botnicks global (shut up|silence|quiet)" $text] {
446    set bMotionInfo(silence) 1
447    set bMotionInfo(away) 1
448    puthelp "NOTICE $nick :Now globally silent"
449    putserv "AWAY :Global silence requested by $nick"
450    return 1
451  }
452
453  if [regexp -nocase "$botnicks (end|cancel|stop) global (shut up|silence|quiet)" $text] {
454    set bMotionInfo(silence) 0
455    set bMotionInfo(away) 0
456    puthelp "NOTICE $nick :No longer globally silent"
457    putserv "AWAY";
458    return 1
459  }
460
461  if [regexp -nocase "$botnicks leet (on|off)" $text blah pop toggle] {
462
463    if {$toggle == "off"} {
464      putlog "bMotion: Leet mode off by $nick"     
465      set bMotionInfo(leet) 0
466      bMotionDoAction $channel $nick "/stops talking like a retard."
467      return 0
468    }
469
470    if {$toggle == "on"} {
471      putlog "bMotion: Leet mode on by $nick"
472      set bMotionInfo(leet) 1
473      bMotionDoAction $channel $nick "Leet mode on ... fear my skills!"
474    }
475    return 1
476  }
477
478  if [regexp -nocase "$botnicks dutch (on|off)" $text blah pop toggle] {
479
480    if {$toggle == "off"} {
481      putlog "bMotion: Dutch mode off by $nick"     
482      set bMotionInfo(dutch) 0
483      bMotionDoAction $channel $nick "/stops talking like a European."
484      return 0
485    }
486
487    if {$toggle == "on"} {
488      putlog "bMotion: Dutch mode on by $nick"     
489      bMotionDoAction $channel $nick "/snapt wel nederlands"
490      set bMotionInfo(dutch) 1
491    }
492    return 1
493  }
494
495
496  if [regexp -nocase "$botnicks leetchance (.+)" $text blah pop value] {
497    set bMotionInfo(leetChance) $value
498    puthelp "NOTICE $nick :Ok"
499    return 1
500  }
501
502  if [regexp -nocase "$botnicks reload" $text blah pop value] {
503    puthelp "NOTICE $nick :Reloading random stuff lists"
504    source scripts/bMotionRandoms.tcl
505    putlog "bMotion: Reloaded bMotion randoms ($nick)"
506    return 1
507  }
508
509  if [regexp -nocase "$botnicks parse (.+)" $text matches bot txt] {
510    bMotionDoAction $channel $nick $txt
511    putlog "bMotion: Parsed text for $nick"
512    return 1
513  }
514
515  if [regexp -nocase "$botnicks su (.+?) (.+)" $text matches bot nick2 txt] {
516    bMotion_event_main $nick2 [getchanhost $nick2 $channel] [nick2hand $nick2] $channel $txt
517    putlog "bMotion: su to $nick2 by $nick on $channel: $txt"
518    return 1
519  }
520}
521
522
523proc msg_bmotioncommand { nick host handle arg } {
524  return 0
525}
526
527proc smileyhandler {} {
528  global bMotionInfo bMotionCache
529  foreach channel $bMotionInfo(randomChannels) {
530    set chanMood $bMotionCache($channel,mood)
531    if [rand 2] {
532      if {$chanMood != 0} {
533        #don't talk to ourselves
534        if {$bMotionCache($channel,last) == 0} {
535          bMotionDoAction $channel "" [makeSmiley $chanMood]
536        }
537      }
538    }
539  #end foreach
540  }
541}
542
543
544# Time stuff
545 set pronounce {vigintillion novemdecillion octodecillion \
546        septendecillion sexdecillion quindecillion quattuordecillion \
547        tredecillion duodecillion undecillion decillion nonillion \
548        octillion septillion sextillion quintillion quadrillion \
549        trillion billion million thousand ""}
550
551 proc get_num num {
552    foreach {a b} {0 {} 1 one 2 two 3 three 4 four 5 five 6 six 7 seven \
553            8 eight 9 nine 10 ten 11 eleven 12 twelve 13 thirteen 14 \
554            fourteen 15 fifteen 16 sixteen 17 seventeen 18 eighteen 19 \
555            nineteen 20 twenty 30 thirty 40 forty 50 fifty 60 sixty 70 \
556            seventy 80 eighty 90 ninety} {if {$num == $a} {return $b}}
557    return $num
558 }
559
560
561 proc revorder list {
562    for {set x 0;set y [expr {[llength $list] - 1}]} {$x < $y} \
563            {incr x;incr y -1} {
564        set t [lindex $list $x]
565        set list [lreplace $list $x $x [lindex $list $y]]
566        set list [lreplace $list $y $y $t]
567    }
568    return $list
569 }
570
571 proc pron_form num {
572    global pronounce
573    set x [join [split $num ,] {}]
574    set x [revorder [split $x {}]]
575    set pron ""
576    set ct [expr {[llength $pronounce] - 1}]
577    foreach {a b c} $x {
578        set p [pron_num $c$b$a]
579        if {$p != ""} {
580            lappend pron "$p [lindex $pronounce $ct]"
581        }
582        incr ct -1
583    }
584    return [join [revorder $pron] ", "]
585 }
586
587proc bMotion_get_number { num } {
588  set hundred ""
589  set ten ""
590  set len [string length $num]
591  if {$len == 3} {
592    set hundred "[get_num [string index $num 0]] hundred"
593    set num [string range $num 1 end]
594  }
595  if {$num > 20 && $num != $num/10} {
596    set tens [get_num [string index $num 0]0]
597    set ones [get_num [string index $num 1]]
598    set ten [join [concat $tens $ones] -]
599  } else {
600    set ten [get_num $num]
601  }
602  if {[string length $hundred] && [string length $ten]} {
603    return [concat $hundred and $ten]
604  } else {
605    # One of these is empty, but don't bother to work out which!
606    return [concat $hundred $ten]
607  }
608}
609
610proc bMotion_startTimers { } { 
611  global mooddrifttimer
612        if  {![info exists mooddrifttimer]} {
613                timer 10 driftmood
614    utimer 5 loldec
615    timer [expr [rand 30] + 3] doRandomStuff
616                set mooddrifttimer 1
617    set delay [expr [rand 200] + 1700]
618    utimer $delay bMotion_interbot_next_elect
619        }
620}
621
622
623bMotion_putloglev d * "bMotion: system module loaded"
Note: See TracBrowser for help on using the repository browser.