cmdr
Check-in [faf4b58f8c]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Draft work on an output package for basic terminal control, and animations (like progress-bars, barber-poles, counters, etc.)
Timelines: family | ancestors | descendants | both | say-more
Files: files | file ages | folders
SHA1: faf4b58f8c6c26b3fdfe6fd3e1e1f9967d920e5a
User & Date: andreask 2015-04-21 18:11:15.441
Context
2015-04-22
20:13
Worked the low-level output into the ask package as demo of use. Especially made the retry loops visually tighter (temp display of error on bad input, plus reuse of existing line for re-input, no redraw of fixed parts (headers, menu listings)). check-in: 4f4b8b9a82 user: andreask tags: say-more
2015-04-21
18:11
Draft work on an output package for basic terminal control, and animations (like progress-bars, barber-poles, counters, etc.) check-in: faf4b58f8c user: andreask tags: say-more
2015-04-17
23:24
history - Added missing docs. check-in: 860ef7cfb3 user: andreask tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Added say-ex.tcl.












































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
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

source color.tcl
source say.tcl

#debug on cmdr/say

if 0 {
    puts |[join [cmdr say larson-phases 23 ***] |\n|]|
    exit
}


if 0 {
    puts |[join [cmdr say pulse-phases 6 *] |\n|]|
    exit
}

if 0 {
    puts |[join [cmdr say pulse-phases 3 [cmdr color red .]] |\n|]|
    exit
}

if 0 {
    puts |[join [cmdr say progress-phases 6 * ^] |\n|]|
    exit
}

