cmdr
Check-in [de4974db8f]
Not logged in

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:de4974db8fe30a276abcd5b801766c85a99144f5
User & Date: andreask 2015-04-30 22:00:18
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
...
217
218
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
...
303
304
305
306
307
308
309






























310
311
312
313
314
315
316
317
318
319

320
321
322
323
324
325
326
...
357
358
359
360
361
362
363

364
365
366
367
368
369
370
...
441
442
443
444
445
446
447




























































































































448
449
450
451
452
453
454
...
598
599
600
601
602
603
604




605
606
607
608
609
610
611

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 {

    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 animate barberpole percent progress-counter progress \
	operation \
	\
	auto-width barber-phases progress-phases larson-phases \
	slider-phases pulse-phases \
	\
	to

    namespace ensemble create
    namespace import ::cmdr::color

    # State for "add", "lock-prefix", "clear-prefix", and "rewind"
................................................................................
    debug.cmdr/say {}
    clear-prefix
    puts  stdout ""
    flush stdout
    return
}








# # ## ### ##### ######## ############# #####################

proc ::cmdr::say::operation {lead script} {
    debug.cmdr/say {}























    add $lead



    uplevel 1 $script











    line [color good OK]























    return
}
















# # ## ### ##### ######## ############# #####################
## 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 {

    variable myphases myphase mywidth

    constructor {args} {
	debug.cmdr/say {}
	my configure {*}$args
	return
    }
................................................................................
    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}]
................................................................................
    }
    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
................................................................................

    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
................................................................................
    # 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







>





>
|



|
|


|







 







>
>
>
>
>
>
>


|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>

>
|
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>












>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










>







 







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>







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
...
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
...
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
...
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
...
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
...
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854

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"
................................................................................
    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
    }
................................................................................
    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}]
................................................................................
    }
    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
................................................................................

    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
................................................................................
    # 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