|
|
 |
 |
 |
 |
TCL(Tool Command Language) Scripting
|
 |
 |
 |
 |
|
|
|
|
How to implement the twirl sequence?
Hi, Guys - does anybody know how to make a "twirl sequence", it just
like a process indication.
for example:
set twirl_sequence "/-\\|/-\\|/-\\|/-\\|\\-/|\\-/|\\-/|\\-/|"
<====[i don't know if it's right]
........
........
and then, we will see the following output:
1 ---> /
2----> -
3---->\
4---->|
but, please note, only one line to show this.
Thanks,
Evan wrote: > Hi, Guys - does anybody know how to make a "twirl sequence", it just > like a process indication. > for example:
> set twirl_sequence "/-\\|/-\\|/-\\|/-\\|\\-/|\\-/|\\-/|\\-/|"
> <====[i don't know if it's right]
> ........
> ........
> and then, we will see the following output:
> 1 ---> /
> 2----> -
> 3---->\
> 4---->|
> but, please note, only one line to show this.
> Thanks,
set patternA [ list \b| \b/ \b- \b\\ ]
set patternB {
"\b\b\b\b\b\b| "
"\b\b\b\b\b\b / "
"\b\b\b\b\b\b - "
"\b\b\b\b\b\b \\ "
"\b\b\b\b\b\b |"
"\b\b\b\b\b\b \\ "
"\b\b\b\b\b\b - "
"\b\b\b\b\b\b / "
}
set pattern $patternB
set file stdout
puts -nonewline $file " "
set cnt -1
set length [ llength $pattern]
while {true} {
set pos [ expr { [incr cnt] % $length}]
puts -nonewline $file [lindex $pattern $pos ]
flush $file
after 200
}
G!
uwe
At 2007-05-07 12:13PM, "Evan" wrote:
> Hi, Guys - does anybody know how to make a "twirl sequence", it just
> like a process indication.
> for example:
> set twirl_sequence "/-\\|/-\\|/-\\|/-\\|\\-/|\\-/|\\-/|\\-/|"
> <====[i don't know if it's right]
> ........
> ........
> and then, we will see the following output:
> 1 ---> /
> 2----> -
> 3---->\
> 4---->|
> but, please note, only one line to show this.
for {set i [expr {$duration * 10}]} {$i >= 0} {incr i -1} {
# here's the secret: print a carriage return first
puts -nonewline "\r$prefix[lindex {/ | \\ -} [expr {$i % 4}]]"
flush stdout
after 100
}
puts ""
}
twirl 4 "watch the spinner --> "
--
Glenn Jackman
"You can only be young once. But you can always be immature." -- Dave Barry
See also http://wiki.tcl.tk/14551 "ASCII animation":
set phases {- / | \\}
proc ascii_animate _var {
upvar 1 $_var var
puts -nonewline [lindex $var 0]\r
flush stdout
set var [concat [lrange $var 1 end] [lindex $var 0]]
}
#-- Test:
while 1 {
ascii_animate phases
after 500
}
Glenn Jackman wrote:
...
> proc twirl {duration {prefix {}}} {
> for {set i [expr {$duration * 10}]} {$i >= 0} {incr i -1} {
> # here's the secret: print a carriage return first
> puts -nonewline "\r$prefix[lindex {/ | \\ -} [expr {$i % 4}]]"
> flush stdout
> after 100
> }
> puts ""
> }
is spinning):
proc twirl {duration {prefix ""}} {
if {$duration <= 0} { puts ""; return }
set phase [expr {int($duration*10)%4}]
puts -nonewline "\r$prefix[lindex {\\ | / -} $phase]"
flush stdout
after 100 [list twirl [expr {$duration-0.1}] $prefix]
}
-- Neil
At 2007-05-08 07:13AM, "Neil Madden" wrote:
> Glenn Jackman wrote: > ... > > proc twirl {duration {prefix {}}} {
> > for {set i [expr {$duration * 10}]} {$i >= 0} {incr i -1} {
> > # here's the secret: print a carriage return first
> > puts -nonewline "\r$prefix[lindex {/ | \\ -} [expr {$i % 4}]]"
> > flush stdout
> > after 100
> > }
> > puts ""
> > }
> And a version using the event loop (so you can do useful work while this
> is spinning):
> proc twirl {duration {prefix ""}} {
> if {$duration <= 0} { puts ""; return }
> set phase [expr {int($duration*10)%4}]
> puts -nonewline "\r$prefix[lindex {\\ | / -} $phase]"
> flush stdout
> after 100 [list twirl [expr {$duration-0.1}] $prefix]
> }
--
Glenn Jackman
"You can only be young once. But you can always be immature." -- Dave Barry
On 5?8?, ??9?17?, Glenn Jackman <gle@ncf.ca> wrote:
> At 2007-05-08 07:13AM, "Neil Madden" wrote: > > Glenn Jackman wrote:
> > ...
> > > proc twirl {duration {prefix {}}} {
> > > for {set i [expr {$duration * 10}]} {$i >= 0} {incr i -1} {
> > > # here's the secret: print a carriage return first
> > > puts -nonewline "\r$prefix[lindex {/ | \\ -} [expr {$i % 4}]]"
> > > flush stdout
> > > after 100
> > > }
> > > puts ""
> > > }
> > And a version using the event loop (so you can do useful work while this
> > is spinning):
> > proc twirl {duration {prefix ""}} {
> > if {$duration <= 0} { puts ""; return }
> > set phase [expr {int($duration*10)%4}]
> > puts -nonewline "\r$prefix[lindex {\\ | / -} $phase]"
> > flush stdout
> > after 100 [list twirl [expr {$duration-0.1}] $prefix]
> > }
> In hindsight, "duh". Thanks for that useful addition.
> --
> Glenn Jackman
> "You can only be young once. But you can always be immature." -- Dave Barry- ??????? -
> - ??????? -
> > proc twirl {duration {prefix ""}} {
> > if {$duration <= 0} { puts ""; return }
> > set phase [expr {int($duration*10)%4}]
> > puts -nonewline "\r$prefix[lindex {\\ | / -} $phase]"
> > flush stdout
> > after 100 [list twirl [expr {$duration-0.1}] $prefix]
> > }
Evan wrote:
...
> Thanks all, and I'd like to know how to run this new version" >>> proc twirl {duration {prefix ""}} {
>>> if {$duration <= 0} { puts ""; return }
>>> set phase [expr {int($duration*10)%4}]
>>> puts -nonewline "\r$prefix[lindex {\\ | / -} $phase]"
>>> flush stdout
>>> after 100 [list twirl [expr {$duration-0.1}] $prefix]
>>> }
twirl 4 "Watch the spinner --> "
but now you need to enter the event loop:
vwait forever
This allows you to process other events while it is spinning -- e.g.,
performing I/O to a socket or file. Alternatively, if you're not using
the event loop currently, then it may be easier to use Richard
Suchenwirth's version and just call it regularly.
-- Neil
On 5?8?, ??10?39?, Neil Madden <n@cs.nott.ac.uk> wrote:
> Evan wrote: > ...
> > Thanks all, and I'd like to know how to run this new version"
> >>> proc twirl {duration {prefix ""}} {
> >>> if {$duration <= 0} { puts ""; return }
> >>> set phase [expr {int($duration*10)%4}]
> >>> puts -nonewline "\r$prefix[lindex {\\ | / -} $phase]"
> >>> flush stdout
> >>> after 100 [list twirl [expr {$duration-0.1}] $prefix]
> >>> }
> Just start it going as before:
> twirl 4 "Watch the spinner --> "
> but now you need to enter the event loop:
> vwait forever
> This allows you to process other events while it is spinning -- e.g.,
> performing I/O to a socket or file. Alternatively, if you're not using
> the event loop currently, then it may be easier to use Richard
> Suchenwirth's version and just call it regularly.
> -- Neil
Thanks Neil.
Evan
At 2007-05-08 09:17AM, "Glenn Jackman" wrote:
> At 2007-05-08 07:13AM, "Neil Madden" wrote: > > Glenn Jackman wrote: > > ... > > > proc twirl {duration {prefix {}}} {
> > > for {set i [expr {$duration * 10}]} {$i >= 0} {incr i -1} {
> > > # here's the secret: print a carriage return first
> > > puts -nonewline "\r$prefix[lindex {/ | \\ -} [expr {$i % 4}]]"
> > > flush stdout
> > > after 100
> > > }
> > > puts ""
> > > }
> > And a version using the event loop (so you can do useful work while this
> > is spinning):
> > proc twirl {duration {prefix ""}} {
> > if {$duration <= 0} { puts ""; return }
> > set phase [expr {int($duration*10)%4}]
> > puts -nonewline "\r$prefix[lindex {\\ | / -} $phase]"
> > flush stdout
> > after 100 [list twirl [expr {$duration-0.1}] $prefix]
> > }
> In hindsight, "duh". Thanks for that useful addition.
namespace eval twirler {
variable afterid
variable DONE
variable chars {/ - \\ |}
proc start {duration {prefix ""} {suffix ""}} {
if { ! ([string is integer -strict $duration] && $duration > 0)} {
error "duration must be a positive integer"
}
spin 0 $prefix $suffix
set stopid [after ${duration}000 [namespace current]::stop]
vwait [namespace current]::DONE
after cancel $stopid
}
proc spin {index prefix suffix} {
variable chars
puts -nonewline "\r$prefix[lindex $chars $index]$suffix"
flush stdout
variable afterid [after 100 [list [namespace current]::spin [expr {($index + 1)%4}] $prefix $suffix]]
}
proc stop {} {
variable afterid
after cancel $afterid
puts ""
variable DONE 1
}
}
twirler::start 4 "a>" "<b"
Not entirely confident about the use of [vwait] though.
--
Glenn Jackman
"You can only be young once. But you can always be immature." -- Dave Barry
|
|
|
|
|
|
Add to del.icio.us |
Digg this |
Stumble it |
Powered by Megasolutions Inc