blob: 44a1448eb283a70f8ed7423eaa0ab96dd19385f3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
#!/usr/bin/env tclsh
#
# ZyklonB coin plugin, random number-based utilities
#
# Copyright 2012, 2014 Přemysl Janouch. All rights reserved.
# See the file LICENSE for licensing information.
#
# This is a terrible excuse for a programming language and I feel dirty.
proc parse {line} {
global msg
unset -nocomplain msg
if [regexp {^:([^ ]*) *(.*)} $line -> prefix rest] {
set msg(prefix) $prefix
set line $rest
}
if [regexp {^([^ ]*) *(.*)} $line -> command rest] {
set msg(command) $command
set line $rest
}
while {1} {
set line [string trimleft $line " "]
set i [string first " " $line]
if {$i == -1} { set i [string bytelength $line] }
if {$i == 0} { break }
if {[string index $line 0] == ":"} {
lappend msg(param) [string range $line 1 [string bytelength $line]]
break
}
lappend msg(param) [string range $line 0 [expr $i - 1]]
set line [string range $line $i [string bytelength $line]]
}
}
proc get_config {key} {
global msg
puts "ZYKLONB get_config :$key"
gets stdin line
parse $line
return [lindex $msg(param) 0]
}
proc pmrespond {text} {
global ctx
global ctx_quote
puts "PRIVMSG $ctx :$ctx_quote$text"
}
fconfigure stdin -translation crlf
fconfigure stdout -translation crlf
set prefix [get_config prefix]
puts "ZYKLONB register"
set eightball [list \
"It is certain" \
"It is decidedly so" \
"Without a doubt" \
"Yes – definitely" \
"You may rely on it" \
"As I see it, yes" \
"Most likely" \
"Outlook good" \
"Yes" \
"Signs point to yes" \
"Reply hazy, try again" \
"Ask again later" \
"Better not tell you now" \
"Cannot predict now" \
"Concentrate and ask again" \
"Don't count on it" \
"My reply is no" \
"My sources say no" \
"Outlook not so good" \
"Very doubtful"]
while {[gets stdin line] != -1} {
parse $line
if {! [info exists msg(prefix)] || ! [info exists msg(command)]
|| $msg(command) != "PRIVMSG" || ! [info exists msg(param)]
|| [llength $msg(param)] < 2} { continue }
regexp {^[^!]*} $msg(prefix) ctx
if [regexp {^[#&+!]} [lindex $msg(param) 0]] {
set ctx_quote "$ctx: "
set ctx [lindex $msg(param) 0]
} else { set ctx_quote "" }
set input [lindex $msg(param) 1]
set first_chars [string range $input 0 \
[expr [string bytelength $prefix] - 1]]
if {$first_chars != $prefix} { continue }
set input [string range $input \
[string bytelength $prefix] [string bytelength $input]]
if {$input == "coin"} {
if {rand() < 0.5} { pmrespond "Heads." } else { pmrespond "Tails." }
} elseif {[regexp {^dice( +|$)(.*)} $input -> _ args]} {
if {! [string is integer -strict $args] || $args <= 0} {
pmrespond "Invalid or missing number."
} else {
pmrespond [expr {int($args * rand()) + 1}]
}
} elseif {[regexp {^(choose|\?)( +|$)(.*)} $input -> _ _ args]} {
if {$args == ""} {
pmrespond "Nothing to choose from."
} else {
set c [split $args ",|"]
pmrespond [lindex $c [expr {int([llength $c] * rand())}]]
}
} elseif {[regexp {^eightball( +|$)(.*)} $input -> _ args]} {
if {$args == ""} {
pmrespond "You should, you know, ask something."
} else {
pmrespond [lindex $eightball \
[expr {int([llength $eightball] * rand())}]].
}
}
}
|