if 0 {
    # larson scanner
    set B [cmdr say animate -phases [cmdr say larson-phases 9 ***]]
    while {1} {
	after 100
	cmdr say rewind
	$B step

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

if 0 {
    # scanner
    set B [cmdr say animate -phases {
	{[***      ]}
	{[** *     ]}
	{[ ** *    ]}
	{[  ** *   ]}
	{[   ** *  ]}
	{[    ** * ]}
	{[     ** *]}
	{[      ***]}
	{[     * **]}
	{[    * ** ]}
	{[   * **  ]}
	{[  * **   ]}
	{[ * **    ]}
	{[* **     ]}
    }]
    while {1} {
	after 100
	cmdr say rewind
	$B step

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

if 0 {
    # infinite slider - semi-barberpole
    set B [cmdr say animate -phases [cmdr say slider-phases 9 ***]]
    while {1} {
	after 100
	cmdr say rewind
	$B step
    }
}

if 1 {
    # infinite slider - semi-barberpole
    set B [cmdr say animate -phases {
	{[         ]}
	{[*        ]}
	{[**       ]}
	{[***      ]}
	{[* **     ]}
	{[ * **    ]}
	{[  * **   ]}
	{[   * **  ]}
	{[    * ** ]}
	{[     * **]}
	{[      * *]}
	{[       * ]}
	{[        *]}
    }]
    while {1} {
	after 100
	cmdr say rewind
	$B step
    }
}

if 0 {
    # infinite pulse - semi-barberpole
    set B [cmdr say animate \
	       -phases [cmdr say pulse-phases 3 [cmdr color {bg-blue white} *]]]
    while {1} {
	after 100
	cmdr say rewind
	$B step
    }
}

if 0 {
    # infinite barberpole
    set B [cmdr say barberpole -width 30]
    while {1} {
	after 100
	cmdr say rewind
	$B step
    }
}

if 0 {
    # infinite barberpole with a prefix
    set B [cmdr say barberpole -width 30]
    cmdr say add "download ... "
    cmdr say lock-prefix
    while {1} {
	#
	# fake download, unknown size, sync ... actual use:
	# - fcopy callback,
	# - http progress-callback
	# - tcllib transfer callback
	after 100
	#
	cmdr say rewind
	$B step
    }
}

if 0 {
    # progress counter.
    set B [cmdr say progress-counter 100]
    set i 0
    cmdr say add "upload ... "
    cmdr say lock-prefix
    while {$i < 100} {
	#
	# fake upload, sync ... actual use:
	# - fcopy callback,
	# - http progress-callback
	# - tcllib transfer callback
	after 100
	#
	cmdr say rewind
	incr i
	$B step $i
    }
}

if 0 {
    # percent progress counter
    set B [cmdr say percent -max 10000 -digits 2]
    set i 0
    cmdr say add "upload ... "
    cmdr say lock-prefix
    while {$i < 10000} {
	#
	# fake upload, sync ... actual use:
	# - fcopy callback,
	# - http progress-callback
	# - tcllib transfer callback
	after 10
	#
	cmdr say rewind
	incr i
	$B step $i
    }
}

if 0 {
    # percent progress bar
    set B [cmdr say progress -max 1000 -width 50]
    set C [cmdr say percent  -max 1000]
    set i 0
    cmdr say add "upload ... "
    cmdr say lock-prefix
    while {$i < 1000} {
	#
	# fake upload, sync ... actual use:
	# - fcopy callback,
	# - http progress-callback
	# - tcllib transfer callback
	after 10
	#
	cmdr say rewind
	incr i
	cmdr say add \[
	$B step $i
	cmdr say add \]

	cmdr say add { }
	$C step $i
    }
    #after 10
    #cmdr say rewind
    cmdr say line { OK}
}

if 0 {
    # percent progress bar, full width
    set C [cmdr say percent -max 1000]

    set  n [string length "upload ... \[\] "]
    incr n [$C width]

    set B [cmdr say progress -max 1000 -width -$n]
    set i 0
    cmdr say add "upload ... "
    cmdr say lock-prefix
    while {$i < 1000} {
	#
	# fake upload, sync ... actual use:
	# - fcopy callback,
	# - http progress-callback
	# - tcllib transfer callback
	after 10
	#
	cmdr say rewind
	incr i
	$C step $i
	cmdr say add { }

	cmdr say add \[
	$B step $i
	cmdr say add \]
    }
    after 1000
    cmdr say rewind
    cmdr say line { OK}
}
Added say.tcl.


















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
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
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
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
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
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
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
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## CMDR - Convenience commands for terminal manipulation and output

# @@ Meta Begin
# Package cmdr::say 0
# Meta author   {Andreas Kupries}
# Meta location https://core.tcl.tk/akupries/cmdr
# Meta platform tcl
# Meta summary     Terminal manipulation and output.
# Meta description Commands to generate terminal output, to control
# Meta description the terminal, and print text
# Meta subject {command line} tty interaction terminal
# Meta require {Tcl 8.5-}
# Meta require debug
# Meta require debug::caller
# Meta require cmdr::color
# Meta require linenoise
# Meta require TclOO
# @@ Meta End

# # ## ### ##### ######## ############# #####################
## Requisites

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

    namespace ensemble create
    namespace import ::cmdr::color

    # State for "add", "lock-prefix", "clear-prefix", and "rewind"
    variable prefix {}
    variable pre    {}
}

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

debug define cmdr/say
debug level  cmdr/say
debug prefix cmdr/say {[debug caller] | }

# # ## ### ##### ######## ############# #####################
## cursor movement

proc ::cmdr::say::up {{n 1}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[${n}A
    flush           stdout
    return
}

proc ::cmdr::say::down {{n 1}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[${n}B
    flush           stdout
    return
}

proc ::cmdr::say::forw {{n 1}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[${n}C
    flush           stdout
    return
}

proc ::cmdr::say::back {{n 1}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[${n}D
    flush           stdout
    return
}

# # ## ### ##### ######## ############# #####################
## (partial) screen erasure

proc ::cmdr::say::erase-screen {{suffix {}}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[2J$suffix
    flush           stdout
    return
}

proc ::cmdr::say::erase-up {{suffix {}}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[1J$suffix
    flush           stdout
    return
}

proc ::cmdr::say::erase-down {{suffix {}}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[0J$suffix
    flush           stdout
    return
}

# # ## ### ##### ######## ############# #####################
## (partial) line erasure

proc ::cmdr::say::erase-line {{suffix {}}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[2K$suffix
    flush           stdout
    return
}

proc ::cmdr::say::erase-back {{suffix {}}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[1K$suffix
    flush           stdout
    return
}

proc ::cmdr::say::erase-forw {{suffix {}}} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[0K$suffix
    flush           stdout
    return
}

# # ## ### ##### ######## ############# #####################
## absolute cursor movement

proc ::cmdr::say::goto {x y} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[${y};${x}f
    flush           stdout
    return
}

proc ::cmdr::say::home {} {
    debug.cmdr/say {}
    puts -nonewline stdout \033\[H
    flush           stdout
    return
}

# # ## ### ##### ######## ############# #####################
## bottom level line output and animation control

proc ::cmdr::say::add {text} {
    debug.cmdr/say {}
    variable pre
    append   pre $text
    puts -nonewline stdout $text
    flush           stdout
    return
}

proc ::cmdr::say::line {text} {
    debug.cmdr/say {}
    variable pre    {}
    variable prefix {}
    puts  stdout $text
    flush stdout
    return
}

proc ::cmdr::say::rewind {} {
    debug.cmdr/say {}
    variable prefix
    erase-line \r$prefix
    return
}

proc ::cmdr::say::lock-prefix {} {
    debug.cmdr/say {}
    variable pre
    variable prefix $pre
    return
}

proc ::cmdr::say::clear-prefix {} {
    debug.cmdr/say {}
    variable prefix {}
    return
}

proc ::cmdr::say::next {} {
    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
    }

    method configure {args} {
	array set config $args
	::cmdr::say::Require config -phases

	set myphases $config(-phases)
	set myphase  0
	set mywidth  [string length [lindex $myphases 0]]
	return
    }

    method width {} {
	debug.cmdr/say {}
	return $mywidth
    }

    method step {} {
	debug.cmdr/say {}
	cmdr say add [lindex $myphases $myphase]
	incr myphase
	if {$myphase == [llength $myphases]} { set myphase 0 }
	return
    }

    method goto {phase} {
	debug.cmdr/say {}
	set myphase $phase
	cmdr say add [lindex $myphases $myphase]
	return
    }

    method done {} {
	debug.cmdr/say {}
	my destroy
    }
}

# # ## ### ##### ######## ############# #####################
## barberpole animation

proc ::cmdr::say::barberpole {args} {
    debug.cmdr/say {}

    array set config {
	-width   {}
	-pattern {**  }
    }
    array set config $args

    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}]
	set myformat %${n}d/%d
	return
    }

    method width {} {
	debug.cmdr/say {}
	return $mywidth
    }

    method step {at} {
	debug.cmdr/say {}
	cmdr say add [format $myformat $at $mymax]
	return
    }

    method done {} {
	debug.cmdr/say {}
	my destroy
    }
}

# # ## ### ##### ######## ############# #####################
## progress counter, in percent.

proc ::cmdr::say::percent {args} {
    debug.cmdr/say {}

    array set config {
	-max    100
	-digits 2
    }
    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
	if {$digits} {
	    incr mywidth ;# .
	    incr mywidth $digits
	}
	set myformat %${mywidth}.${digits}f
	return
    }

    method width {} {
	debug.cmdr/say {}
	return $mywidth
    }

    method step {at} {
	debug.cmdr/say {}
	set percent [expr {100*double($at)/double($mymax)}]
	cmdr say add [format $myformat $percent]%
	return
    }

    method done {} {
	debug.cmdr/say {}
	my destroy
    }
}

# # ## ### ##### ######## ############# #####################
## progress-bar

proc ::cmdr::say::progress {args} {
    debug.cmdr/say {}

    array set config {
	-max    100
	-width  {}
	-stem   =
	-head   >
    }
    array set config $args

    set phases [progress-phases \
		    [auto-width $config(-width)] \
		    $config(-stem) \
		    $config(-head)]

    return [progress::Im new $config(-max) $phases]
}

oo::class create ::cmdr::say::progress::Im {
    variable mymax myphases

    constructor {max phases} {
	debug.cmdr/say {}
	# Inner object, general animation, container for our phases.
	cmdr::say::animate::Im create A -phases $phases
	set mymax    $max
	set myphases [llength $phases]
	return
    }

    forward width \
	A width

    method step {at} {
	debug.cmdr/say {}
	set phase [expr {int($myphases * (double($at)/double($mymax)))}]
	if {$phase >= $myphases} { set phase end }
	A goto $phase
	return
    }

    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
	set width [linenoise columns]
    } elseif {$width < 0} {
	# Adapt to terminal width, with some space reserved.
	set width [expr {[linenoise columns] + $width}]
    }
    return $width
}

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

proc ::cmdr::say::barber-phases {width pattern} {
    debug.cmdr/say {}

    # Repeat the base pattern as necessary to fill the requested
    # width. We use a count which gives us something which might be a
    # bit over, so after replication the resulting string is cut down
    # to the exact size.
    set n    [expr {int(0.5+ceil($width / double([string length $pattern])))}]
    set base [string range [string repeat $pattern $n] 0 ${width}-1]

    # Example for standard pattern '**  ', widths 16, and 17.
    # |**  **  **  **  |
    # | **  **  **  ** |
    # |  **  **  **  **|
    # |*  **  **  **  *|

    # |**  **  **  **  *| Note how the odd length yields one larger
    # |***  **  **  **  | band (***) in the pattern, which ripples
    # | ***  **  **  ** | across, and multiplies the number of phases
    # |  ***  **  **  **| before reaching the origin again.
    # |*  ***  **  **  *|
    # |**  ***  **  **  | Similar effects will be had for for any width
    # | **  ***  **  ** | which W != 0 mod (length pattern).
    # |  **  ***  **  **|
    # |*  **  ***  **  *|
    # |**  **  ***  **  |
    # | **  **  ***  ** |
    # |  **  **  ***  **|
    # |*  **  **  ***  *|
    # |**  **  **  ***  |
    # | **  **  **  *** |
    # |  **  **  **  ***|
    # |*  **  **  **  **|

    lappend phases $base
    # rotate the base through all configurations until we reach it again.
    set next $base
    while {1} {
	set next [string range $next 1 end][string index $next 0]
	if {$next eq $base} break
	lappend phases $next
    }

    return $phases
}

proc ::cmdr::say::progress-phases {width stem head} {
    debug.cmdr/say {}

    # compute phases.
    set h [string length $head]
    set phases {}
    for {set i 0} {$i < ($width - $h)} {incr i} {
	lappend phases [string repeat $stem $i]$head
	# >, =>, ==>, ...
    }

    return [Fill $phases]
}

proc ::cmdr::say::larson-phases {width pattern} {
    debug.cmdr/say {}

    set n [string length $pattern]
    if {$n > $width} {
	return [list $pattern]
    }

    set spaces [expr {$width - $n}]

    # round 1: slide right
    for {
	set pre  0
	set post $spaces
    } { $post > 0 } {
	incr pre
	incr post -1
    } {
	lappend phases [string repeat { } $pre]${pattern}[string repeat { } $post]
    }

    # round 2: slide left
    for {
	set pre  $spaces
	set post 0
    } { $pre > 0 } {
	incr pre  -1
	incr post
    } {
	lappend phases [string repeat { } $pre]${pattern}[string repeat { } $post]
    }

    return $phases
}

proc ::cmdr::say::slider-phases {width pattern} {
    debug.cmdr/say {}

    set n [string length $pattern]
    if {$n > $width} {
	return [list $pattern]
    }

    # round 1: slide pattern in.
    lappend phases {}
    for {set k 0} {$k < $n} {incr k} {
	lappend phases [string range $pattern end-$k end]
    }

    # round 2: slide pattern right.
    set spaces [expr {$width - $n}]
    for {
	set pre  0
	set post $spaces
    } { $post > 0 } {
	incr pre
	incr post -1
    } {
	lappend phases [string repeat { } $pre]${pattern}[string repeat { } $post]
    }

    # round 3: slide pattern out.
    for {set k 0} {$k < $n} {incr k} {
	lappend phases [string repeat { } $pre][string range $pattern 0 end-$k]
	incr pre
    }

    return $phases
}

proc ::cmdr::say::pulse-phases {width stem} {
    debug.cmdr/say {}

    # 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
    return -code error \
	-errorCode [list CMDR SAY OPTION MISSING $option] \
	"Missing required option \"$option\""
}

proc ::cmdr::say::Fill {phases} {
    # compute max length of phase strings
    set max [string length [lindex $phases 0]]
    foreach p [lrange $phases 1 end] {
	# Look for ANSI color control sequences and remove them. Avoid
	# counting their characters as such sequences as a whole
	# represent a state change, and are logically of zero/no
	# width.
	regsub -all "\033\\\[\[0-9;\]*m" $p {} p
	set n [string length $p]
	if {$n < $max} continue
	set max $n
    }

    # then pad all other strings which do not reach that length with
    # spaces at the end.
    set tmp {}
    foreach p $phases {
	# Look for ANSI color control sequences and discount
	# them. Avoid counting their characters as such sequences as a
	# whole represent a state change, and are logically of zero/no
	# width.
	regsub -all "\033\\\[\[0-9;\]*m" $p {} px
	set n [string length $px]
	if {$n < $max} {
	    append p [string repeat { } [expr {$max - $n}]]
	}
	lappend tmp $p
    }

    return $tmp
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide cmdr::say 1