Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | More animations, extended the "operation" command with easy integration of animations, added examples. Added helper script "local" for easier execution of the examples without having cmdr::say installed. |
---|---|
Timelines: | family | ancestors | descendants | both | say-more |
Files: | files | file ages | folders |
SHA1: |
de4974db8fe30a276abcd5b801766c85 |
User & Date: | andreask 2015-04-30 22:00:18.443 |
Context
2015-05-01
| ||
00:06 | Tweaked options for "operation" command, extended a bit, plus slider & larson animation classes. check-in: e250dbed44 user: andreask tags: say-more | |
2015-04-30
| ||
22:00 | More animations, extended the "operation" command with easy integration of animations, added examples. Added helper script "local" for easier execution of the examples without having cmdr::say installed. check-in: de4974db8f user: andreask tags: say-more | |
2015-04-22
| ||
21:42 | say - Start on tests, and extended package to support output redirection, making the tests easier. check-in: 2cc0a755b9 user: andreask tags: say-more | |
Changes
Added examples/local.
> > > > > > > > > | 1 2 3 4 5 6 7 8 9 | #!/usr/bin/env tclsh # -*- tcl -*- #lappend auto_path [file dirname [file dirname [file normalize [info script]]]] #puts "= [join $auto_path "\n= "]" source [file dirname [file dirname [file normalize [info script]]]]/say.tcl source [lindex $argv 0] exit |
Added examples/say-operation-barber.
> > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 | #!/usr/bin/env tclsh # -*- tcl -*- package require Tcl 8.5 package require cmdr::say cmdr say operation {Upload ... } { after 5000 {set ::done ok} vwait ::done } -play {cmdr say barberpole -width -11} exit |
Added examples/say-operation-ping.
> > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 | #!/usr/bin/env tclsh # -*- tcl -*- package require Tcl 8.5 package require cmdr::say cmdr say operation {Upload } { after 5000 {set ::done ok} vwait ::done } -play {cmdr say ping -width 31 -wrap 1} exit |
Added examples/say-operation-pulse.
> > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 | #!/usr/bin/env tclsh # -*- tcl -*- package require Tcl 8.5 package require cmdr::say cmdr say operation {Upload } { after 5000 {set ::done ok} vwait ::done } -every 50 -play {cmdr say pulse -width 7} exit |
Added examples/say-operation-turn.
> > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 | #!/usr/bin/env tclsh # -*- tcl -*- package require Tcl 8.5 package require cmdr::say cmdr say operation {Upload } { after 5000 {set ::done ok} vwait ::done } -every 50 -play {cmdr say turn} exit |
Added examples/say-ping.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | #!/usr/bin/env tclsh # -*- tcl -*- package require Tcl 8.5 package require cmdr::say # ping bar #set B [cmdr say ping -width 17] #set B [cmdr say ping -width 17 -wrap 1] set B [cmdr say ping -width 41 -wrap 1 -head {} -map { 100000 @ 10000 \# 1000 % 100 | 10 * 1 {} }] #set B [cmdr say ping -width -8 -wrap 1] #set B [cmdr say ping -width -8] #set B [cmdr say ping -width Inf] cmdr say add "upload " cmdr say lock-prefix while {1} { # # fake upload, sync ... actual use: # - fcopy callback, # - http progress-callback # - tcllib transfer callback after 10 # cmdr say rewind $B step } exit |
Added examples/say-turn.
> > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | #!/usr/bin/env tclsh # -*- tcl -*- package require Tcl 8.5 package require cmdr::say # turn set B [cmdr say animate -phases [cmdr say turn-phases]] while {1} { after 100 cmdr say rewind cmdr say add ( $B step cmdr say add ) # NOTE: putting the rewind after the step means that we will # see the animation output only for a split second and the # erased/empty line for the 100 milli delay => the terminal # will look empty, with nothing happening. } exit |
Added examples/say-turn-phases.
> > > > > > > > | 1 2 3 4 5 6 7 8 | #!/usr/bin/env tclsh # -*- tcl -*- package require Tcl 8.5 package require cmdr::say puts ([join [cmdr say turn-phases] )\n(]) exit |
Changes to say.tcl.
︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 | package require Tcl 8.5 package require cmdr::color package require debug package require debug::caller package require linenoise package require TclOO namespace eval ::cmdr { namespace export say } namespace eval ::cmdr::say { | > | > | | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | package require Tcl 8.5 package require cmdr::color package require debug package require debug::caller package require linenoise package require TclOO package require try namespace eval ::cmdr { namespace export say } namespace eval ::cmdr::say { namespace export \ up down forw back \ erase-screen erase-up erase-down \ erase-line erase-back erase-forw \ goto home line add line rewind lock-prefix clear-prefix \ next next* animate barberpole percent progress-counter progress \ ping pulse turn operation \ \ auto-width barber-phases progress-phases larson-phases \ slider-phases pulse-phases turn-phases \ \ to namespace ensemble create namespace import ::cmdr::color # State for "add", "lock-prefix", "clear-prefix", and "rewind" |
︙ | ︙ | |||
217 218 219 220 221 222 223 224 225 | debug.cmdr/say {} clear-prefix puts stdout "" flush stdout return } # # ## ### ##### ######## ############# ##################### | > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > | > | > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > > > > > > > > > > > > | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 | debug.cmdr/say {} clear-prefix puts stdout "" flush stdout return } proc ::cmdr::say::next* {} { debug.cmdr/say {} puts stdout "" flush stdout return } # # ## ### ##### ######## ############# ##################### proc ::cmdr::say::operation {lead script args} { debug.cmdr/say {} set cmd {} set delay 100 while {1} { set o [lindex $args 0] switch -glob -- $o { -every { set delay [lindex $args 1] set args [lrange $args 2 end] } -play { set cmd [lindex $args 1] set args [lrange $args 2 end] } -* { return -code error \ -errorcode {CMD SAY BAD-OPTION} \ "Unknown option $o, expected -a, or -d" } default break } } add $lead lock-prefix if {[llength $cmd]} { set animation [uplevel 1 $cmd] $animation run $delay } try { uplevel 1 $script } {*}$args on error {e o} { # General error => close line, and pass. line "" return {*}$o $e } on ok {e o} { rewind ; # remove animation output, leave only the lead line [color good OK] } finally { # Stop ongoing animation, if any if {[llength $cmd]} { $animation done } } return $e } # # ## ### ##### ######## ############# ##################### ## Animation helper class (timer driven auto-step). oo::class create ::cmdr::say::Auto { variable mytimer method run {delay} { debug.cmdr/say {} my stop ;# Kill a running timer, this allows us to call sequences of runs without worrying about the system state. cmdr say rewind my step set mytimer [after $delay [info level 0]] return } method stop {} { debug.cmdr/say {} catch { after cancel $mytimer } set mytimer {} return } destructor { debug.cmdr/say {} my stop } } # # ## ### ##### ######## ############# ##################### ## general animation command and class proc ::cmdr::say::animate {args} { debug.cmdr/say {} array set config $args Require config -phases return [animate::Im new -phases [Fill $config(-phases)]] } oo::class create ::cmdr::say::animate::Im { superclass ::cmdr::say::Auto variable myphases myphase mywidth constructor {args} { debug.cmdr/say {} my configure {*}$args return } |
︙ | ︙ | |||
303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | set phases [barber-phases \ [auto-width $config(-width)] \ $config(-pattern)] # Run the animation via the general class. return [animate::Im new -phases $phases] } # # ## ### ##### ######## ############# ##################### ## progress counter, n of max. proc ::cmdr::say::progress-counter {max} { debug.cmdr/say {} return [progress-counter::Im new $max] } oo::class create ::cmdr::say::progress-counter::Im { variable mywidth myformat mymax constructor {max} { debug.cmdr/say {} set n [string length $max] set mymax $max set mywidth [expr {1+2*$n}] | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 | set phases [barber-phases \ [auto-width $config(-width)] \ $config(-pattern)] # Run the animation via the general class. return [animate::Im new -phases $phases] } # # ## ### ##### ######## ############# ##################### ## pulse animation proc ::cmdr::say::pulse {args} { debug.cmdr/say {} array set config { -width {} -stem . } array set config $args set phases [pulse-phases \ [auto-width $config(-width)] \ $config(-stem)] # Run the animation via the general class. return [animate::Im new -phases $phases] } # # ## ### ##### ######## ############# ##################### ## turn animation proc ::cmdr::say::turn {} { debug.cmdr/say {} set phases [turn-phases] # Run the animation via the general class. return [animate::Im new -phases $phases] } # # ## ### ##### ######## ############# ##################### ## progress counter, n of max. proc ::cmdr::say::progress-counter {max} { debug.cmdr/say {} return [progress-counter::Im new $max] } oo::class create ::cmdr::say::progress-counter::Im { superclass ::cmdr::say::Auto variable mywidth myformat mymax constructor {max} { debug.cmdr/say {} set n [string length $max] set mymax $max set mywidth [expr {1+2*$n}] |
︙ | ︙ | |||
357 358 359 360 361 362 363 364 365 366 367 368 369 370 | } array set config $args return [percent::Im new $config(-max) $config(-digits)] } oo::class create ::cmdr::say::percent::Im { variable mywidth myformat mymax constructor {max digits} { debug.cmdr/say {} set mymax $max set mywidth 3 | > | 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | } array set config $args return [percent::Im new $config(-max) $config(-digits)] } oo::class create ::cmdr::say::percent::Im { superclass ::cmdr::say::Auto variable mywidth myformat mymax constructor {max digits} { debug.cmdr/say {} set mymax $max set mywidth 3 |
︙ | ︙ | |||
441 442 443 444 445 446 447 448 449 450 451 452 453 454 | method done {} { debug.cmdr/say {} my destroy } } # # ## ### ##### ######## ############# ##################### proc ::cmdr::say::auto-width {width} { debug.cmdr/say {} if {$width eq {}} { # Nothing defined, adapt to terminal width | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 | method done {} { debug.cmdr/say {} my destroy } } # # ## ### ##### ######## ############# ##################### ## ping proc ::cmdr::say::ping {args} { debug.cmdr/say {} # Options # -head string - Show in front of the ping characters. # -map dict - Map moduli to characters, when reached. # Order relevant, largest moduli first. # End with modulus 1, always matching! # (System will internally add such to close the map). # -width int - Amount of space to use for the moving ping+head # -wrap bool - Wrapping keeps the moving part within the current line. # Without wrap a wrap goes to the next line using next*. array set config { -wrap 0 -head & -map { 100000 @ 10000 \# 1000 % 100 | 10 * 1 . } -width {} } array set config $args return [ping::Im new \ $config(-wrap) \ $config(-head) \ $config(-map) \ [auto-width $config(-width)]] } oo::class create ::cmdr::say::ping::Im { superclass ::cmdr::say::Auto variable mywrap myhead mymap mywidth myphase mybuffer myewidth mytrail constructor {wrap head map width} { debug.cmdr/say {} # close map, if user forgot. No-op if user closed it. lappend map 1 _ ;# default char configurable ? set mywrap $wrap set myhead $head set mymap $map set mywidth $width set myewidth [expr {$mywidth - [string length $head]}] ;# effective width. set myphase 0 set mybuffer "" if {$mywrap} { set mytrail [string repeat { } $myewidth] } else { set mytrail {} } return } method width {} { return $mywidth } method step {} { debug.cmdr/say {} set ch [my Next] # Create a buffer to print, from the previous state. # First attempt. Without a head leading the pings. append mybuffer $ch set str $mybuffer if {$mywrap} { set mytrail [string range $mytrail 1 end] } if {[string length $str] < $myewidth} { # Still fits. Simply print. cmdr say add $str$myhead$mytrail } else { # Too long. Split into a fitting piece and overshot. set fit [string range $str 0 ${myewidth}-1] set over [string range $str ${myewidth} end] # Print the fitting piece first to complete the line, # then move to the next line and print the overshot. cmdr say add $fit if {!$mywrap} { cmdr say next* ;# no-wrap: next line, keep current prefix. } else { cmdr say rewind ;# wrap: rewind/clear line and continue } cmdr say add $over$myhead$mytrail # Set state for next call. set mybuffer $over if {$mywrap} { set mytrail $fit } } return } method done {} { debug.cmdr/say {} my destroy } method Next {} { incr myphase foreach {mod char} $mymap { if {($myphase % $mod) != 0} continue return $char } return -code error -errorcode ... "" } } # # ## ### ##### ######## ############# ##################### proc ::cmdr::say::auto-width {width} { debug.cmdr/say {} if {$width eq {}} { # Nothing defined, adapt to terminal width |
︙ | ︙ | |||
598 599 600 601 602 603 604 605 606 607 608 609 610 611 | # compute phases. set phases {} for {set i 0} {$i <= $width} {incr i} { lappend phases [string repeat $stem $i] } return [Fill $phases] } # # ## ### ##### ######## ############# ##################### proc ::cmdr::say::Require {cv option} { debug.cmdr/say {} upvar 1 $cv config if {[info exists config($option)]} return | > > > > | 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 | # compute phases. set phases {} for {set i 0} {$i <= $width} {incr i} { lappend phases [string repeat $stem $i] } return [Fill $phases] } proc ::cmdr::say::turn-phases {} { return [list | / - \\] } # # ## ### ##### ######## ############# ##################### proc ::cmdr::say::Require {cv option} { debug.cmdr/say {} upvar 1 $cv config if {[info exists config($option)]} return |
︙ | ︙ |