Timer TCL

[djkenny]

salut,

pour ceux que ça intéresserais voila le utimer de eggdrop recodé entièrement en tcl pur avec after (comprend le killutimer et utimers)

tclcopier

proc timer {time proc} {
 variable timers
  set timerid [after [expr $time*1000] $proc]
  lappend timers "[expr [unixtime] + $time] $proc $timerid" 
  set after($timerid) [after [expr $time*1000] "[namespace current]::unsettimers {[expr [unixtime] + $time] $proc $timerid}"] 
  return $timerid
}
 
proc unsettimers {id} {
 variable timers
  if {[info exists timers] && $timers!=""} {
    set find [lsearch -exact $timers "$id"]
    if {$find!="-1"} {
      set timers [lreplace $timers $find $find]
    }
  }
}
 
proc timers { } {
 variable timers
  if {[info exists timers] && $timers!=""} {
    foreach u $timers {
      set u [charfilter $u]
      set t [lindex $u 0]
      set t [expr $t - [unixtime]]
      lappend ut "$t {[join [lrange $u 1 [expr [llength $u] - 2]]]} [lindex $u end]"
    }
    return $ut
  }
  return
}
 
proc killtimer {timerid} {
 variable timers
  if {[info exists timers] && $timers!=""} {
    foreach u $timers {
      if {[lindex $u end]==$timerid} {
        unsettimers $u
        catch {after cancel $timerid}
      }
    }
  }
}