# ascii-art.tcl
# display ASCII/ANSI art from text files via Eggdrop's
# flood-protected queue, with a stop that actually clears the queue.
#
# Channel usage:
# !art <name> !art fr-terminator/!art ans/lgcy-002/fr-terminator
# extension optional: fr-terminator.ans also works
# !art list list available art, grouped by folder
# !art stop abort whatever is sending to this channel
namespace eval asciiart {
# ---- config ----------------------------------------------------------
variable trigger "!art"
variable flags "-|-"
variable artdir "scripts/art"
variable exts {txt ans asc nfo diz} ;# extensions treated as art
variable artencoding cp437 ;# decoding for .ans-family files
# --- flood protectioopn ---------------------------------------------
# Output goes through putserv => Eggdrop's flood protection stays ON.
# We feed the queue in small refills so it never gets huge, which means
# 'stop' only ever has a little to flush. 'queuecap' is how many art
# lines we let sit in the server queue at once; raise it for faster
# output at the cost of a slightly longer drain after 'stop'.
variable queuecap 5
variable tick 1 ;# seconds between refills (utimer min = 1)
# ----------------------------------------------------------------------
variable maxlines 0 ;# max lines per file (0 = unlimited)
variable cooldown 10 ;# seconds between art uses, per channel
variable encmap ; array set encmap {txt utf-8} ;# .txt = mIRC art (utf-8)
variable timer ; array set timer {} ;# chan -> active utimer id
variable last ; array set last {} ;# chan -> unix time of last art use
bind pub $flags $trigger asciiart::pub
putlog "ascii-art.tcl loaded: $trigger (dir: $artdir, queuecap: $queuecap)"
}
# Recursively index art files -> list of {relname fullpath}.
proc asciiart::index {dir {prefix ""}} {
variable exts
set out {}
foreach f [lsort [glob -nocomplain -directory $dir -type f *]] {
set e [string tolower [string trimleft [file extension $f] .]]
if {[lsearch -exact $exts $e] < 0} continue
set base [file rootname [file tail $f]]
set rel [expr {$prefix eq "" ? $base : "$prefix/$base"}]
lappend out [list $rel $f]
}
foreach d [lsort [glob -nocomplain -directory $dir -type d *]] {
set sub [file tail $d]
set np [expr {$prefix eq "" ? $sub : "$prefix/$sub"}]
set out [concat $out [asciiart::index $d $np]]
}
return $out
}
# Read art, decode by extension, trim DOS-EOF (0x1A) + trailing SAUCE.
proc asciiart::readart {path} {
variable encmap; variable artencoding
set ext [string tolower [string trimleft [file extension $path] .]]
set enc [expr {[info exists encmap($ext)] ? $encmap($ext) : $artencoding}]
if {[catch {open $path r} fp]} { return -code error "open failed" }
if {$enc eq "binary"} {
fconfigure $fp -translation binary -encoding binary
} else {
fconfigure $fp -encoding $enc -translation auto
}
set lines {}
set first 1
while {[gets $fp line] >= 0} {
if {$first} { set line [string trimleft $line \uFEFF] ; set first 0 }
set z [string first \x1A $line]
if {$z >= 0} {
set line [string range $line 0 [expr {$z - 1}]]
if {$line ne ""} { lappend lines $line }
break
}
if {$line eq ""} { set line " " }
lappend lines $line
}
close $fp
return $lines
}
proc asciiart::pub {nick uhost hand chan text} {
variable trigger; variable artdir; variable exts; variable maxlines
variable cooldown; variable timer; variable last
set arg [string trim [lindex [split $text] 0]]
# ---- stop ----
if {$arg eq "stop"} {
if {[info exists timer($chan)]} {
catch {killutimer $timer($chan)}
unset timer($chan)
catch {clearqueue server} ;# flush whatever's still queued in Eggdrop
putserv "PRIVMSG $chan :stopped."
} else {
putserv "NOTICE $nick :nothing is sending to $chan"
}
return
}
# one job at a time per channel (art OR a long listing)
if {[info exists timer($chan)]} {
putserv "NOTICE $nick :busy on $chan — use '$trigger stop' to abort"
return
}
# ---- list ----
if {$arg eq "list"} {
set idx [asciiart::index $artdir]
if {![llength $idx]} {
putserv "PRIVMSG $chan :no art found in $artdir"
return
}
array set groups {}
foreach pair $idx {
set rel [lindex $pair 0]
lappend groups([file dirname $rel]) [file tail $rel]
}
set lines {}
foreach g [lsort [array names groups]] {
set label [expr {$g eq "." ? "(top)" : $g}]
lappend lines "$label: [join [lsort $groups($g)] {, }]"
}
asciiart::start $chan $lines
return
}
if {$arg eq ""} {
putserv "PRIVMSG $chan :usage: $trigger <name> ('$trigger list', '$trigger stop')"
return
}
# cooldown (art only)
set now [clock seconds]
if {[info exists last($chan)] && ($now - $last($chan)) < $cooldown} {
set wait [expr {$cooldown - ($now - $last($chan))}]
putserv "NOTICE $nick :cooldown, try again in ${wait}s"
return
}
# ---- resolve name ----
set segs [split $arg /]
foreach s $segs {
if {$s eq ".." || ![regexp {^[A-Za-z0-9._-]+$} $s]} {
putserv "NOTICE $nick :invalid name"
return
}
}
set lastseg [lindex $segs end]
set lastext [string tolower [string trimleft [file extension $lastseg] .]]
if {[lsearch -exact $exts $lastext] >= 0} {
set segs [lreplace $segs end end [file rootname $lastseg]]
}
set req [join $segs /]
set reqL [string tolower $req]
set idx [asciiart::index $artdir]
set matches {}
foreach pair $idx {
if {[string tolower [lindex $pair 0]] eq $reqL} { lappend matches $pair }
}
if {![llength $matches] && [llength $segs] == 1} {
foreach pair $idx {
if {[string tolower [file tail [lindex $pair 0]]] eq $reqL} {
lappend matches $pair
}
}
}
if {![llength $matches]} {
putserv "NOTICE $nick :no such art: $req"
return
}
if {[llength $matches] > 1} {
set opts {}
foreach pair $matches { lappend opts [lindex $pair 0] }
putserv "NOTICE $nick :ambiguous '$req' — try: [join [lsort $opts] {, }]"
return
}
set path [lindex [lindex $matches 0] 1]
if {[catch {asciiart::readart $path} lines]} {
putserv "NOTICE $nick :can't read $req"
return
}
if {![llength $lines]} {
putserv "NOTICE $nick :$req is empty"
return
}
if {$maxlines > 0 && [llength $lines] > $maxlines} {
putserv "NOTICE $nick :$req is [llength $lines] lines (max $maxlines)"
return
}
set last($chan) $now
asciiart::start $chan $lines
}
# begin a send job for a channel
proc asciiart::start {chan lines} {
variable timer
# mark busy immediately so the guard + stop work even before first refill
set timer($chan) "init"
asciiart::pump $chan $lines 0
}
# Refill the server queue up to queuecap, then reschedule. The timer stays
# alive until BOTH all lines are handed over AND Eggdrop's queue has drained,
# so 'stop' always has a live timer to kill and a queue to clear.
proc asciiart::pump {chan lines idx} {
variable queuecap; variable tick; variable timer
set total [llength $lines]
# still have lines to hand over? top the queue back up to the cap.
if {$idx < $total} {
set room [expr {$queuecap - [queuesize server]}]
set i $idx
while {$room > 0 && $i < $total} {
putserv "PRIVMSG $chan :[lindex $lines $i]"
incr i
incr room -1
}
set timer($chan) [utimer $tick [list asciiart::pump $chan $lines $i]]
return
}
# all lines handed over — keep ticking until the queue actually empties,
# so we don't free the channel (and drop 'stop's clear target) early.
if {[queuesize server] > 0} {
set timer($chan) [utimer $tick [list asciiart::pump $chan $lines $total]]
return
}
catch {unset timer($chan)}
}