plaintext
16,775 chars
· 547 lines
# Celebrity Dead Pool - Eggdrop script
#
# Load from eggdrop.conf with: source scripts/deadpool.tcl
#
# Commands (channel or private message to the bot):
# !dp help
# !dp add <celebrity> suggest a celebrity (needs admin approval)
# !dp list private list of the pool
# !dp set <celebrity> <YYYY-MM-DD> set/update YOUR guess (best done in PM)
# !dp <celebrity> show all guesses for a celebrity
# !dp top leaderboard
#
# Admin commands (bot owners [+n] are always admins):
# !dp pending
# !dp approve <celebrity>
# !dp reject <celebrity>
# !dp remove <celebrity>
# !dp died <celebrity> [YYYY-MM-DD] confirm death (date defaults to today)
# !dp adminadd <handle/nick>
# !dp adminrem <handle/nick>
#
# In a private message you can use either "!dp add ..." or "dp add ...".
package require Tcl 8.5
namespace eval ::deadpool {
# Data file (relative to the bot's working directory)
variable datafile [file join [pwd] scripts deadpool.dat]
# Lowercased handles/nicks that are admins (bot owners are always admins)
variable admins [list]
# pending: key -> dict {name <display> by <nick>}
variable pending [dict create]
# celebs: key -> dict {name <display> date <YYYY-MM-DD or ""> added <secs> died 0|1}
variable celebs [dict create]
# guesses: key -> dict {<nick lowercase> <YYYY-MM-DD>}
variable guesses [dict create]
variable top_count 10
bind pub - !dp ::deadpool::pub_cmd
bind msg - !dp ::deadpool::msg_cmd
bind msg - dp ::deadpool::msg_cmd
}
# ---------------------------------------------------------------------------
# Persistence
# ---------------------------------------------------------------------------
proc ::deadpool::save {} {
variable datafile
variable admins
variable pending
variable celebs
variable guesses
file mkdir [file dirname $datafile]
set tmp "${datafile}.tmp"
set f [open $tmp w]
puts $f [list admins $admins pending $pending celebs $celebs guesses $guesses]
close $f
file rename -force $tmp $datafile
}
proc ::deadpool::load_data {} {
variable datafile
variable admins
variable pending
variable celebs
variable guesses
if {![file exists $datafile]} { return }
if {[catch {
set f [open $datafile r]
set data [read $f]
close $f
if {[dict exists $data admins]} { set admins [dict get $data admins] }
if {[dict exists $data pending]} { set pending [dict get $data pending] }
if {[dict exists $data celebs]} { set celebs [dict get $data celebs] }
if {[dict exists $data guesses]} { set guesses [dict get $data guesses] }
} err]} {
putlog "Dead Pool: failed to load $datafile: $err"
}
}
# ---------------------------------------------------------------------------
# Helpers
# ---------------------------------------------------------------------------
# Send text (possibly multiple lines) to a nick or channel
proc ::deadpool::say {target text} {
foreach line [split $text "\n"] {
set line [string trimright $line]
if {$line ne ""} {
puthelp "PRIVMSG $target :$line"
}
}
}
# Reply privately to the user
proc ::deadpool::priv {nick text} {
say $nick $text
}
# Reply where the command came from (channel, or PM if chan is empty)
proc ::deadpool::reply {nick chan text} {
if {$chan eq ""} {
say $nick $text
} else {
say $chan $text
}
}
# Normalise a celebrity name into a lookup key
proc ::deadpool::keyof {name} {
return [string tolower [regsub -all {\s+} [string trim $name] " "]]
}
proc ::deadpool::clean {name} {
return [regsub -all {\s+} [string trim $name] " "]
}
proc ::deadpool::is_admin {nick hand} {
variable admins
if {[lsearch -exact $admins [string tolower $nick]] >= 0} { return 1 }
if {$hand ne "" && $hand ne "*"} {
if {[lsearch -exact $admins [string tolower $hand]] >= 0} { return 1 }
if {[matchattr $hand n]} { return 1 }
}
return 0
}
# Strict YYYY-MM-DD check (rejects things like 2025-13-45 or 2025-02-30)
proc ::deadpool::valid_date {date} {
if {![regexp {^\d{4}-\d{2}-\d{2}$} $date]} { return 0 }
if {[catch {clock scan $date -format %Y-%m-%d -timezone UTC} secs]} { return 0 }
return [expr {[clock format $secs -format %Y-%m-%d -timezone UTC] eq $date}]
}
# 1 point for year, +3 for month, +11 for day (15 max)
proc ::deadpool::calc_score {guess actual} {
if {$guess eq "" || $actual eq ""} { return 0 }
set g [split $guess "-"]
set a [split $actual "-"]
set pts 0
if {[lindex $g 0] eq [lindex $a 0]} {
incr pts 1
if {[lindex $g 1] eq [lindex $a 1]} {
incr pts 3
if {[lindex $g 2] eq [lindex $a 2]} {
incr pts 11
}
}
}
return $pts
}
# Sorted list of {user points}, aggregated across all confirmed deaths
proc ::deadpool::leaderboard {} {
variable celebs
variable guesses
set totals [dict create]
dict for {key c} $celebs {
if {![dict get $c died]} { continue }
if {![dict exists $guesses $key]} { continue }
set actual [dict get $c date]
dict for {user g} [dict get $guesses $key] {
set pts [calc_score $g $actual]
if {$pts > 0} { dict incr totals $user $pts }
}
}
set rows [list]
dict for {user pts} $totals { lappend rows [list $user $pts] }
return [lsort -integer -decreasing -index 1 $rows]
}
# ---------------------------------------------------------------------------
# Command entry points
# ---------------------------------------------------------------------------
proc ::deadpool::pub_cmd {nick uhost hand chan text} {
dispatch $nick $hand $chan $text
return 1
}
proc ::deadpool::msg_cmd {nick uhost hand text} {
dispatch $nick $hand "" $text
return 1
}
proc ::deadpool::dispatch {nick hand chan text} {
set args [regexp -all -inline {\S+} $text]
if {[llength $args] < 1} {
reply $nick $chan "Usage: !dp <command> \[arguments\] | !dp help for all commands"
return
}
set cmd [string tolower [lindex $args 0]]
set rest [lrange $args 1 end]
set name [join $rest " "]
switch -exact -- $cmd {
help { cmd_help $nick }
list { cmd_list $nick }
top { cmd_top $nick $chan }
add { cmd_add $nick $chan $name }
set { cmd_set $nick $chan $rest }
pending -
approve -
reject -
remove -
died -
adminadd -
adminrem {
if {![is_admin $nick $hand]} {
reply $nick $chan "Only admins can use !dp $cmd."
return
}
cmd_$cmd $nick $chan $rest
}
default { cmd_lookup $nick $chan [join $args " "] }
}
}
# ---------------------------------------------------------------------------
# User commands
# ---------------------------------------------------------------------------
proc ::deadpool::cmd_help {nick} {
priv $nick {=== Celebrity Dead Pool ===
!dp help - this help
!dp add <name> - suggest a celebrity (admin must approve)
!dp list - private list of all celebrities
!dp set <name> <YYYY-MM-DD> - set/update YOUR guess for a celebrity
!dp <name> - see all guesses for a celebrity
!dp top - leaderboard
Admins only:
!dp pending - list suggestions awaiting approval
!dp approve <name> / !dp reject <name> / !dp remove <name>
!dp died <name> [YYYY-MM-DD] - confirm a death (date defaults to today)
!dp adminadd <nick> / !dp adminrem <nick>
Scoring: correct year = 1 pt, +3 for month (4 total), +11 for day (15 total).
Tip: send your guesses in a private message to the bot.}
}
proc ::deadpool::cmd_add {nick chan name} {
variable pending
variable celebs
if {$name eq ""} {
reply $nick $chan "Usage: !dp add <celebrity name>"
return
}
set key [keyof $name]
set name [clean $name]
if {[dict exists $celebs $key]} {
reply $nick $chan "$name is already in the pool."
return
}
if {[dict exists $pending $key]} {
reply $nick $chan "$name is already pending approval."
return
}
dict set pending $key [dict create name $name by $nick]
save
reply $nick $chan "$nick suggested: $name - awaiting admin approval."
}
proc ::deadpool::cmd_list {nick} {
variable celebs
if {[dict size $celebs] == 0} {
priv $nick "No celebrities in the pool yet."
return
}
set text "=== Celebrity Dead Pool ===\n"
foreach key [lsort [dict keys $celebs]] {
set c [dict get $celebs $key]
set date [dict get $c date]
if {$date eq ""} { set date "alive/TBD" }
if {[dict get $c died]} {
append text "- [dict get $c name]: died $date\n"
} else {
append text "- [dict get $c name]\n"
}
}
append text "Total: [dict size $celebs] celebrities"
priv $nick $text
}
proc ::deadpool::cmd_set {nick chan rest} {
variable celebs
variable guesses
if {[llength $rest] < 2} {
priv $nick "Usage: !dp set <celebrity name> <YYYY-MM-DD>"
return
}
set date [lindex $rest end]
set name [join [lrange $rest 0 end-1] " "]
set key [keyof $name]
if {![dict exists $celebs $key]} {
priv $nick "$name is not in the pool. Suggest them with !dp add."
return
}
if {![valid_date $date]} {
priv $nick "Invalid date. Use YYYY-MM-DD (e.g. 2027-01-15)."
return
}
set c [dict get $celebs $key]
if {[dict get $c died]} {
priv $nick "[dict get $c name] has already died ([dict get $c date]); guesses are closed."
return
}
dict set guesses $key [string tolower $nick] $date
save
priv $nick "Guess saved for [dict get $c name]: $date"
}
proc ::deadpool::cmd_lookup {nick chan name} {
variable celebs
variable guesses
set key [keyof $name]
if {![dict exists $celebs $key]} {
reply $nick $chan "$name is not in the pool."
return
}
set c [dict get $celebs $key]
set died [dict get $c died]
set actual [dict get $c date]
set text "=== [dict get $c name] ===\n"
if {$died} {
append text "Died: $actual\n"
} else {
append text "Status: still going (no date confirmed)\n"
}
if {![dict exists $guesses $key] || [dict size [dict get $guesses $key]] == 0} {
append text "No guesses yet. Be the first!"
reply $nick $chan $text
return
}
set g [dict get $guesses $key]
foreach user [lsort [dict keys $g]] {
set guess [dict get $g $user]
if {$died} {
append text "- $user: $guess ([calc_score $guess $actual] pts)\n"
} else {
append text "- $user: $guess\n"
}
}
reply $nick $chan $text
}
proc ::deadpool::cmd_top {nick chan} {
variable top_count
set rows [leaderboard]
if {[llength $rows] == 0} {
reply $nick $chan "No scores yet. Scores appear once a death is confirmed."
return
}
set text "=== Top Scores ===\n"
set i 0
foreach row $rows {
incr i
if {$i > $top_count} { break }
append text "$i. [lindex $row 0] - [lindex $row 1] points\n"
}
reply $nick $chan $text
}
# ---------------------------------------------------------------------------
# Admin commands (all take: nick chan rest)
# ---------------------------------------------------------------------------
proc ::deadpool::cmd_pending {nick chan rest} {
variable pending
if {[dict size $pending] == 0} {
priv $nick "Nothing pending."
return
}
set text "=== Pending suggestions ===\n"
dict for {key p} $pending {
append text "- [dict get $p name] (suggested by [dict get $p by])\n"
}
priv $nick $text
}
proc ::deadpool::cmd_approve {nick chan rest} {
variable pending
variable celebs
set name [join $rest " "]
if {$name eq ""} { priv $nick "Usage: !dp approve <celebrity name>"; return }
set key [keyof $name]
if {![dict exists $pending $key]} {
priv $nick "$name is not pending."
return
}
set p [dict get $pending $key]
dict unset pending $key
dict set celebs $key [dict create name [dict get $p name] date "" added [clock seconds] died 0]
save
reply $nick $chan "Approved: [dict get $p name] added to the pool (suggested by [dict get $p by])."
}
proc ::deadpool::cmd_reject {nick chan rest} {
variable pending
set name [join $rest " "]
if {$name eq ""} { priv $nick "Usage: !dp reject <celebrity name>"; return }
set key [keyof $name]
if {![dict exists $pending $key]} {
priv $nick "$name is not pending."
return
}
set pname [dict get $pending $key name]
dict unset pending $key
save
reply $nick $chan "Rejected: $pname removed from the pending list."
}
proc ::deadpool::cmd_remove {nick chan rest} {
variable celebs
variable guesses
set name [join $rest " "]
if {$name eq ""} { priv $nick "Usage: !dp remove <celebrity name>"; return }
set key [keyof $name]
if {![dict exists $celebs $key]} {
priv $nick "$name is not in the pool."
return
}
set cname [dict get $celebs $key name]
dict unset celebs $key
if {[dict exists $guesses $key]} { dict unset guesses $key }
save
reply $nick $chan "$cname removed from the pool."
}
proc ::deadpool::cmd_died {nick chan rest} {
variable celebs
if {[llength $rest] < 1} {
priv $nick "Usage: !dp died <celebrity name> \[YYYY-MM-DD\]"
return
}
set date [clock format [clock seconds] -format %Y-%m-%d]
set last [lindex $rest end]
if {[regexp {^\d{4}-\d{2}-\d{2}$} $last]} {
if {![valid_date $last]} {
priv $nick "Invalid date. Use YYYY-MM-DD."
return
}
if {[llength $rest] < 2} {
priv $nick "Usage: !dp died <celebrity name> \[YYYY-MM-DD\]"
return
}
set date $last
set rest [lrange $rest 0 end-1]
}
set name [join $rest " "]
set key [keyof $name]
if {![dict exists $celebs $key]} {
priv $nick "$name is not in the pool."
return
}
set c [dict get $celebs $key]
if {[dict get $c died]} {
priv $nick "[dict get $c name] is already confirmed dead ([dict get $c date])."
return
}
dict set celebs $key died 1
dict set celebs $key date $date
save
reply $nick $chan "[dict get $c name] has been confirmed dead. Date: $date. Check !dp top for scores."
}
proc ::deadpool::cmd_adminadd {nick chan rest} {
variable admins
if {[llength $rest] < 1} { priv $nick "Usage: !dp adminadd <handle/nick>"; return }
set who [string tolower [lindex $rest 0]]
if {[lsearch -exact $admins $who] >= 0} {
priv $nick "$who is already a Dead Pool admin."
return
}
lappend admins $who
save
priv $nick "$who is now a Dead Pool admin."
}
proc ::deadpool::cmd_adminrem {nick chan rest} {
variable admins
if {[llength $rest] < 1} { priv $nick "Usage: !dp adminrem <handle/nick>"; return }
set who [string tolower [lindex $rest 0]]
set idx [lsearch -exact $admins $who]
if {$idx < 0} {
priv $nick "$who is not in the admin list (bot owners are always admins)."
return
}
set admins [lreplace $admins $idx $idx]
save
priv $nick "$who is no longer a Dead Pool admin."
}
# ---------------------------------------------------------------------------
# Startup
# ---------------------------------------------------------------------------
proc ::deadpool::start {} {
variable celebs
variable guesses
load_data
putlog "Dead Pool loaded: [dict size $celebs] celebrities, [dict size $guesses] guessed"
}
::deadpool::start