# 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)}
}