[ET] 2022-5-8 - (1.12)  (New: more debug options)

The Tasks module's primary goal is to make threads simple to use: as easy as calling a standard procedure. Tasks can be used in place of or together with the Threads package.

Tasks are a concurrent programming abstraction layered on Tcl Threads.  A Task mimics a standard proc called with an '''arglist'''. Tasks can team up in a client/multi-server operation to concurrently process arglists from a single job queue to increase performance. Tasks are pure tcl and hosted entirely here on the wiki. 

The below example demonstrates how with '''Tasks''' one can transform a proc into a team of tcl threads by just adding a '''T'''.

This example was derived from '''Ashok's''' web page on '''Promises''' [https://www.magicsplat.com/blog/promises-by-example/index.html] and tasks were created using his book '''The Tcl Programming Language'''. The example computes the number of digits in 4 large fibonacci numbers using the tcl math library.

First we present a standard '''sequential''' approach which took 4.8 seconds followed by a Tasks version that took 1.6 seconds (timing code omitted).

======tcl
    proc fibsize {num} {
        package require math
        return "$num size -> [string length [math::fibonacci $num]]"
    }
    set n -1
    foreach num {100000 100100 100200 100300} {
        set answer([incr n]) [fibsize $num]
    }
    parray answer
    
#   answer(0) = 100000 size -> 20899
#   answer(1) = 100100 size -> 20920
#   answer(2) = 100200 size -> 20941
#   answer(3) = 100300 size -> 20962
#   Time = 4.869001 seconds
======

Next we transform the sequential version into a '''multi-threaded''' program by using tasks. We replace '''proc''' with '''Tproc''' without any changes to the procedure name, args, or body. Tproc creates the same proc and also a group of tasks that each import the proc. 

The procedure '''tgroup''' is then used to feed the tasks the same 4 numbers to process concurrently. The results are saved in an array (global or namespaced) variable of the same name as the Tproc.

======tcl
    namespace import tasks::* 
    Tproc fibsize {num} {
        package require math
        return "$num size -> [string length [math::fibonacci $num]]"
    }
    tgroup fibsize -run 100000 100100 100200 100300
    parray fibsize rvar*
 
#   fibsize(rvar,0) = 100000 size -> 20899
#   fibsize(rvar,1) = 100100 size -> 20920
#   fibsize(rvar,2) = 100200 size -> 20941
#   fibsize(rvar,3) = 100300 size -> 20962
#   Time = 1.607991 seconds
======

To see how this is accomplished expand the discussions below.

There are several youtube videos, which begin with: intro to tcl tasks: [https://youtu.be/wsz_xx4PXJI]

A video with some tips and tricks for using tasks can be found here: [https://youtu.be/Kjtt6xAs-zY]

Some details on using the Task and tgroup commands:  [https://youtu.be/V9-uxBx6ltQ]

The producer/consumer example from below is shown running on a linux system along with the Task Monitor and Send Command tools, with a complete code walk-through: [https://youtu.be/v5ElNemrBz8]

<<discussion>>Tasks Introduction
**** '''Introduction to Tcl Tasks''' ****

Tasks are a compatible extension to tcl threads that provide a middle ground between full processes and Tcl Threads.  Tasks comprise 5 primitives and 2 meta-procedures. They present a familiar call/return model using standard arglists with a client/server capability. The primitives plus some debugging procedures can be used alone or with the high level procedures to build and run task groups.  

Tasks can call other tasks similarly to calling a local procedure and can do so '''synchronously '''or '''asynchronously '''. The following is a description of the 5 primitives used by the 2 group building commands '''Tproc''' and '''tgroup''' shown in the first section.

   * Task's 5 Primitives

===tcl
    '''Task''' taskname ?options? ?list of imports? {
         '''twait''' -> varname1 varname2 ...   
         # do something with the args $varname1 $varname2 ...
         '''treturn''' result
    }


    '''tcall''' $taskname ?-async? returnvar <- arg1 arg2 ...
    '''tvwait''' returnvar
===

   * Creating Tasks 

A task is a tcl thread created using the '''Task''' proc, as shown above. The '''taskname''' is the name of a (global or namespace) variable assigned the thread id and also used for creating some tsv shared variables. There are several options, and any needed proc's defined in the program can be easily imported into the thread's interpreter with the optional import list arg. 

The last arg to the Task proc is the '''script'''. Task creates a new thread, supplements the script with error catchers and options for a while loop,  proc imports, and initializers plus some global control variables and starts the task running. The script will typically begin with a '''twait''' call that returns with a job and it's arglist. '''treturn''' sends a result back to the client caller. This is normally repeated in a forever loop to mimic a procedure call or a server request.

   * Calling Tasks 

On the other side of the transaction, the procedure '''tcall''' sends an arglist to a task, If it was called with the option '''-async''' one can then wait with '''tvwait''' until the '''returnvar''' is set. Without -async, it will synchronously wait for returnvar to receive a result and also returns its value as the command result. 

   * Multi-Tasking with Job Queues

Tasks manage their own job queues and when several feed off the same queue, jobs run concurrently. With the task grouping utility '''tgroup''', submitting a set of parallel jobs to run on a multi-core processor, is like calling a procedure with multiple arglists. The queues are distinct from the event loop queue, while remaining compatitible with it's usage.


   * Meta-tasking

Programs can be built using the 5 primitives alone, and/or can use the higher level procedures Tproc and tgroup which build and manage jobs for one or more tasks. 

Tproc defines a procedure that is also loaded into N tasks that work in a group. Then tgroup is used to feed jobs to the group's shared queue that can run in parallel on a multi-core system. Using '''Tproc''' one can transform a standard tcl proc into a Task group by simply adding a '''T''' in front of '''proc'''. 

<<enddiscussion>>

<<discussion>>Details


**** '''Task Details''' ****

   * Tasks vs. Procedures 

A Task resembles a procedure, however, '''treturn''' does not end the task and return like a procedure. It returns a result to the caller task (or main) and the code continues on with any statement following the treturn. It might loop back to another twait (the default choice), or go into some other loop or just straight line code. Each twait call can have a different number and type of arguments, handy for task initialization followed by a work loop. 

   * Tasks by default are enclosed in a forever loop

By default, the script is enclosed in a while 1 loop unless the '''-once''' option to the Task command is used. Then the task will exit if it reaches the end of the script. If the -once is not specified, then a '''break '''can be used to exit the Task supplied forever loop, and a thread exit will occur. There is no added thread::wait since the thread script is not empty. 

This loop allows a script to function like a called proc, but one that runs concurrently rather than using a call stack. At minimum, it can free up the main thread to keep a GUI responsive. It can also function as a client/server model with a shared job queue. In contrast to events, a task only works on jobs when it is ready to do so and has finished a previous job. 

   * Tasks work with arglists lassign'ed to variables

Inside the script for a task, one uses the '''twait''' and '''treturn''' commands, to wait for a job (an arglist) and return a result. twait also can optionally do an lassign of the args to a list of variables.

'''Note:''' the '''->''' used in the twait call above is actually a variable name. The -> variable (being the first arg) receives the full arglist (like the special variable args to a proc).  This extra visual cue is optional, and is often used when the full arglist is not needed, but a placeholder variable is required.  This variable can be named as desired; argv or args is also a good choice.

   * Task queues

Callers send arglists, which are saved in a sharable queue until the Task attempts to retrieve a job using twait. If the queue is shared with other tasks, then whichever task can get to the queue first, will get the next request. If nothing is queued, the task(s) will block until a job request arrives (but tasks use a timer to re-enter the event loop every 50 ms (the default) while waiting for an arglist to be queued by a '''tcall''' command).

A task can have its first twait accept an arglist with initialization data, and then drop into a loop calling twait/treturn for a different set of args to receive for the subsequent job requests. See the producer / consumer example that uses this technique.

   * Synchronous and Asynchronous calls

'''Synchronous calls''' use '''tcall''' to mimic a procedure call, but the procedure in this case is running concurrently in its own thread. This returns, with a value, after the task issues it's treturn statement.

===tcl

    '''tcall''' $taskname resultvar  <- arg1 arg2 ... ;# returns the resultvar value as the command result 

===
'''Asynchronous calls''' also use '''tcall''' to mimic a concurrent procedure call, that runs in it's own thread, but can do other things before waiting on a result. For example, this allows one to fire off multiple -async calls that run concurrently, and then wait for all to complete. 
===tcl

    '''tcall''' $taskname -async resultvar  <- arg1 arg2 ... 
# ... do something else ...
    '''tvwait''' resultvar 
   
===
'''tcall''' sends an arglist to a task by using the contents of taskname, which contains the thread id (set by Task). tcall requires a variable name to receive a result which is the signal back to the caller that the job is done. tcall returns the value of the resultvar when called sync.

For consistency with thread::send, the option -async may be specified before the $taskname arg, i.e. 

tcall '''-async''' $taskname ... 

If the taskname is not a valid thread id, an error is thrown.

'''tvwait''' does a vwait on the resultvar, (but only) if it doesn't yet exist (tcall unsets it). This is necessary to avoid a race condition if some code uses vwait or update and enters the event loop.

Some versions of the http package use a vwait which is an example of where the event loop might be entered without the programmer being aware, and so the unset/vwait approach is needed to avoid a possible race condition.

tvwait can also be used in place of a vwait if the user program unsets a variable first. The producer / consumer example does just this, since that code uses '''after''' and '''vwait''' to simulate production time.

 

                                                   - - -

<<enddiscussion>>



<<discussion>>Features
**** '''Tasks are easy to add to a program''' ****

Tasks are programmed in pure TCL code. No other packages are required other than Threads and Tk. They are currently just a code block that can be included in a program or placed in a file and sourced. 

Note: the tasks code needs to reside in the main thread. In order to use the windows console for output, the main thread id must be known, and the code source assumes it is being run in the main thread.

----

**** '''Tasks vs. tcl threads''' ****


Tasks differ from simply using thread::create and thread::send (or tpool) in several ways. 

   * Tasks use a share-able queuing method

Tasks implement a work queue using mutexes and condition variables. These are easy to synchronize and share across several threads (tasks). By having several tasks share the same queue, it is easy to provide single-queue multiple-server functionality where jobs can run in parallel on a multi-core processor. 

To get this functionality with the Threads package, one can use the threadpool (tpool) package, which requires more steps than tasks. Tpool uses job id's whereas Tasks keep track of jobs automatically. Tasks can incorporate traces which can be used to get notifications when jobs are done without having to wait and keep track of job ids. Tasks automatically save result values in an array rather than requiring calls to tpool::get to retreive the results. However, tpool does provide a job queue, similar to tasks.

   * Each task is called with an argument list

Rather than always receiving a snippet of tcl code, tasks use the more familiar method of passing data in an arglist, that all procs, methods, commands, and processes (argc/argv) use for their inputs. Tpool jobs use the standard tcl thread method of passing in a script which is more complex than simply using arglists. Tasks can more easily mimic procedure calls and using Tproc can convert any existing procs into task groups with ease.

   * Tasks are sequential code

Event driven programs are usually more complex to understand than code which uses a more conventional sequential model. Tasks are designed to do simple, but sometimes cpu intensive jobs rather than an interactive gui, which is best done with events. However, thread::send can still be used and if the task is waiting for work, it can receive a command.

   * Tasks include proc importing

When a task starts up, it can import into its interpreter procedures (either global or in a namespace) from the calling task (or the main thread). This makes it easy to initialize a Task with all the code it needs to do simple jobs. The main thread can do the bulk of the program calling on a few tasks running in parallel to do some processing that can utilize modern multi-core cpus.


----
**** '''Tasks can process one job or loop back for more work ''' ****

After processing an arglist and returning a value, the task can then simply exit, or remain running in a loop waiting for the next arglist to process, similar to a client/server arrangement. 

By default, a loop surrounds the script, unless the '''-once''' option is specified in the Task command. Each task has a queue, so pending asynchronous calls will be queued fifo in an orderly fashion.
----
**** '''Helper tasks are simple to add''' **** 

One or more tasks can be '''helpers''', (with the same or different scripts) and will all share the main task's queue implementing a '''single queue multiple server''' organization. This is a key feature of Tasks. Callers can be from the main thread or any task (except itself). 

Adding helpers is quite easy. Helper tasks are created with a simple taskname convention of '''worker/boss''' as shown below. All jobs are sent to the boss task.


======
    Task boss ... $script
    Task worker1/boss ... $script
    Task worker2/boss ... $script
    ...

    tcall $boss ....
======

Caller's job requests are fanned out fifo from the (boss) queue to the boss and helper workers and any waiting task in the group can grab a job from the queue with twait. Caller requests can load up the shared queue without limit. See the example web request below that fires off 200 requests for 10 tasks.

Here's a program that will create 4 tasks for 5 jobs. Note: the task name is available to each task using the global variable '''t_name''', created by the Task command. 

Because the computation takes a second or two, 4 will be run concurrently, and which ever one finishes first will snag the 5th one which was waiting in the job queue of tBoss. Due to scheduling of threads, there's no guarantee of which task that will be. Each task returns a list of 2 items, a text message and the result of the computation.



======
    namespace import tasks::*
    set script {
        package require math
        twait   ->  i  number
        treturn  [list                                          \
                   "$i courtesy of $::t_name : $number"         \
                   [string length [math::fibonacci $number]]    \
                 ]
    }
    set jobs {100 200 300 400 500}

    foreach   taskname {tBoss help1/tBoss help2/tBoss help3/tBoss } {
        Task $taskname  -import  $script      ;# create the 4 tasks
    }
    foreach i $jobs {                         ;# run the 5 jobs
        tcall $tBoss -async   rvar($i)   <-  $i  [expr { $i + 100000 }]
    }
    foreach i $jobs {tvwait rvar($i)}         ;# wait for all jobs
    
    parray rvar

#   
#   Each run could assign different tasks to each job, here's 2 results
#   Since there are only 4 tasks for 5 jobs, someone has to do 2 jobs:
#   
#    
#   rvar(100) = {100 courtesy of help1 : 100100} 20920
#   rvar(200) = {200 courtesy of tBoss : 100200} 20941
#   rvar(300) = {300 courtesy of help2 : 100300} 20962
#   rvar(400) = {400 courtesy of help3 : 100400} 20983
#   rvar(500) = {500 courtesy of help1 : 100500} 21003
#   
#   rvar(100) = {100 courtesy of help1 : 100100} 20920
#   rvar(200) = {200 courtesy of help2 : 100200} 20941
#   rvar(300) = {300 courtesy of tBoss : 100300} 20962
#   rvar(400) = {400 courtesy of help3 : 100400} 20983
#   rvar(500) = {500 courtesy of tBoss : 100500} 21003
    

======
----
**** '''Tasks are compatible with other Thread functions and the event queue''' ****

   * tsv, mutexes, and conditional variables 

The tsv shared variables are easily incorporated. Mutexes and conditional variables can also be used. Also a thread::send or thread::cancel can still be used. The taskid used in tcall is just the thread id. 

During the wait for work, the event queue is checked every 50 ms  by doing an '''update''', so any pending events, such as a thread::send or updating of any gui widgets will have time to be serviced. 50 ms is the default, configurable with the global ::t_twait_timeout as mentioned in the task environment section.

   * Communicating Tasks 

Tasks are a framework within which a program can run several concurrent threads. If these task threads communicate with one another, the programmer will still need to insure that deadlock or starvation does not occur. If a task does only functional code, i.e. does not use resources that other tasks might be using (other than the shared job queues used with helper tasks) then provided a task does not try to recursively call itself, there should not be any deadlocks. 

When several tasks share a job queue, there is no method to insure that all tasks are assigned work. It depends on the system's thread scheduler and the number of parallel cores/threads in the cpu. Typically, helper tasks use the same script, so it shouldn't matter which task works on which jobs in the queue. 
 
----
**** '''Tasks include puts like debugging and an error handler''' ****

Tasks comes with utility procedures for debugging such as a puts like statement that can create a Tk text widget (one per task) and a built in error catcher that will display a tk_messageBox.  

Note, due to a Tk bug on linux, putz will '''not''' create Tk windows, but rather will output to stdout using puts, but with the taskname prepended. This mode can also be used on windows to output to the console if desired.

                                                        - - -

<<enddiscussion>>
----
**** '''Task Procedures''' ****

<<discussion>>The 5 primitive Task commands
----
**** Create a Task ****
 
   * '''Task  taskname  ?-once? ?-import_tasks? ?-min_import_tasks? ?import list? script '''

'''taskname''' is the name of a variable that will be assigned the thread id (also called the task id). It is also the name used for some tsv shared variables that the Task system uses internally. 

This taskname can also be '''namespace qualified''', e.g. ns::taskname, where a prior namespace eval ns {...} was used in the program.

Note: the taskname is created at global scope unless an explicit namespace is used.

   * '''Helper Tasks''' 

The taskname can also be a pair of names separated by a slash (e.g. helper1/main). The first name will be used for the taskname, and the second one is the name of a previously created task whose job queue will be shared, instead of creating another one for the new task. See the discussion above in the features section under helper tasks. The tasknames can also be array elements. See below in the small example discussion. Helper task names have the same local/global rule as mentioned in the previous section.

   * '''Task options''' 

The '''-once''' option suppresses the forever while loop normally around the script.

The '''-import_tasks''' option is a shorthand way to add a namespace import tasks::* at the right place in the script imported into the thread. This option can be abreviated to '''-import'''.

The '''-min_import_tasks''' option can be used to limit the tasks procedures imported to the thread to only '''twait''' and '''treturn'''. Others, such as '''putz''' can still be imported as described in the next section.

   * '''Importing Procedures'''

The '''import list''' is a list of proc's that can be imported into the task's interpreter. Each list element can be a pattern as described in the [[info procs]] command. This can include a namspace qualifier, e.g. starkit::* which would include all the procs from the starkit namespace. When an item includes a namespace, that namespace is eval'd e.g. ''namespace eval starkit {namespace export *}'' which will define the namespace and also export all the procs defined in that namespace (even if they haven't yet been defined).

   * '''Initialization Code'''

Additionally, each item in the import list can be of the form {-tcl command} where the - is removed and the remaining item is inserted as a command at the point of the imported procedures. These commands are inserted before the script (and not inside the added forever loop), but after all the tasks::* procedures. The order of insertion is left to right. For example, suppose you need to include a package command (plus assorted other procs and inits), but don't want to place it inside the added forever loop :

Task taskname -import_tasks [[list {-package require math} mystuff::* someproc -$bigscript]] $script

An alternative is to provide one's own loop as shown in the next section.

   * '''Task Script''' 

The '''script''' can be supplied in braces or with a $script variable, depending on preference. A variable is normally used with helper tasks when each uses the same script. 

The script is situated at global level in a new thread in a new interpreter. Any simple (non-namespace, or proc/method local) variables in the script are global. While tasks are here often shown as simply twait/treturn pairs at the top and bottom of a task's script to mimic a procedure, that structure is not required.

For example, a task script can include proc's, TCLOO code, namespaces etc, and can specify -once.  Tasks are usually sequential code, and not event driven and so it is often beneficial to choose a structure like this:

===tcl
Task mytask -once -import_tasks ?import list? {
    package require something
    proc test {arg1 arg2 args} {
        # test something
    }

    set someglobal "some init value"

    # some TCLOO code perhaps

    while 1 {
        twait args
            # do a job
        treturn "some result"
    }
}
===

Another layout is presented in the producer/consumer example below, where 2 pairs of twait/treturn are used, one for initialization, and then a looped pair for job requests. 

   * '''Event driven Tasks''' 

A task can be event driven like a standard thread script and just make use of the Task framework to import procedures, use the debugging '''putz''' proc, and the error catching code. It can even use twait and treturn before using '''thread::wait''' to go into the thread event loop and wait for '''thread::send''' calls.

The following example imports the '''Time''' proc and defines an event triggered proc '''callback'''. While this is not much different than simply using thread::create and thread::send it does demonstrate that tasks are quite compatible with the threads package and can be used in many ways, such as this hybrid example which uses a single twait to get some init data, and also makes use of the debugging putz proc.

======
    namespace import tasks::*
    proc Time {} {                        ;# a timestamp with 3 digit ms resolution
        set ms [clock milliseconds]
        set secs [expr {   $ms / 1000   }]
        set ms [string range $ms end-2 end]
        return [string range [clock format $secs] 11 18].$ms
    }
    Task evt -import_tasks -once {Time} {
        proc callback {args} {             ;# a proc to call as an event
            putz "[Time] inside callback with args = |$args|"
            return "send back args = |$args|"
        }
        set t_debug 2                     ;# on windows, putz goes to console, stdout on linux
        twait -> init1 init2              ;# get some args (optional)
        putz "[Time] twait received: init1= |$init1| init2= |$init2| "
        
        thread::wait                      ;# now becomes an event driven task
    }
    tcall $evt -async {} one two          ;# send args with -async task call use a {} for unneeded result variable
    
    wait 2000
    thread::send -async $evt [list callback three four five]   ;# use standard thread::send -async
    wait 1000
    set out [thread::send $evt [list callback 3 4 5]]          ;# not -async, so returns a value
    wait 500
    puts "[Time ] out= |$out| "

# output:    
#   evt        ! 09:51:33.656 twait received: init1= |one| init2= |two| 
#   evt        ! 09:51:35.656 inside callback with args = |three four five|
#   evt        ! 09:51:36.656 inside callback with args = |3 4 5|
#   09:51:37.157 out= |send back args = |3 4 5|| 

======

   * '''Tasks can function like monitors''' 

If a task (or any thread) calls thread::wait and event code re-enters the event loop (e.g. with vwait or update) then pending events can be delivered before the previous ones have completed. 

When using twait/treturn and no thread::send calls, one can use sequential code that includes vwait delays and/or update calls and the task will not be interrupted. Each tcall (whether -async or not) will run strictly fifo. Thus Tasks operate like a '''monitor''' and can be used for synchronization where that method is desired. 

The buffer task in the producer / consumer example below can include sequential delays (calling on the wait procedure that uses vwait or be paused by a GUI checkbox) and not be interrupted and re-entered which could cause data corruption.

   * '''Reviewing the generated Script''' 

Tasks add some additional code even when -once is used, in particular there are 2 catches around the script. It is advisable to use the following command from a terminal to output the actual script that is generated, say for task mytask from above:

===tcl
puts [[tset mytask script]]
===


   * '''task environment''' 

Task defines several global variables inside the task's thread interpreter. 

    t_pid              the thread id that created the task, this need not be the caller's id
    t_name             the tasks's task name
    t_debug            this controls putz output, see the comments before the putz proc code
    t_debug_contents   this controls debug output of the queue contents, default is end (for lrange 0 end) -1 = none, 0 = just 1, ...
    t_twait_timeout    this controls how often twait does an update while waiting, in ms default=50

There are 2 checkboxes on the Tk putz window which have 2 globals.

    t_putz_output       a toggle to turn putz output on/off
    t_task_pause        a toggle to pause the task, see tpause_check


The Task system uses 3 tsv shared variables:

    main                Stores the thread id of the main thread
    tvar                all the shared variables about a task
    tids                all the task ids with their task names

Each task saves it's state in the shared tsv variable '''tvar'''. There are 12 elements that are comprised of '''taskname,variable''' for each task. These can be examined using the '''tdump''' procedure. 

===
  taskname,cond           the conditional variable handle
          ,count          count of times that twait returned a job 
          ,error          the text of a caught error 
          ,gvar           the global return variable name
          ,mutex          the mutex handle
          ,pid            the parent thread id, of the caller note: not always = t_pid 
          ,queue          the job queue 
          ,result         the result of the last treturn
          ,script         the modified actual script being used by the task
          ,share          the name of the task that is the main task in a shared group (or null) 
          ,tid            the thread id of this task 
          ,user           a user available item which has no current use 
===

    
   * '''task caller id''' 

The id of the caller of a task is saved in a tsv shared variable. To access that, '''after''' a twait call, one can use the following:

    set caller_id [tset $::t_name pid]

   * '''task exit or error''' 

When a task exits, either from an error or by design, the task shared variables are not removed and can be examined using the '''tdump''' command. In some cases, an error might not be reported but it's text might be found in the tsv shared variable name,error which can be viewed using the tdump or tset commands. 

A possible future enhancement is to provide a way to clean up and create the same task again, however, currently only an error will be generated if the same task name is used more than once in another Task command. 

'''Task''' returns the newly created task's thread id (taskid). 
----   
**** Call a Task and Wait till Done ****

   * '''tcall $taskname ?-async? rGlobal ?<-? ?arg ...?'''                    

   * '''tvwait rGlobal ?taskid?''' 

'''tcall''' sends a message to the task id specified by the contents of $taskname and uses the provided rGlobal variable name to set on completion and also provides an argument list. rGlobal can also be an array element, e.g. rGlobal($element), and optionally include a namespace qualifier. tcall will add :: in front of rGlobal if not specified in the tcall.

tcall optionally allows, as a visual cue, a text string beginning with '''<-''' (e.g. <---- is also ok). If present, the argument is ignored. For example,

tcall $test -async rvar <-- 1 2 3

If the first argument might need to send a text string beginning with <- then this usage would become required. 

tcall returns the result when called synchronously (i.e. no -async) and a 1 if -async. If the $taskname argument does not contain a valid thread id, an error will be thrown.

For consistency with thread::send, the option -async may be specified before the $taskname arg, i.e. 

tcall '''-async''' $taskname ... 


'''tvwait''' will wait for the completion of the tcall job and receive the return value. If the optional '''taskid''' is used, then tvwait will also verify that the task is still running (exists) to avoid waiting forever. 

A tvwait is not required, there is no limit to the size of the input queue. In some cases, it can be useful to never tvwait, and do all -async tcall's. 

For example, tasks are being used in a remote control program for a streaming device that requires delays, or commands will be dropped. It is much easier to code sequentially using send and wait calls in sequence than to use event callbacks. The job queue is used to buffer up requests until they can be serviced. 

These 2 procedures can be used from the main thread or any task. Note: Tasks are not re-entrant, and so should not call themselves recursively. Tasks use only a single set of tsv shared variables to save the rGlobal name and the arglist, and they are not stacked, like with a recursive proc.



----
**** Wait for a Call and Return a Value ****

   * '''twait ?argv? ?varname1 varname2 ..?''' 
   * '''treturn  result''' 

This pair is used inside of a task and is analogous to a procedure's arglist and return value. However, unlike a procedure, treturn does not end the task nor pop a stack frame. Instead, this pair is normally (and by default) processed in a forever loop. But that is optional, and a task can have code that follows a treturn. See the producer / consumer example which has 2 sets of twait/treturn statements, where the first pair is to get initialization data, and the second pair are looped to retrieve job requests.

'''twait''' waits for work to do and gets the job arglist. It can then optionally lassign argv (the arglist) to the variables varname1 varname2 ...

If the argv value is not needed, it is sometimes set to '''->''' for visibility purposes. For example,

twait -> x y z

which would set the variable '''->''' to all the arguments (like args in a proc) and then lassign them to the arguments x, y, and z. The full args are still available in the variable -> if needed. This usage is optional, and any other variable name can be substituted for the -> such as args or argv. 

A task can issue a thread::send to itself (or receive one from another task) which will cause an event. However, events in a task (or any tcl thread) work the same as in a single threaded program, and must enter the event loop at some point to be serviced. twait does this every 50 ms while waiting for job requests. The 50 ms is the default, see the global '''t_twait_timeout''' in the Task environment section to change it.

'''treturn''' signals the caller and returns a result. If the caller is waiting with a tvwait, it will resume. A treturn is not required unless the tcall-er is going to tvwait for a result.  
----
                                              - - -
<<enddiscussion>>

<<discussion>>Tproc and tgroup
----
****  Meta-commands ****

   * '''tgroup name  ?-option? '''  
   
This is a task builder which can create a group of tasks sharing the same queue. See the discussion below and also in the comments before that proc in the code for more information. There are examples below in a discussion. Here is a summary of the tgroup sub-commands, with a more detailed discussion in the examples section.

===

     tgroup groupname '''-tasks''' ?-?N  ?task options? ?list of imports? script (same options as the Task command)

     tgroup groupname '''-call'''    {arglist 1} {arglist 2} ... (only 1 of these per -wait)
     tgroup groupname '''-foreach''' {arglist 1} {arglist 2} ... (can be repeated followed by a -wait )

     tgroup groupname '''-wait''' all 
   
     tgroup groupname '''-run'''  {arglist 1} {arglist 2} ...    (does a -reset, -foreach, -wait all)

     tgroup groupname '''-reset'''                               (reset indices to 0, clears old args and results from group array)

     groupname(rvar,*)                                     (this is the result variables for each job)  
     groupname(args,*)                                     (this is the arglists for each job)  
===
The '''-tasks''' option is used only once to create the tasks. Afterwards, multiple calls with  -call, -foreach, and -run can be used. However, these should not be mixed. Each is somewhat different. If N is negative, then abs(N) tasks are still created, but a trace is put on each result.

The '''-call''' must be followed by a '''-wait''', and before another -call/-wait pair is used, a '''-reset''' is required. The -call will repeat the arglists if there are fewer than the number of tasks, and throws an error if there are more. 

The -call is most useful when only 1 arg is provided. It will then try to call each task in the group passing in that same arg. A task can use it's task name ($t_name) to determine which one it is, if desired. The task names will be name0, name1, ... name(n-1) so the number can be easily extracted using string range or a regexp command. Note: This is not perfect. If the call to a task is done extremely quickly, then it is possible for some task to finish up and get to the queue again before another task can which might not have been able to do any work at all. There needs to be some starvation checks, but they don't exist yet. It also depends on how many cores and the thread scheduler as well. This is a work in progress option.

The '''-foreach''' can be followed by more -foreach calls, and will continue to increment the index, and so the results will accumulate, even if a -wait all is issued. After a -reset further -foreach calls will begin over at index 0 and prior results are cleared.

A '''-run''' does a -reset, -foreach, and a -wait all in sequence. So, subsequent -run calls will all use indices 0...N-1 for the number of arglists in the -run.

'''Traces''' are optional by using a negative value for -tasks. Note that trace callbacks occur as the results become available, without the need to do a -wait all. Each trace will be a write variable trace that calls a procedure named the same as the groupname, and is delivered with 3 values, the name of the array, the element of the array, and an operation of write. To retrieve the value inside a trace callback, one does this:

===
proc groupname {aname element operation} { ;# uses groupname as the trace proc to call with 3 args
    set value [[set ${aname}($element)]]
}
===
Note the required braces for '''${aname}''' here.    

The '''results''' are stored in an array of the same name as the tgroup name (which is global or an explicit namespace can be specified). The arglists are also available in the array, plus some bookkeeping used by tgroup.

The '''-wait all''' tests the resultant variables for being set with their values. If (some or all) values are already set, there will be no waiting for those values, only with the values not yet set (knowable because the variables were unset before being queued to a task). Values are set by event callbacks as the called task issues a '''treturn''' back to the caller task/thread.

The -wait all does not do a -reset. It can be used multiple times with some additional -foreach sub-commands. It will wait for all current jobs to be finished, then more jobs can be added, and another -wait all can be done to wait for the new batch to be done. For example, this code will process a total of 1000 jobs, but after 10 are queued, it will wait till they finish, and then it will wait 10 seconds before queing up the next 10 jobs. Finally, after the loop is done, it will wait for all to finish.


===tcl
    for {set m 0} {$m < 1000 } {incr m} {
        tgroup  sum_task -foreach [[list 100  $m ]]
        if { $m % 10  == 0} {
            tgroup  sum_task -wait all
            wait 10000
        }
    }
    tgroup  sum_task -wait all
===

----

   * '''Tproc name args body ?-options? '''  
   
This transforms a regular proc to a set of tasks that share a queue. It uses '''tgroup''' to create the tasks and the options are the same as for Task (but no script at the end). This also creates a regular proc using the name, args, and body of a proc. 

The first 2 args after the body default to -tasks 4. To add additional options, the -tasks N must be first specified explicitly. After a Tproc is created, one can use the tgroup commands such as -run, -foreach, and -wait the same as if a tgroup -tasks command had been issued (because Tproc does just that).

Tproc first creates a proc using the name, args, and body of the procedure by calling '''proc'''. It then uses the tgroup command to create N tasks that each import the proc and create a thread script (normally in a loop) that looks like the following,

===
    twait argv
    treturn [['''name''' {*}$argv]]
===

The options -once, -import_tasks, and -min_import_tasks are allowed here. If these are specified, then -task N must be explicit and occur first. All of these 3 options are sent to the tgroup -tasks command, with '''name''' replaced by the Tproc name. 

This method passes along any arglist to the actual proc which will test that the number of arguments agree, supporting any required or default arguments and the special argument args. If there is an error, it will be caught and reported in a message box just as any proc.

   * Tproc creates a proc and N tasks  

A Tproc creates both a local proc and a tgroup of tasks. The local proc is called the same as any proc; the task group is called using tgroup. When the group is called, any of the main or helper tasks that are not busy can service the request.

A Tproc group can also be called using '''tcall''' by using the $name0 variable, where '''name''' is used to create a group of tasks (as described in tgroup). For example, below are both methods for calling a Tproc, 

   * Using the Tproc generated code  

======
Tproc test {arg1 arg2 {arg3 100}} {
    set value ...
    return $value
} -tasks 2

##################### using tcall ###########################

# a sync call is just an -async and a tvwait in one statement

tcall $test0 rvalue <-  one two                  ;#arg3 will default to 100

# or call async with unique (a requirement) return value variables 

tcall $test0 -async rvalue1 <-  one two 
tcall $test0 -async rvalue2 <-  three four 200

# do something as the 2 run, then wait for both to finish

tvwait rvalue1
tvwait rvalue2

##################### using tgroup ##########################

# using tgroup and -run, both the above can be specified in a single call with the 2 arglists:

tgroup test -run {one two} {three four 200}     ;# does a -reset, then runs both -async, then a -wait all 

# tgroup stores the results in an array of the same name as the Tproc, and can be listed:

parray test rvar,*                              ;# * will be 0..n-1 for N jobs

# one can also use tgroup -foreach to run one at at time -async (e.g. see the web extract example)

tgroup test -foreach {one two}
tgroup test -foreach {three four 200}
tgroup test -wait all

# note that -foreach can also have more than one arglist, in any combination

tgroup test -foreach {one two} {three four 200}
tgroup test -foreach {five six}
tgroup test -wait all                           ;# waits for all 3

# a tgroup -reset can be used to do another set of -foreach (the results will start over at index rvar,0)
 
======

Tproc uses tgroup, which creates a group of tasks, named test0, test1, ... testN-1 for N tasks (as specified in -tasks N with tgroup). test0 is the main task, with test1 - N-1 as helper tasks all sharing the test0 queue. Note, these N test variables are global, or can specify a specific namespace.

A common error using tcall is to forget to use the zero'th name here, $test0 and instead use $test. This will cause an error referring to $test with the message that test is an array.  This is because tgroup uses the name (without a number) to save state information.
<<enddiscussion>>

<<discussion>>Utilities         

****  Utilities ****

   * '''putz "text" ?color? ''' 

On windows, this will create a Tk window for debug output, one per Task. There are several buttons and checkboxes, for turning on/off the output, clearing the text, and pausing the task. The large button is also a quick exit of the program along with some Task info.

See the tag's in the code for the current set of colors. Add additional ones for your own use. Color and/or font changes, as well as foreground/background colors can be specified.

On Linux, this will go to stdout using a puts. If called from the main thread, this will also translate to a puts call. 

The t_debug global variable controls putz output with an option for a debug trace. It can have 7 values,

===
-1 = no putz output
0  = no debug trace (default is 0x0)
1  = debug trace
2  = no debug trace, no tk windows, on linux, uses puts, on windows, write to console (in main thread)
3  = same as 2, but with a debug trace
4  = same as 0, and overides linux forcing and permits tk window (n.b. this can cause tcl/tk to crash)
5  = same as 1, and overides linux forcing (ditto)
===    

When the platform is not windows, a value of 0 or 1 is changed to 2 and 3 respectively. On windows, if set to 2 or 3, it will go to the console, and if the color is red (or anything except normal) then a puts to stderr is used (console stderr writes are red on windows). A value of 4 or 5 overides this forcing to use puts instead of using a tk window. Until this is fixed, tcl/tk can crash if more than one thread tries to use Tk. '''This should only be used during debugging (on linux).'''

When doing a trace, the queue contents are shown which can be quite large, there is another global, '''t_debug_contents''' which can be used to limit the output. It's value is used as the '''to''' arg to an lrange, with default of end. A value of -1 will suppress the contents totally, and other values, e.g. 3, can be used to limit the output to 4 pending queue items.

With 1.10, putz creates a toplevel window instead of using . so user programs can use the normal . toplevel. This means the . window will be created as well, and so if t_debug is hex (i.e. begins with 0x) then the . window will be withdrawn. To overide that, a value of 0..5 can be used. Note putz can detect if it is, say, 0x0 vs. 0 by using string operations. Admittably, this is ugly, but it saves using another global. 

Colors can also be added by using tag configure commands from the task. NOTE: putz must be run at least 1 time first, and t_debug must be either 0 or 1. After this, there will be a putz toplevel window .taskdebug.ttttt which can be modified. For example:

======
set color_tag { # this will be imported AFTER the first putz in the import list below
    .taskdebug.ttttt tag configure lblue  -foreground black -background LightBlue -font {Arial 14}
}
Tproc test {arg1 arg2} {
    putz "arg1= |$arg1| arg2= |$arg2| " lblue
    return "args were $arg1 and $arg2"

} -tasks 1 -import_tasks [list {-putz ""} -$color_tag]

tgroup test -run {one two} {three four}
======

   * '''tset taskname element ?val? '''

Set a Task shared variable value, or get it if no ?val?

   * '''tdump ?pat? ?max-width? '''   
 
Debug dump of shared variable data used by tasks. pat is an regex that defaults to .* and max width def=90. 

If the pattern starts with a -pat or +pat the - or + is removed, but then only the matched lines (i.e. not the extra task info) will be output.
 
If the pattern starts with a +pat there will be no putz output but instead, the command returns a list of 2 element lists where the 2 items are the shared variable element (e.g. task1,count) and it's value, with no maximum width. 

This can be used from the main, but also from a task since it uses putz for its output.

   * '''tname taskid '''  
             
taskid (which is the thread id also) will lookup and return the taskname.

   * '''tpause_check'''   
             
This is checked in twait, but can be used also by the task code. It checks for the '''t_task_pause''' global, which is initialized to 0, and does a non-busy wait for the global to change back to 0 after it has been set to 1, by clicking the checkbox widget to on, or setting the variable in the code. It is connected to the pause checkbox in the Tk window that putz creates. 

A task can use the initialization option in a tasks import list to set this to 1 (which changes the default of 0 set earlier) to start up a task paused. This can be done with an import list entry of: {-set ::t_task_pause 1}. Note that if t_debug is set to 2 or 3, (or running on linux) there will be no tk window with a checkbox to clear the pause. Only by a thread::send back to the task to change this to 0 would the task ever be able to resume.

This proc also issues a putz when the task is paused. If t_debug is 0 or 1 and running on windows, a tk window will open if not already.

----
****  Misc ****


   * '''comma number'''
                
comifies a positive integer, only used in testing

   * '''wait ms'''
                     
A non busy wait using vwait and a global variable.

   * '''xwait ms''' 
                   
A busy wait, for easily testing compute bound threads. The time is approximate.

   * '''tlg ?pattern? ?delimiter? ?max width?''' 
                   
This will dump global variables using putz. If there is an () output, then the variable is an array and the indices are output. Newlines are changed to unicode character. The delimiter can be unicode, e.g. \u250b for a tripple dot vertical line. The maximum width displayed defaults to 80. This can be sent to any task to dump its global variables. 

When a task starts, a global variable is set to the current list of globals from [[info global]]. When the tlg command is used with no arguments, then it will list '''only''' variables that are not in the list. To list all variables, one can specify the argument pattern as a *. 

Note: since each task resides in a separate thread and thus separate interpreter, global variables in a task are '''not''' global to the entire program. Any global variables in a task are not visible to the main thread or other tasks.


   * '''tla array_name ?pattern? ?reverse?''' 

This is similar to parray, but uses putz to dump it's output. The reverse arg can be -1,0,1. A 0 is the default. If -1 or 1 the pattern is used against the '''value''' instead of the index. For 1 it lists matches and -1 it lists those that do not match.  Pattern is a string match glob style pattern.
 

   * '''twidgets''' 

This is a widget tree display tool for a task. It requires BWidgets. It has 3 buttons. Open, Close, Refresh. Open will expand all the tree levels, and close reverses that. Refresh makes it restart itself, in case some new widgets have been created since it was started. It can be run in any task, to give a look at the widgets there. It can be closed and re-run again later. 

Clicking on any widget item will use putz to output a 2 column list of all the configure attributes.

This can also be used in the main thread as well, but requires a value for t_debug be set first. To use in the main: set ::t_debug 0 ; twidgets.
 
                                                    - - -

<<enddiscussion>>

<<discussion>>Task Monitor and Send Commands
****  Task Monitor  ****

   * '''task_monitor ?table-rows? ?font-size? ?repos-rows? ?putz-window?'''

This starts the task monitor in a separate thread and toplevel window. All the arguments are optional. Use {} for any to use defaults (if you need to specify later ones). 

+++
table-rows The initial number of rows to use in the task data table (expands as needed)
font-size The font size initially, can be adjusted at run time
repos-rows The maximum number of rows to use when repositioning putz windows
putz-window Monitor will also open a putz window if yes/true/1 etc. default is no
+++

The Task monitor is a separate task (thread) that one can run to bring up a window that presents a table format for the Tasks in the program. Here is a sample format of what it looks like:

%| Task | row | count |Q-len | rvar | share | result | error | caller | putz | user |%
| _taskmonitor | 1| 1|  | ::tasks::mon_start|  | {max rows: 10}|  | mainthread|  | args: 10 9|
| sum_task0| 2| 5| 7 | ::sum_task(rvar,19)|  | 119|  | mainthread|  | 100 19 |
| sum_task1| 3| 4|  | ::sum_task(rvar,20)| sum_task0 | 120|  | mainthread|  | 100 20|
| sum_task2| 4| 6|  | ::sum_task(rvar,21)|  sum_task0 | 117|  | mainthread|  | 100 17|

The column headers can be left or right mouse clicked to, respectively, narrow or widen columns. Shift clicking increases the adjustment by 5 times (e.g. 3 vs 15 chars wider/narrower per click). The scrollbars can be operated with the mousewheel for vertical scrolling, and with the shift-key for horizontal scrolling, if your version of tcl/tk supports that.

Above the data table are several controls. Each spinbox should respond to the mousewheel.
+++
Refresh [[ # ]] spinbox - time in seconds (steps of .5)
Font-size [[ # ]] spinbox - integers 6-20
+++ 

----
+++
X-width  [[ # ]] spinbox - for repositioning
Y-height  [[ # ]] spinbox - for repositioning
Reposition Button - Repostion all putz windows
+++

----
+++
On Button - set pause checkbox in putz windows
Off Button - clear pause checkbox in putz windows
Send Runs the send command task
Color [[ ]] checkbox - to briefly color changed values
On-Top [[ ]] checkbox - Monitor will stay on top of other windows
Pause [[ ]] checkbox - Monitor will not update while paused
Exit Button - Exits the program
+++

****  Debug Window Repositioning ****

   * '''repos ?WxH? ?rows? ?x-offset? ?y-offset?'''

This will find all the putz windows, and re-align and position them. If the first argument is given (only) then the number of rows will be chosen based on a presumed screen size of 1080p or greater. If the rows argument is given (and not null) then that will be the number of rows. The last two arguments can be used to provide a different spacing between windows.

The task monitor has a button to call repos and can supply width and height arguments from 2 spinboxes.

****  Send Command ****

   * '''send_command'''


This will open a small window (in its own task) with 2 text entry boxes, that makes it easy to send commands (using thread::send) to any (or all) task(s).

The first text entry is for the name of the task(s) to send a command to, which can be entered manually or using the Task menu. If manually entered, it can be a string match pattern and each matching task will be sent the same command. 

The second entry is the command to send. Both text boxes support up/down arrow (or mousewheel) for a history, and there are 3 additional buttons that can be used. The Send button is the same as doing a <return> followed by an <up> (in the send entry) and so can be used to send a command multiple times easily.

This entry also accepts <tab> for command and variable expansion, similar to the windows console,  and <escape> for bracketing completion for square bracekts, curly braces, and parens. <escape> will fill in one, and shift-escape fills in all. After filling, it will select the text between the bracket pairs. The F1 key can be used to extend the selection one character on both sides.

The send command window has 3 menu columns:

'''Task:''' includes the tasks names of all tasks (when the command first starts up). This fills in the taskname entry. If new tasks have started since the command was issued, this menu will refresh itself (it checks every 2 seconds for new tasks).

'''Commands:''' This will set the second entry to various commands. See the description of the '''tlg''' and '''tla''' commands. The '''widget tree''' command can be used to launch a widget display utility inside any task. This and the Task menu have tearoff options. Several commands just set the command entry so it can be edited and then sent. The putz commands and the widget command send as well.

The menu command, Lookup with browser, will launch the default browser on the platform (windows or linux) and pass the text in the second entry to the https://www.magicsplat.com/tcl-docs/docindex.html website. 

'''Extra:''' This includes a manual refresh of the Task menu and an option to keep the send command window on top. 


Note, the send uses a thread::send and so the task must enter the event loop (or use thread::wait) to process a command. If the task only does solid compute, then no events will be able to be processed while that compute is ongoing. A twait command will check the event queue periodically, so that counts as being in the event loop.

The widget tree can be run again, and closed. This also applies to the putz windows. However, the task monitor and send command tasks should not be closed, rather, use the minimize to hide, since these are tasks and they can't be restarted (currently - a wish list item is to allow this). This utility requires the BWidgets package.

<<enddiscussion>>

----
**** '''Trying out the examples''' ****

To demo the examples, copy the code source discussion (click the copy button in the upper right) followed by an example to a file and run it with tclsh or wish. It requires Threads and Tk.

Note: On windows, one should also include a '''[[console show]]''' command to see the output.

'''Warning:''' If using the single file 8.7 (windows) builds, there will be a silent error on the examples that do a '''package require math'''. It appears that these builds do not fully setup auto_paths. If the thread exits from this error, one should use tdump to see if the error attribute shows this to be an error during task/thread creation.


<<discussion>>Code source
======
package require Thread
    
tsv::set  tids [thread::id] mainthread  ;# for reverse lookup 
tsv::set  main mainthread [thread::id]  ;# for reverse lookup 
################################################# Tasks version 1.12
namespace eval tasks {  
proc putz {arg {color normal} {debug no}} { ;# debugging put using a text widget from a Task (a thread)
##########################################
#   t_debug -1 means no putz output at all
#   t_debug 0  means we use the tk, but no  debug output - the default if < we use 0
#   t_debug 1  means we use the tk  and yes debug stuff
#
#   t_debug 2  means we don't use the tk, and also no  debug
#   t_debug 3  means we don't use the tk, and also yes debug output debug
#
#   t_debug 4  overide protection and allow linux to use tk, 4 becomes a 0 - this is to save using another global this is getting ugly
#   t_debug 5  overide protection and allow linux to use tk, 5 becomes a 1
#
#   when the value is in hex, i.e. begins with a 0x, then the . tk window is withdrawn (now that we have our own toplevel) 
#
#   platform is windows     ok
#   platform is not windows then we add 2 to the value of t_debug if < 2 and not > 3
##########################################
#   set mid [tsv::get main mainthread]
#   thread::send -async $mid [list puts stderr "arg= |$arg| color= |$color| debug= |$debug| "]
#
    set dodebugging     0
    set dotk        0
    set overide     0
    if { ! [info exist ::t_pid] } { ;# check this, only exists in a task, not main (t_debug might be set by main, so can't use that)
        set io stdout
        if { $color ne "normal" && $::tcl_platform(platform) eq "windows"} {
            set io stderr
        }
        if { [info exist ::t_debug] && $::t_debug < 0 } {
            return
        }
        puts $io $arg
        return
    }
    set tdebug $::t_debug
    if       { $tdebug < 0 || $::t_putz_output == 0} {
        return
    } elseif { $tdebug > 3 } {
#        error "t_debug set to > 3 an invalid setting"
        set overide 1       ;# to use on linux systems anyway
        incr tdebug -4      ;# change to 0/1 for 4/5
    }
    if { $::tcl_platform(platform) ne "windows"  } { ;# hack: change windows to windowsx to force it to use stdout/stderr and a puts
        if { $tdebug < 2 && ! $overide } {
            incr tdebug 2                           ;# hack 2, if commented out, linux can also use tk windows, but beware, tcl/tk might abort with a seg fault or other crash
        }
    }
    
    if       { $tdebug == 0} {
        set  dotk 1
    } elseif { $tdebug  == 1} {
        set  dotk 1
        set  dodebugging 1
    } elseif { $tdebug  == 2} {
        # ok as is, both 0
    } elseif { $tdebug  == 3 } {
        set dodebugging 1
    } else {
        error "bad value for tdebug"
    }
#   tasks::tset $::t_name user "dotk= |$dotk| dodebugging= |$dodebugging| tdebug= |$tdebug| color= |$color| debug= |$debug| ::t_debug= |$::t_debug| "
#   error "dotk= |$dotk| dodebugging= |$dodebugging| tdebug= |$tdebug| color= |$color| debug= |$debug| ::t_debug= |$::t_debug| "
#   return  ;# to turn off debugging putz calls always
    if { $debug  eq "debug" && $dodebugging == 0} {
        return  
    }
    if { $dotk == 0 } {
        set mid [tsv::get main mainthread]
        set argg "[format %-10s  $::t_name] ! $arg"
        set io stdout
        if { $color ne "normal" && $::tcl_platform(platform) eq "windows"} {
            set io stderr
        }
#       tsv::set tvar $::t_name,user4 $mid

        if { $::tcl_platform(platform) eq "windows" } {
            thread::send -async $mid [list puts $io $argg]
        } else {
            puts $io $argg
        }
        return
    }
    if { [info command .taskdebug.ttttt] eq "" } {                  ;# ![info exist ::t_putz] 
#        set ::t_putz 1
        if [catch {
            package require Tk
        } err_code] {
            tsv::set tvar $::t_name,errorTk "tdebug= |$tdebug| dotk= |$dotk| dodebugging= |$dodebugging| debug= |$debug| arg= |$arg| err_code= |$err_code| "
            return
        }
        if { [string range $::t_debug 0 1] eq "0x" } {
#           wait 15000
            catch {wm withdraw .} ;# now that we use our own toplevel, if this is inited to 0x0 we close this, user can set to 0 or other value to override
        }
        toplevel .taskdebug
        wm title .taskdebug "$::t_name putz"
        tsv::set tvar $::t_name,putz yes
        if [catch {
            set tname [tsv::get tids [thread::id]]
        } err_code] {
            set tname "No Task" 
        }
#        catch {wm title . $tname}
        frame  .taskdebug.fffff
        button .taskdebug.fffff.bbbbb -text "Exit [thread::id] $tname"   -command exit
        button .taskdebug.fffff.ccccc -text "Clear"                      -command {.taskdebug.ttttt delete 1.0 end}
        button .taskdebug.fffff.wwwww -text "Wider->"                    -command {wm geom .taskdebug [expr [lindex [split [wm geom .taskdebug] x] 0]+100]x[lindex [split [wm geom .taskdebug] x] 1]}
        
#       set ::t_task_pause 0 ;# don't set this here anymore, allows task to start up paused by setting this to 1
        checkbutton .taskdebug.fffff.cbcbcb1 -variable ::t_task_pause -text "pause"
        
        text      .taskdebug.ttttt    -yscrollcommand     {.taskdebug.sssss set}    -tabs {32 left} -tabstyle wordprocessor
        scrollbar .taskdebug.sssss    -command            {.taskdebug.ttttt yview}
        
        pack .taskdebug.fffff -side top -fill x
        pack .taskdebug.fffff.wwwww .taskdebug.fffff.ccccc .taskdebug.fffff.bbbbb -side left -expand 1 -fill x
        pack .taskdebug.sssss -side right -fill y
        pack .taskdebug.ttttt -side left -fill both -expand 1
        pack .taskdebug.fffff.cbcbcb1 -side right -fill y
        
        set ::t_putz_output 1
        checkbutton .taskdebug.fffff.cbcbcb2 -variable ::t_putz_output -text "putz output" 
        pack .taskdebug.fffff.cbcbcb2 -side right -fill y
        
        .taskdebug.ttttt tag configure debug              -foreground black -selectbackground lightblue
        .taskdebug.ttttt tag configure normal             -foreground black -selectbackground lightblue
        .taskdebug.ttttt tag configure green              -foreground \#408f40 -background \#e8e8e8 -font {courier 10 bold} -selectbackground lightblue
        .taskdebug.ttttt tag configure white              -foreground white -background black  -font {courier 10 bold} -selectbackground lightblue
        .taskdebug.ttttt tag configure yellowonblack      -foreground yellow -background black -font {courier 10 bold} -selectbackground red
        .taskdebug.ttttt tag configure yellow             -foreground yellow -background red -selectbackground blue
        .taskdebug.ttttt tag configure whiteonred         -foreground white -background red -font {courier 10 bold} -selectbackground black
        .taskdebug.ttttt tag configure rederror           -foreground red -background grey85 -font {courier 15 bold italic} -selectbackground black
        .taskdebug.ttttt tag configure red                -foreground red -font {courier 10} -selectbackground lightblue
    }
    if [catch {
        .taskdebug.ttttt insert end $arg\n $color
        .taskdebug.ttttt see end
        update
    } err_code] {
    }
}

proc wait { ms } {              ;# non busy wait
    set uniq [incr ::__sleep__tmp__counter]
    set ::__sleep__tmp__$uniq 0
    after $ms set ::__sleep__tmp__$uniq 1
    vwait ::__sleep__tmp__$uniq
    unset ::__sleep__tmp__$uniq
}
    
#################################################
    
proc xwait {arg {doupdate 1} {doputz 0}} {              ;# a busy wait version of wait, to test compute bound
    set max [expr {   $arg * 12000   }]
    for {set m 0} {$m < $max} {incr m} {
        incr mm
        if { ($m % 100000) == 0 } {
            if { $doupdate } {
                update
            }
        }
    }
    if { $doputz } {
        putz "xwait max= |$max|" normal debug
    }
}


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

proc comma {num {sep ,}} { ;    ;# commify a positive number
    while {[regsub {^([-+]?\d+)(\d\d\d)} $num "\\1$sep\\2" num]} {}
    return $num
}

#proc Task package code         -----------------------------------------------------------
################################################# return a name from a tid
proc tname {tid} {              ;# shorthand to get the taskname given a Task id
    return [tsv::get tids $tid]
}
################################################# get or set by taskname and parm
proc tset {name parm {arg {GwY6itRvUgUNuTg2WfS3xyz123}}} {  ;# shorthand to get or set a shared variable given a Task name and element (optional value)
    set items [list tid pid result script mutex gvar cond queue count error share user putz]
    
    if { $arg != {GwY6itRvUgUNuTg2WfS3xyz123} } {
        foreach item $items {
            if { $parm eq $item } {
                return [tsv::set tvar $name,$item $arg]
            }   
        }
    } else {
        foreach item $items {
            if { $parm eq $item } {
                return [tsv::set tvar $name,$item]
            }   
        }
    }
}
#proc tget/tset alias           -----------------------------------------------------------
#interp alias {} tget {} tset
################################################# dump all shared variables
proc tdump {{pat .*} {max 90}} {         ;# dump all the shared Task variables
    set all 1
    set doputz 1
    set out {}
    if {       [string index $pat 0] eq "-" } { ;# a leading - reduces output to just the variables
        set all 0
        set pat [string range $pat 1 end]
    } elseif { [string index $pat 0] eq "+" } { ;# a leading + no output putz either AND return results in $out
        set all 0
        set doputz 0
        set pat [string range $pat 1 end]
    }
    if { $all } {
        putz "\n------ Task(s) dump -----------------------------------------"
        putz "tsv::names  = |[tsv::names *]|"
        putz "tsv::tids   = |[tsv::array names tids *]|"
        putz "---------------------------------------------------------------"
    }
    set tvarnames [lsort -stride 2 -index 1 [tsv::array get tids]]
    
    if { $all } {
        putz "tid/names   = |$tvarnames|"
        putz "---------------------------------------------------------------"
    }
    foreach {var val}  [lsort -dictionary -stride 2 -index 1 $tvarnames ] {
        if { $all } {
            putz "[format %-10s $val] tid: $var  exists: [thread::exists $var]"
        }
        
        set tidnames [tsv::array names tvar $val,*]
        foreach tname [lsort $tidnames] {
            set val [tsv::get tvar $tname]
            set val [string map {\n \u2936 \t \u02eb} $val]
            if { [regexp .*${pat}.* "$tname\t[string range $val 0 $max]"] } {
                if { $doputz } {
                    putz "                 [format %-27s ($tname)] = |[string range $val 0 $max]| "
                } else {
                    lappend out [list $tname $val]
                }
            }
        }
    }
    if { $all } {
        putz "---------------------------------------------------------------"
    }
    return $out ;# will be null unless +pat was used - to avoid dummping it all in interactive mode or windows console
}
#proc - main Task procs         -----------------------------------------------------------
#################################################
proc Task {name0 args} {        ;# create a Task
    set dowhile 1               ;# assume we want the automatic while loop, but if -once is the first arg in args, we suppress it
    set donamespace 1           ;# assume we want to use namespaces, so we import by namespace
    set do_min_import 0
    while 1 {
        if {        [lindex $args 0] eq "-once" } {
            set dowhile 0
            set args [lrange $args 1 end]   ;# shift over the first item in args if -once is the next one
        } elseif {  [lindex $args 0] eq "-min_import_tasks"} {
            set do_min_import 1
            set args [lrange $args 1 end]   ;# shift over the first item in args if -puts is the next one
        } elseif {  [lindex $args 0] eq "-import" || [lindex $args 0] eq "-import_tasks"} {
            set donamespace 0
            set args [lrange $args 1 end]   ;# shift over the first item in args if -import is the next one
        } else {
            break
        }
    }
    set len [llength $args]
    if       { $len == 0 || $len > 3 } {
        error "too few or too many args to Task = $len (or possibly a mispelled option)"
    } elseif { $len == 1 } {
        set args [list {} [lindex $args 0 ]]
    }
    set names [split $name0 /]
    if { [llength $names] == 1 } {
        set name $name0
        set share no
        set sname {}
    } elseif { [llength $names] == 2 } {
        lassign $names name sname           ;# my name plus which shared queue do we use
        set share yes
    } else {
        error "Invalid Task name |$name0|"
    }
#    if { [info exist ::t_debug] && $::t_debug } {
#        if [catch {
#        } err_code] {
#            catch {putz "Task: name= |$name| sname= |$sname| name0= |$name0| names= |$names| share= |$share| args(end-1)= |[lrange $args end-1 end-1]|"}
#        }
#    }
    
    if { [tsv::exists tvar $name,pid] } {
        error "Task \"$name\" already in use, only one task per taskname"
    }
    set me [thread::id]
    tsv::set tvar $name,pid $me             ;# save current parent pid
    tsv::set tvar $name,gvar {}             ;# used by tresult and tcall for a global to wait on
    tsv::set tvar $name,result {}           ;# the result
    tsv::set tvar $name,count 0             ;# the number of times waked up
    tsv::set tvar $name,error {}            ;# the last error if any
    tsv::set tvar $name,share {}            ;# the shared queue if any
    tsv::set tvar $name,putz {}             ;# set to yes if a putz called, for straighting windows
    tsv::set tvar $name,user {}             ;# an extra shared variable the user can use
    
    if { $share } {
        set mutex   [tsv::get   tvar    $sname,mutex]
        set cond    [tsv::get   tvar    $sname,cond]  
        tsv::set    tvar    $name,share     $sname   
        
    } else {
        set mutex   [thread::mutex create]  
        set cond    [thread::cond create]    
    }
    tsv::set    tvar    $name,queue     {}              ;# setup the cond/mutex and the queue   
    tsv::set    tvar    $name,mutex     $mutex  
    tsv::set    tvar    $name,cond      $cond   
    
    set dw1 "while 1 \{"        ;# also enclose our script in a while 1 loop unless the option -once is used
    set dw2 "\}"
    if { ! $dowhile } {
        set dw1 ""
        set dw2 ""
    }
    set e1 "if \[catch \{$dw1"  ;# enclose script in a catch, and a while (unless suppressed with the option)
    
    set e2a "\n\}$dw2 thread_err_code thread_err_dict\] \{\n    tsv::set tvar $name,error \$thread_err_dict  \n"
    set e2b {    package require Tk; tk_messageBox -message "Name = $::t_name Parent = $::t_pid\n$thread_err_code\n\n$thread_err_dict" -title "tid [thread::id]"}
    set e2c "\n\}\n"
    
    set e2 ""
    append e2 $e2a $e2b $e2c
    
    if { $do_min_import } {
        set autoimport [list ::tasks::treturn ::tasks::twait ]
    } else {
        set autoimport [list ::tasks::tlg ::tasks::tla ::tasks::twidgets ::tasks::tproc ::tasks::tdump ::tasks::putz ::tasks::treturn \
                        ::tasks::wait ::tasks::tset ::tasks::tcall ::tasks::twait ::tasks::Task ::tasks::tgroup \
                        ::tasks::xwait ::tasks::comma ::tasks::tname ::tasks::tvwait ::tasks::tpause_check ::tasks::Tproc ]
    }
    if { ! $donamespace } {
#        set autoimport [string map {::tasks {}} $autoimport]
        lappend autoimport {-namespace import tasks::* ;# from -import_tasks}
    }
    set preamble "#Preamble\n\nnamespace eval tasks {}\nset ::t_pid $me\nset ::t_name $name\nset ::t_putz_output 1\nset ::t_twait_timeout 50\nset ::t_task_pause 0\nset ::t_debug 0x0\nset ::t_debug_contents end\n[tproc {*}$autoimport]\n"
    if       { [llength $args] == 2 } {
        lassign $args prefix script00
        append script0 $e1 $script00 $e2
        set prefix0 {}
        foreach prx $prefix {
            if { [string index $prx 0] eq "-" } { ;# dont put a -command in the importing comment, it could have newlines, just indicate it was seen
                append prefix0 " {-cmd} "
            } else {
                append prefix0 " " $prx " "
            }   
        }

        append script $preamble  
        append script "set ::___tlg___  \[info globals\] ;lappend ___tlg___  ___tlg___\n"
        append script "\n#end preamble\n" "\n#included procs/cmds: import list: \{$prefix0\}\n\n" [tproc {*}$prefix] $script0
        
    } elseif { [llength $args] == 1 } {
        lassign $args script0
        append script $preamble  "\n#end preamble\n" "\n#included procs: none\n\n"  $script0 
    } else {
        error "Wrong number of args to task (or mispelled -option): $args"
    }

    set script0 "" ;# place another if/catch around the entire script, to catch things like namespace eval missing
    append script0 "if \[catch \{\n" $script "\n" "\} err_code_Task_Create\] \{ " "\n" "    tsv::set tvar $name,error \$err_code_Task_Create\n    package require Tk; tk_messageBox -title {Task create error} -message \$err_code_Task_Create\n\}"  
    set script $script0
    set tid [thread::create $script]
    
    tsv::set  tvar $name,tid        $tid
    tsv::set  tvar $name,script     $script
    tsv::set  tids $tid             $name       ;# for reverse lookup
    if { $share } {
#   tdump
#   vwait ffff
    }
    uplevel #0 set $name $tid
    return $tid
}
proc tproc {args} {             ;# get procedure(s) and return results, internal use by [Task]
    set once_tasks 1
    set output {}
    foreach arg $args {
        if { [string index $arg 0] eq "-" } {
            append output [string range $arg 1 end] "\n"
        } else {
            set found 0
            
            set nq [namespace qualifiers ::$arg]
            set nqe [namespace exist ::$nq]
            if { $nq ne "" && $nqe } {
                if { ([string trim $nq :] ne "tasks") } {
                    append output "namespace eval $nq {namespace export *}\n" ;# we export everything, user can import if desired
                } else {
                    if { $once_tasks } {
                        append output "namespace eval $nq {namespace export *} ;# do this one time for tasks\n" ;# output this only once
                        set once_tasks 0
                    }
                }
            } else {
            }
            foreach proc [info procs ::$arg] {
                set found 1
                set space ""
                append output  "proc $proc {"
                    foreach arg [info args $proc] {
                        if [info default $proc $arg value] {
                            append output  "$space{$arg \{$value\}}"
                        } else {
                            append output  $space$arg
                        }
                        set space " "
                    }
#                   No newline needed because info body may return a
#                   value that starts with a newline
                    append output  "} {"
                    append output   [info body $proc]
                append output "}\n"
            }
            if { $found == 0 } {
                error "No imports found for $arg\n"
            }
        }
    }
    set lines [split $output \n]
    set out {}
    foreach line $lines {
        if { [string index $line 0] eq "#" } { ;# don't import comment lines, just a blank line instead (so line numbers don't change)
            set line "#"
        }
        append out $line \n
    }
    return $out
}
proc treturn {args} {           ;# return the value from a Task
#    set exiting no
#    if { [llength $args ] > 0} {
#        if       { [lindex $args 0] eq "-exit"} {
#            set exiting yes
#            set args [lrange $args 1 end]
#        }
#    }
    if [catch {
        set rvalue $args
        set me      [thread::id]
        set name    [tsv::get   tids            $me]
        set pid     [tsv::get   tvar            $name,pid]
        tsv::set    tvar        $name,result    $args
        set gvar    [tsv::get   tvar            $name,gvar]
        
        if { $args == {} } {
            thread::send $pid [list set ::$gvar $rvalue]    ;# to allow for an empty return value
        } else {
            thread::send $pid "set ::$gvar $rvalue"         ;# to allow for a simple text string or a [list]
        }
        
    } err_code] {
        putz $err_code
    }
}

#################################################
proc tcall {taskid args} {      ;# call a Task, sync or asyn
    if { $taskid eq "-async" } { ;# allow -async to precede the taskid (thread id) for consistency with thread::send
        tailcall tcall [lindex $args 0] -async {*}[lrange $args 1 end]
    }
    if [catch {
        set exists [thread::exists $taskid] ;# this can return 0 or an error if id is not a thread id
    } err_code] {
        set exists 0
    }
    if {! $exists } {
        if [catch { ;# did the caller use the task name and not it's value?
            set tid $taskid
            set taskid [tsv::set tvar $taskid,tid] ;# try this instead
        } err_code] {
            putz $err_code 
            error "Thread '$taskid' does not exist"
        }
        error "Task id $tid does not exist, likely forgot to use \$$tid"
    }

    set name [tsv::get tids $taskid]
    set async no
    if { [llength $args ] > 0} {
        if       { [lindex $args 0] eq "-async"} {
            set async yes
            set args [lrange $args 1 end]
        }
    }
    set a1 [string range [lindex $args 1 ] 0 1]
    if { $a1 eq "<-" } {
        set args [lreplace $args 1 1]
    }
    if { [llength $args ] > 0} {
        set theglobal   [lindex $args 0]
        set args        [lrange $args 1 end]
    } else {
        error "tcall missing the argument for global variable"
    }
    if { [string range $theglobal 0 1] ne "::" } {
        set theglobal "::$theglobal"
    }
#   global $theglobal
    unset -nocomplain $theglobal
    
#   thread::send ?-async? ?-head? id script ?varname?
#   return
    
    set mutex   [tsv::set tvar $name,mutex]
    set cond    [tsv::set tvar $name,cond]
    set argsx   [list]
    lappend     argsx   [thread::id]    $theglobal $args
    
#   tsv::set tvar $name,gvar $theglobal ;################## the problem
    
    
    thread::mutex   lock    $mutex
    tsv::lpush      tvar    $name,queue $argsx end
    thread::cond    notify  $cond
    thread::mutex   unlock  $mutex
    
    if { $async } {
        if [catch {
        } err_code] {
            putz "async cannot use puts here $err_code" green debug
            catch {putz "send  $name  $taskid   args -async = |$args|"} ;# try again but to the thread instead
        }
        return 1
    } else {
        if { ![tvwait $theglobal $taskid] } {
            return {}
        }
        return [set $theglobal]
#       return [tsv::set tvar $name,result] ;# note, if we are using a shared queue, this will not be right, must use global var instead
    }
    
    
}
#################################################
proc tpause_check {args} {
    set twcount 0
    if { $::t_task_pause } {
        while { $::t_task_pause } {
            if { [incr twcount] == 1 } {
                putz "Pausing  task: $twcount"
            }
            wait 1000
        }
        putz "Resuming task after:  $twcount seconds"
        wait 1000
    }
    
}

proc twait {args} {             ;# wait for something in the Task queue
    if { $::t_debug < 0 } {
        set dbug 0
    } else {
        set dbug [expr {   $::t_debug % 2   }] ;# optimize the debug trace when not tracing -   t_debug is 0/2 no trace, 1/3 trace  
    }
#   wait 2000
    if { [info command tpause_check] ne ""} {
        tpause_check 
    }
    if [catch {
        set mutex [tsv::get tvar $::t_name,mutex]
        set cond  [tsv::get tvar $::t_name,cond]
    } err_code] {
        catch {putz $err_code}
    }
    if [catch {
        
#       wait 2000
        thread::mutex lock $mutex
#        set count 0
        set sname [tsv::get  tvar $::t_name,share]
        if { $sname != {} } {
            set tname $sname
        } else {
            set tname $::t_name
        }
        if { $dbug } {catch {putz "" normal debug}}
        if { $dbug } {catch {putz "sname(share name) = |$sname| tname(use)= |$tname| ::t_name(me)= |$::t_name| "  normal debug}}
        set count -1
        while {[tsv::llength tvar $tname,queue] == 0} {
            incr count
            if { $count < 1} { ;# output 1 times only each idle period
                if { $dbug } {catch {putz "queue is empty, so wait ($count)" red debug}}
            }
            thread::cond wait $cond $mutex $::t_twait_timeout
            update
        }
        if { $dbug } {catch {putz "queue not empty (retrys: [incr count]) len= [tsv::llength tvar $tname,queue] contents: [lrange [tsv::get tvar $tname,queue] 0 $::t_debug_contents ]" green debug}}
        set works [tsv::lpop tvar $tname,queue]
        thread::mutex unlock $mutex
        
        lassign $works pid gvar work ;# got these from the queue, now set gvar, so the return can use it, also the parent thread to return to
        tsv::set tvar   $::t_name,gvar  $gvar 
        tsv::set tvar   $::t_name,pid   $pid 
        if { $dbug } {
            set ms [clock milliseconds]
            set secs [expr {   $ms / 1000   }]
            set ms [string range $ms end-2 end]
            
            catch {putz "[string range [clock format $secs] 11 18].$ms job [expr {   [tsv::get tvar $::t_name,count]+1   }]: worklen= [llength $work] -> \{$work\} pid= $pid gvar= $gvar " yellowonblack debug}
        }
        
    } err_code err_dict] {
        set err [lrange [dict get $err_dict -errorcode] 0 1]
        tsv::set tvar $::t_name,error [list $err_code $err]
        if { $dbug } {catch {putz "error2: |$err_code| err |$err| " normal debug}}
        error  $err ;# propogate up, this could be a cancel, not sure what else to do here
    }
    tsv::incr tvar $::t_name,count

# should be able to do this with just one uplevel and lassign, but couldn't figure it out, so brute force it
    if { [llength $args] > 0 } { ;# if the call contained a variable to get the args, plus optionally variables to "lassign" them to
        set name [lindex $args 0]
        set rest [lrange $args 1 end]
        
        if { $dbug } {catch {putz  "args varname= |$name| rest of variables= |$rest|" normal debug}}
        uplevel set $name [list $work]
        
        set i -1
        foreach item $rest {
            incr i
            set data [lindex $work $i ] 
            if { $dbug } {catch {putz "     arg $i: [format %-12s $item ] data= |$data| " normal debug}}
            uplevel set $item [list $data]
        }
    
    }
    
    
    return $work
    
}
#################################################
proc tvwait {var {tid {}}} {    ;# wait till an async Task call, with Task id tid, completes and sets the variable
    if { [string range $var 0 1] ne "::" } {
        set var "::$var"
    }
    if { ![info exist $var] } {
        if {$tid != {} && ![thread::exists $tid] } { ;# if given a taskid, make sure it's still running or we wait forever
            set io stdout
            if { $::tcl_platform(platform) eq "windows" && 0} {
                set io stderr
            }
            if [catch {
                puts $io "Task: $tid does not exist, while waiting on $var"
            } err_code] {
                putz "error in twait: $err_code" normal debug
                catch {putz  "Task: $tid does not exist, while waiting on $var"}
            }
            return 0
        }
        vwait $var
    }
    return 1    
}
############ tgroup ##########################################################
#   
#   Multiple task builder. This takes gname and uses it for a
#   group of tasks. The names will be gname0, gname1, .... gname(N-1)
#   where gname0 is the boss and the rest will be helper/boss with
#   names like gname1/gname0, gname2/gname0, ... gname(N-1)/gname0
#   
#   If the number of tasks is negative, e.g. -4, then the abs(number) will
#   be used, but the -N also will then create traces on each of the tasks
#   assigned result variables (rvar,n). in the -call code, after the tcall's
#   
#
#   To create the tasks, one uses the -tasks N or -N option
#   
#       tgroup groupname -tasks N ....  args in Task starting with options
#       tgroup groupname -tasks -N .... this one creates a trace
#       
#   
#   
#   There are 2 ways to process, using -call or -foreach
#   
#       tgroup groupname -call args...
#       tgroup groupname -foreach args...
#       
#       -call
#    
#           can only have as many items as tasks, and if items are less
#           than the number of tasks, it will recycle from the beginning of
#           the arglist until it has run exactly N jobs for -tasks N
#           it is an error to have more args than tasks
#           
#       -foreach
#   
#           This can take any number of args 1..M and each will be run
#           regardless of how many tasks are created. if more jobs than
#           tasks, some tasks will run more than one job in sequence. This
#           option can be used more than once.
#
#   A trace, using -tasks -N can be applied to either -call or -foreach
#
#   To wait for these to be done
#       
#       tgroup groupname -wait all
#       
#           This will wait on all the tasks to complete.
#           
#   The groupname is also the name of a global array that will be
#   first unset on the -tasks option, and then the following elements are
#   generated:
#   
#   where n is the number 0..N-1 for N jobs
#   
#   rvar,n     the result value element the calls use
#   args,n     the arguments passed to the n'th task
#   tid,n      the task id's
#   
#   tasks      one only, the number of tasks or jobs depending on -call or -foreach
#   
#   The tasks are all linked to the first one, gname0, and they may exit, but
#   gname0 should not exit. If the script is the same for each, they can tell
#   if they are the boss task by testing for the number in ::t_name which is
#   always set to the task's name and will have a number at the end.
#   
#   usage:
#   
#   tgroup groupname -tasks ?-?N .... args to a task beginning with the options
#
#   tgroup groupname -call    {arglist 1} {arglist 2} ... (only 1 of these)
#   tgroup groupname -foreach {arglist 1} {arglist 2} ... (can be repeated)
#
#   tgroup groupname -wait all 
#   
# or to comine -foreach and -wait all to reduce to just 2 calls:
#
#   tgroup groupname -tasks ?-?N .... args to a task beginning with the options
#   tgroup groupname -run  {arglist 1} {arglist 2} ...    (only 1 of these)
#   tgroup groupname -reset                               (no args, reset counts to same as just after -tasks) 
############
    
proc tgroup {gname option args} {
    if       { $option eq "-tasks" } {
        uplevel #0 array unset $gname
        upvar #0 $gname name
        
        set argss [lassign $args num]
        if [catch {
            set name(trace) 0 ;# if we catch an error here, we likely already have a variable of the same name as the group, no can do
        } err_code] {
            if { [info exists name] } {
                error "error: $err_code\ngroup name $gname is already in use as a variable"
            } else {
                error "error: $err_code"    
            }
        }
        set name(job)   0  ;# so we can have multiple -foreach's (only 1 -call however)
        if { $num < 0 } {
            set num [expr {   0 - $num   }]
            set name(trace) 1
        }
        set name(tasks) $num
        set name(threads) $num
        for {set n 0} {$n < $num } {incr n} {
            if { $n == 0 } {
                set t ${gname}0
            } else {
                set t   ${gname}${n}/${gname}0
            }   
            set tid [uplevel [list tasks::Task $t {*}$argss]]
            set name(tid,$n) $tid
        }
        
    } elseif {  $option eq "-run" || $option eq "-reset" } {
        upvar #0 $gname name
        set name(job)   0                                              ;# reset this so we can do another -run
        set undef {}
        lappend undef  {*}[array names name rvar,*] {*}[array names name args,*]
        foreach und $undef {
            unset name($und)    
        }
        set name(tasks) $name(threads)
        if { [llength $args] != 0 && $option eq "-run"} { ;# no args after -reset
            tgroup $gname -foreachup2 {*}$args
            tgroup $gname -waitup2 all
        }
    
        
    } elseif {  $option eq "-foreach" || $option eq "-foreachup2"  } { ;# it's ugly but we allow multiple -foreach's in separate tgroup calls, so we must accumulate jobs
        upvar #0 $gname name
        set numtasks $name(tasks)
        set numarglists [llength $args]
        set name(tasks) [expr {   $numarglists + $name(job)   }] ;# this is ugly, we change meaning of tasks to jobs, since -wait will still work on number of tasks
        if { $name(job) < 0} {
            error "Cannot mix -foreach and -call current job =  $name(job)"
        }
        set jj -1
        for {set job $name(job)} {$job < $name(tasks) } {incr job} {
            set theargs [lindex $args [incr jj] ]
            set name(args,$job) $theargs
            set tid [tset  ${gname}0 tid]
            set tn  [tname $tid]
            set c [uplevel [list tasks::tcall $tid -async ::${gname}(rvar,$job) {*}$theargs]]
            if { $name(trace) } {
                if {! [info exist  ::${gname}(rvar,$job)] } {
                    trace add variable ::${gname}(rvar,$job) write $gname
                } else {
                    $gname  ::$gname rvar,$job Write
                }
            }
            
            if { $c != 1 } {
                error "error calling tgroup -call on job $job"
            }
            
        }
        set name(job) $job

    } elseif {  $option eq "-call"  } { ;# only one -call allowed
        upvar #0 $gname name
        if { $name(job) != 0 } {
            error "Cannot mix -foreach and -call or more than one -call: current job =  $name(job)"
        }
        set name(job) -1   ;# in case we try to do this again
        set numtasks $name(tasks)
        set numarglists [llength $args]
        if { $numarglists >  $numtasks} {
            error "tgroup $gname : too many arglists, $numarglists with only $numtasks tasks"
        }
        set index 0
        for {set job 0} {$job < $numtasks } {incr job} {
            if { ($job % $numarglists) == 0} {
                set index 0
            }
            set theargs [lindex $args $index ]
            set name(args,$job) $theargs
            set tid [tset  ${gname}0 tid]
            set tn  [tname $tid]
            set c [uplevel [list tasks::tcall $tid -async ::${gname}(rvar,$job) {*}$theargs]]
            if { $name(trace) } {
                if {! [info exist  ::${gname}(rvar,$job)] } {
                    trace add variable ::${gname}(rvar,$job) write $gname
                } else {
                    $gname  ::$gname rvar,$job Write
                }
            }
            
            if { $c != 1 } {
                error "error calling tgroup -call on job $job"
            }
            
            incr index
        }
        
    } elseif {  $option eq "-wait" || $option eq "-waitup2" } {
        upvar #0 $gname name
        lassign $args type
        if       { $type eq "all" } {
            set numtasks $name(tasks)
            for {set job 0} {$job < $numtasks } {incr job} {
                tvwait ::${gname}(rvar,$job)
            }
        } elseif { $type eq "one"  } {
            error "not implemented in tgroup yet $type"
        } else {
            error "Invalid tgroup call -wait $type must be all or one"
        }
    } else {
        error "Invalid option to tgroup: $option, must be -tasks, -call, -foreach, -run, -reset, or -wait"
    }
}
#   Notes on Tproc. 
#   The user can specify a -num for -tasks, just like in tgroup, however, this
#   means that the traceback proc will have to be after Tproc is called to overide 
#   the proc name, since tracebacks also use the task name. We have to create the proc using
#   the same name, so we can import it. Maybe we should do ${name}_orig for the proc name
#   
#   The user can also do -import or -import_tasks, and also -once, but if -once is used, then
#   the proc will exit after 1 call.
#
#   Note: Tproc uses tgroup on name, so name0,name1,...,nameN are generated, so cannot be used
#   for other Tproc's or tgroups as the name argument, or an error will result 

proc Tproc {name arguments body {option -tasks} {num 4} args} {
    uplevel [list proc $name $arguments $body]
    if { $option ne "-tasks" } {
        error "Tproc option $option invalid, should be -tasks"
    }
    set qual "tasks::"
    set opts {}
    set ar $args
    while { 1 } {
        set ar [lassign $ar option]
        if { $option eq "-import_tasks"  || $option eq "-import"} {
            lappend opts "-import_tasks"
            set qual ""
        } elseif { $option eq "-once" } {
            lappend opts "-once"
        } elseif { $option eq "-min_import_tasks" } {
            lappend opts "-min_import_tasks"
        } else {
            set ar [list $name {*}$option]
            break
        }
    }
    set targs {}
    lappend targs {*}$opts $ar
    uplevel "tasks::tgroup $name -tasks $num $targs  \{
        ${qual}twait argv
        ${qual}treturn \[$name \{*\}\$argv\]
    \}
    "
}


#proc repos {{geomx 700x200} {rowsx 4} {xoffx 700} {yoffx 240} } ;# old way, now we compute, so need only enter 111x222, but can still specify others
proc repos {args} {
    lassign $args geomx  rowsx  xoffx  yoffx
    if { $geomx eq "" } {
        set geomx 700x200
    }
    lassign [split $geomx x] xsize ysize
    if { ![string is integer -strict $xsize] || ![string is integer -strict $ysize]  } {
        error "invalid XxY (xsize by ysize) usage: repos ?XxY? ?rows? ?x-offset? ?y-offset?"
    }
    
    set xsize [expr {   max($xsize,150)   }] ;# need minimum of 150
    set ysize [expr {   max($ysize,100)   }]
    set geomx ${xsize}x${ysize}              ;# reconstruct
    
    if { $rowsx eq "" } {
        set rowsx   [expr {   int( 1000 / ($ysize + 40))   }]
    }
    if { $xoffx eq "" } {
        set xoffx $xsize
    }
    if { $yoffx eq "" } {
        set yoffx [expr {   $ysize + 40   }]
    }
    
    
    set task -1
    foreach i [tasks::tdump {+,tid}] {
        lassign $i name tid
        if { $name eq "_taskmonitor,tid" || $name eq "sendcmd,tid" } {
            continue
        }
        set tname [lindex [split $name ,] 0]
        set count [tasks::tset $tname count]
        if { $count <= 0 } {
            #continue ;# if you only want tasks that have done something to be adjusted, enable this
        }
        if { [tsv::set tvar $tname,putz]  ne "yes"} {
            continue    ;# if this task  has no putz debug window, skip so task count doesn't increment and windows
        }
        incr task
        set script "set __repos__(num) $task\nset  __repos__(rows) $rowsx;set  __repos__(xoff) $xoffx; set  __repos__(yoff) $yoffx; set  __repos__(geom) $geomx\n"
        append script {
            
            set  __repos__(x) [expr {   ($__repos__(num) / $__repos__(rows))   * $__repos__(xoff)   }]
            set  __repos__(y) [expr {   ($__repos__(num) % $__repos__(rows))   * $__repos__(yoff)   }]
            set  __repos__(newgeom) "$__repos__(geom)+$__repos__(x)+$__repos__(y)"
            if [catch {
                wm withdraw .taskdebug
                wm deiconify .taskdebug
                wm geom .taskdebug $__repos__(newgeom)
                set __repos__(zzz) $__repos__(newgeom)
            } __repos__(err_code)] {
                set __repos__(zzz) "err=[set __repos__(err_code)]" ;# debugging, if it fails we can check this global in the thread
            }
            #set __repos__(zzz) "$__repos__(zzz) ---- $__repos__(num)   x= $__repos__(x)    y= $__repos__(y)" ;# for debugging this
        }
        after [expr {   100*$task   }] [list thread::send  -async $tid $script]
    }
} ;# end repos


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

proc task_monitor {args} {
    
#   --------------------------------------- create frames
    set create_frame_script {
    
        ; proc column_sizer {mult col which widgetx} { ;# left/right clicks on heading will resize column left=smaller (min size 3) (max size 100)
            set current [$widgetx cget -width]
#           tasks::putz  "col= |$col| nrows= |$::nrows| which= |$which| widgetx= |$widgetx| current= |$current| " green
            for {set n 0} {$n <= $::nrows  } {incr n} {
#               tasks::putz  "   n = $n  widget($n,$col) = $::widget($n,$col)" red
                if { $which == 1 } {
                    set newcur  [expr {   max(1,$current - (3*$mult))   }]
                } else {
                    set newcur  [expr {   min(100,$current + (3*$mult))    }]
                }
#               tasks::putz "newcur= |$newcur| " 
                $::widget($n,$col) configure -width $newcur
                
            }
            event generate .top.fra.scframe.canvas <Configure> ;# should be able to compute this widget path, but...
            
        }
        
        ; proc add_row {newrow} {
            global nrows ncols widget table path
#           tasks::putz "nrows= |$nrows| ncols= |$ncols| newrow= |$newrow| "
            set last [expr {   $newrow - 1   }]
            set widgets [list]
            foreach col [range 0 ..  $ncols]     {
                set w0 $widget($last,$col)
                set wid [$w0 cget -width]
                set font [$w0 cget -font]
                set parent [winfo parent $w0]
                set newpath "$parent.path$newrow-$col"
#               tasks::putz "\ncol = $col last = $last   w0= |$w0| path= $path "    red
#               tasks::putz "newpath = |$newpath| width = $wid  font = $font"
                set w1 [entry $newpath      -textvariable ::table($newrow,$col) -width $wid -font $font -readonlybackground {} -state normal]
                if { $col == 0 } {
                    $w1 configure -bg grey80  -bd 5 -relief flat
                } else {
                    $w1 configure  -justify left -bd 5 -relief groove
                }
                set widget($newrow,$col) $w1
                set table($newrow,$col) {} 
                lappend widgets $w1     

            }
#           tasks::putz [join $widgets \n] yellowonblack
            grid  configure {*}$widgets
            incr nrows
        }
        
        ; proc create_table {top frame nrow ncol widths headers {fsize 12}} {
            global widget table
#           frame .frame
            foreach row [range 0 .. $nrow ] {
                set widgets {}
                foreach col [range 0 ..  $ncol ] {
                    set wid [lindex $widths $col]
                    if { $wid eq "" } {
                        set wid 15
                    }
                    set w [entry $frame.path$row-$col   -textvariable ::table($row,$col) -width $wid \
                            -font [list TkTextFont $fsize] -readonlybackground {} -state normal]
                    set widget($row,$col) $w
                    if { $row == 0 } {
                        bind $w <Button-1>  "column_sizer 1 $col %b %W ; break"
                        bind $w <Button-3>  "column_sizer 1 $col %b %W ; break"
                        bind $w <Shift-Button-1>  "column_sizer 5 $col %b %W ; break"
                        bind $w <Shift-Button-3>  "column_sizer 5 $col %b %W ; break"
                    }
                    if { $row == 0 } {
                        set table($row,$col) "[lindex $headers $col]"
                        $w configure -bg grey90 -justify center -bd 5 -relief raised
                        
                    } else {
                        $w configure  -justify left -bd 5 -relief groove
                        set table($row,$col) {} ;#"label $row x $col [string repeat 12345- 5]"
                        
                    }
                    lappend widgets $w
                }
                grid  configure {*}$widgets
            }
            foreach row [range 1 .. $nrow ] {
                $widget($row,0) configure -bg grey80  -bd 5 -relief flat
            }
            grid $frame
            event generate .top.fra.scframe.canvas <Configure>          
        }
        ; proc destroy_table {args} {
            global widget table
            foreach wida [array names widget] {
                destroy $::widget($wida)
                unset ::widget($wida)
            }
            destroy .frame
            
            
        }
        ; proc create_frame {top args} {
#           ----------------------------- wow, scrollable frame setup --------------
            if { [info command $top] == "" } {
                set top [toplevel $top]
            }
            set fra [frame $top.fra]
            set frascr $fra.scframe
            
            sframe new $frascr -mode xY -toplevel false  -anchor w
            
            set path [sframe content $frascr]
            
            pack $fra -expand 1 -fill both
            pack $frascr -expand 1 -fill both
            
            $fra.scframe.canvas configure -xscrollincrement 1
            $fra.scframe.canvas configure -yscrollincrement 1
            return $path
#           ------------------------------------------------------------------------
        }
        
    } ;# end create_frame_script
    
#proc end   create frames
    
#   --------------------------------------------- scrollable frame from wiki
    
    set sframe_script {
        
        namespace eval ::sframe {
            namespace ensemble create
            namespace export *
            
            # Create a scrollable frame or window.
            ;proc new {path args} {
                # Use the ttk theme's background for the canvas and toplevel
                set bg [ttk::style lookup TFrame -background]
                if { [ttk::style theme use] eq "aqua" } {
                    # Use a specific color on the aqua theme as 'ttk::style lookup' is not accurate.
                    set bg "#e9e9e9"
                }
                
                # Create the main frame or toplevel.
                if { [dict exists $args -toplevel]  &&  [dict get $args -toplevel] } {
                    toplevel $path  -bg $bg
                } else {
                    ttk::frame $path
                }
                
                # Create a scrollable canvas with scrollbars which will always be the same size as the main frame.
                set mode both
                if { [dict exists $args -mode] } {
                    set mode [dict get $args -mode]
                }
                switch -- [string tolower $mode] {
                    both - xy - yx {
                        set canvas [canvas $path.canvas -bg $bg -bd 0 -highlightthickness 0 -yscrollcommand [list $path.scrolly set] -xscrollcommand [list $path.scrollx set]]
                        ttk::scrollbar $path.scrolly -orient vertical   -command [list $canvas yview]
                        ttk::scrollbar $path.scrollx -orient horizontal -command [list $canvas xview]
                    }
                    y {
                        set canvas [canvas $path.canvas -bg $bg -bd 0 -highlightthickness 0 -yscrollcommand [list $path.scrolly set]]
                        ttk::scrollbar $path.scrolly -orient vertical   -command [list $canvas yview]
                    }
                    x {
                        set canvas [canvas $path.canvas -bg $bg -bd 0 -highlightthickness 0 -xscrollcommand [list $path.scrollx set]]
                        ttk::scrollbar $path.scrollx -orient horizontal -command [list $canvas xview]
                    }
                    default {
                        return -code error "-mode option is invalid: \"$mode\" (valid are x, y, xy, yx, both)"
                    }
                }
                
                # Create a container frame which will always be the same size as the canvas or content, whichever is greater.
                # This allows the child content frame to be properly packed and also is a surefire way to use the proper ttk background.
                set container [ttk::frame $canvas.container]
                pack propagate $container 0
                
                # Create the content frame. Its size will be determined by its contents. This is useful for determining if the
                # scrollbars need to be shown.
                set content [ttk::frame $container.content]
                
                # Pack the content frame and place the container as a canvas item.
                set anchor "n"
                if { [dict exists $args -anchor] } {
                    set anchor [dict get $args -anchor]
                }
                pack $content -anchor $anchor
                $canvas create window 0 0 -window $container -anchor nw
                
                # Grid the scrollable canvas sans scrollbars within the main frame.
                grid $canvas   -row 0 -column 0 -sticky nsew
                grid rowconfigure    $path 0 -weight 1
                grid columnconfigure $path 0 -weight 1
                
                # Make adjustments when the sframe is resized or the contents change size.
                bind $path.canvas <Configure> [list [namespace current]::resize $path]
                
                # Mousewheel bindings for scrolling.
                bind [winfo toplevel $path] <MouseWheel>       [list +[namespace current] scroll $path yview %W %D]
                bind [winfo toplevel $path] <Shift-MouseWheel> [list +[namespace current] scroll $path xview %W %D]
                
                return $path
            }
            
            
            # Given the toplevel path of an sframe widget, return the path of the child frame suitable for content.
            ;proc content {path} {
                return $path.canvas.container.content
            }
            
            
            # Make adjustments when the the sframe is resized or the contents change size.
            ;proc resize {path} {
                set canvas    $path.canvas
                set container $canvas.container
                set content   $container.content
                
                # Set the size of the container. At a minimum use the same width & height as the canvas.
                set width  [winfo width $canvas]
                set height [winfo height $canvas]
                
                # If the requested width or height of the content frame is greater then use that width or height.
                if { [winfo reqwidth $content] > $width } {
                    set width [winfo reqwidth $content]
                }
                if { [winfo reqheight $content] > $height } {
                    set height [winfo reqheight $content]
                }
                $container configure  -width $width  -height $height
                
                # Configure the canvas's scroll region to match the height and width of the container.
                $canvas configure -scrollregion [list 0 0 $width $height]
                
                # Show or hide the scrollbars as necessary.
                # Horizontal scrolling.
                if {[winfo exists $path.scrollx]} {
                    if { [winfo reqwidth $content] > [winfo width $canvas] } {
                        grid $path.scrollx  -row 1 -column 0 -sticky ew
                    } else {
                        grid forget $path.scrollx
                    }
                }
                # Vertical scrolling.
                if {[winfo exists $path.scrolly]} {
                    if { [winfo reqheight $content] > [winfo height $canvas] } {
                        grid $path.scrolly  -row 0 -column 1 -sticky ns
                    } else {
                        grid forget $path.scrolly
                    }
                }
                return
            }
            
            
            # Handle mousewheel scrolling.
            ;proc scroll {path view W D} {
                if { [winfo exists $path.canvas]  &&  [string match $path.canvas* $W] } {
                    $path.canvas $view scroll [expr {-$D}] units
                }
                return
            }
        } ;# end namespace sframe
        
    } ;# end sframe_script
    
#proc end sframe
    
    
set utility_scripts {
        
    ;proc range {a op b {by by} {step 1}} {
        if       { $op eq ".." || $op eq "to"} {
            if { $a > $b && $step > 0 } {
                set step [expr {   0 - $step   }]
            }
            if { $step == 0 || ($step < 0 && $a <= $b) || ($step > 0 && $b < $a)} {
                error "range: invalid step = $step with a = $a and b = $b"
            }
            if { $by ne "by" } {
                error "range: unknown term for by : $by"
            }
            set step [expr {   abs($step)   }]
            if { $a <=  $b } {
                incr a [expr {   0-$step   }]
                lmap b [lrepeat [expr {   ($b-$a) / $step   }] 0] {incr a $step}
            } else {
                #           puts "a= |$a| b= |$b| step= |$step| "
                incr a $step
                lmap b [lrepeat [expr {   ($a-$b) / $step   }] 0] {incr a -$step}
            }
        } elseif { $op eq "#" } {
            incr a [expr {   0-$step   }]
            lmap b [lrepeat $b 0] {incr a $step}
        } else {
            error "unknown range op $op"
        }
        
    }
    
#####################      send command task        ###########################
    
        
        
        
        
        
        
} ;# end utility_scripts
    
#proc end utility_scripts
    
    
#proc  task defintion
#   namespace import tasks 
    Task _taskmonitor  -import_tasks [list -$sframe_script -$create_frame_script -$utility_scripts tasks::repos tasks::* balloon::* {- #set t_debug 0} ] {
        set repos_rows ""
        set putzwindow ""

        tasks::twait -> init_nrows fsize repos_rows putzwindow    ;# max rows, font size to use, and if present monitor size vertical for repos, and putz window will open, 
        if { $init_nrows eq "" } {
            set init_nrows 10                   ;# default rows
        }
        tasks::treturn "initial rows: $init_nrows $repos_rows $putzwindow"
        
        if { $fsize eq "" } {
            set fsize 10                        ;# default font size if caller didn't supply one (missing args are always null)
        }
        if { $putzwindow ne ""  && $putzwindow} {
            tasks::putz "Initial rows: |$init_nrows|  Font Size = |$fsize| repos rows = |$repos_rows| putzwindow = |$putzwindow|"
        }
#       -------------------------------- gui ---------------------------------------------------------
        package require Tk
        wm withdraw .
        
        toplevel .top
        wm title .top  "TaskMonitor"
        set refresh_seconds 2                   ;# this also determines how long a changed value stays pink, user can change with spinbox
        set pause           0                   ;# we pause by just continuing in the main loop
        set changes         1                   ;# indicate changes with color
        set reposX          825
        set reposY          400
        set ontop           0
        
        ttk::labelframe .top.frame              -text "  Task Monitor Controls  "   -padding [list 5 2 5 2]
        
        ttk::labelframe .top.frame.delay        -text "Refresh  / Font"
        ttk::spinbox    .top.frame.delay.sb     -from .5  -to 5    -increment .5    -textvariable refresh_seconds   -width 4   -font {TkTextFont 14}
        ttk::spinbox    .top.frame.delay.sb2    -from 6   -to 20   -increment 1     -textvariable fsize             -width 4   -font {TkTextFont 14} -command [list font_callback]
        
        ttk::labelframe .top.frame.repos        -text "reposition X / Y"
        ttk::spinbox    .top.frame.repos.x      -from 100 -to 2000 -increment 25    -textvariable reposX -width 4   -font {TkTextFont 14}
        ttk::spinbox    .top.frame.repos.y      -from 100 -to 2000 -increment 25    -textvariable reposY -width 4   -font {TkTextFont 14} 
        button          .top.frame.repos.b1     -text " Reposition "                -command {repos_callback} 
        
        ttk::labelframe .top.frame.pause        -text "Pause All"
        button          .top.frame.pause.on     -text " On "        -command {do_pause on} 
        button          .top.frame.pause.off    -text " Off "       -command {do_pause off} 
        
        button          .top.frame.b3           -text "Exit"        -command {exit}
        button          .top.frame.b4           -text "Send Cmd"    -command {tasks::send_command}
        checkbutton     .top.frame.c1           -variable pause     -relief raised  -text "Pause"
        checkbutton     .top.frame.c2           -variable changes   -relief raised  -text "Color New"
        checkbutton     .top.frame.c3           -variable ontop     -relief raised  -text "On Top" -command {do_ontop}
        
        balloon::balloon .top.frame.b4          -text "Opens 2 windows, one to send commands\nand another to view results"
        balloon::balloon .top.frame.repos.b1    -text "Using X and Y spinboxes, will\nreposition/resize all putz windows"
        balloon::balloon .top.frame.c2          -text "Change color of changed fields, briefly\ntime depends on refresh interval"
        balloon::balloon .top.frame.delay       -text "Refresh in seconds and Font size 6-20"
        balloon::balloon .top.frame.pause       -text "Turn on or off all pause checkboxes \nin putz windows" -showdelay 200
        balloon::balloon .top.frame.c1          -text "Pauses this task monitor"
        balloon::balloon .top.frame.c3          -text "Keeps this window on top"
#       balloon::balloon xxxxx  -text ""
#       balloon::balloon xxxxx  -text ""
        pack    .top.frame                                                  -side top   -expand 0 -fill x
        
        pack    .top.frame.delay .top.frame.delay.sb .top.frame.delay.sb2   -side left  -expand 0 -fill x
        pack    .top.frame.repos .top.frame.repos.x  .top.frame.repos.y     -side left  -expand 0 -fill x
        
        pack    .top.frame.repos.b1                                         -side left  -expand 1 -fill both
        pack    .top.frame.pause                                            -side left  -expand 0 -fill both
        pack    .top.frame.b4           .top.frame.c2   .top.frame.c3 \
                .top.frame.c1           .top.frame.b3                       -side left  -expand 1 -fill both
        pack    .top.frame.pause.on     .top.frame.pause.off                -side left  -expand 0 -fill both
        
        wm geom .top 892x318+128+128
        wm protocol .top WM_DELETE_WINDOW {putz "Can't close the monitor, pause and use minimize \nputz windows can be closed and reopened however" yellowonblack}
#       -----------------------------------------------------------------------------------------
        
#       ;proc xputs  {args} {
#       }
        set widths  {15   3   7     5      20     15     30    28     15    4   25  }       ;# column widths initially, user can resize
        set headers {Task row count Q-len rvar   share result error caller putz user}       ;# column headings
        
        
        set nrows $init_nrows                               ;# initial number of rows, now will add rows as needed, note this must be global for callbacks to work
        set ncols [expr {   [llength $headers] - 1   }]     ;# number of columns-1
        
        set once 0
        
        set path [create_frame .top]
        create_table .top $path $nrows $ncols $widths $headers $fsize
        
        set ntasks -1
        set maxflag 1
#       set t_task_pause 1
        proc do_pause {arg} {
            if { $arg eq "on" } {
                set p 1
            } else {
                set p 0 
            }
            set tnames [lsort -dictionary -stride 2 [array get ::table *,0]]
            dict for {ind tn} $tnames {
#               tasks::putz "ind = $ind, tn = $tn"
                if { $ind eq "0,0" || $tn eq "_taskmonitor" || $tn eq "" } {
                    continue
                }
#               tasks::putz "                                 turn pause $arg for $ind / $tn   "
                set tid [tasks::tset $tn tid]
                if { ! [thread::exists $tid]} {
                    continue
                }
#               tasks::putz "                                  $tid"
                thread::send -async $tid "set t_task_pause $p"
            }
        }
        
        proc do_ontop {args} {
            tasks::putz "new on top $::ontop"   
            wm attributes .top -topmost $::ontop
        }



        
        proc setfont {size} {
#           tasks::putz "new font size $size"   
            for {set r 0} {$r <= $::nrows} {incr r} {
                for {set c 0} {$c <= $::ncols } {incr c} {
                    set w $::widget($r,$c)
                    $w configure -font "TkTextFont $size"
                }   
            }
        }
        
        proc font_callback {args} {
            setfont $::fsize
            event generate .top.fra.scframe.canvas <Configure> ;# should be able to compute this widget path, but...
        }
        proc repos_callback {} {
            tasks::repos ${::reposX}x$::reposY $::repos_rows
        }
        
#       ---------------------------- main monitoring loop -------------------------------------
        
        while 1 {
            tasks::tpause_check
            if { $pause } {
                tasks::wait 1000
                continue
            }
            set geom [wm geom .top]
            set tasks [tasks::tdump +,tid\t]
            set len [llength $tasks]
            if { $len != $ntasks } {
                set ntasks $len
            }
            
            set row 0
            foreach t $tasks {          ;# check each task for changes
                incr row
                if { $row > $nrows} {
                    add_row $row
                }
                if { $row > $nrows} { ;# if still true, something is wrong we will punt
                    if { $maxflag } {
                        set maxflag 0 ;# don't report this again
                        tasks::putz "Cannot process task $t row $row > max rows $nrows"
                        tasks::tset _taskmonitor error "Exceeded max rows, skipping..."
                    }
                    continue
                }
                set tname [lindex [split $t ,]   0 ]
                set table($row,0) $tname
                set temp [tasks::tset $tname tid]
                if { ! [thread::exists $temp] } {
                    $::widget($row,0) configure -bg pink    ;# indicate the thread has exited (probably an error)
                } else {
                    $::widget($row,0) configure -bg grey80  ;# otherwise back to normal
                }
                set column 0
                foreach item {row  count queue gvar share result error pid putz user} {
                    incr column
                    if { $item eq "row" } {
                        set ::table($row,$column) $row
                        continue
                    }
                    if { $item eq "queue" } {
                        set temp [tsv::llength tvar $tname,queue]   ;# current value
                        if { $temp == 0 } {
                            set temp ""
                        }
                        set tval $::table($row,$column)             ;# table value now
                        set ::table($row,$column) $temp             ;# new value
                    } elseif { $item eq "count" } {
                        set temp [tasks::tset $tname $item]         ;# current value
                        if { $temp == 0 } {
                            set temp ""
                        }
                        set tval $::table($row,$column)             ;# table value now
                        set ::table($row,$column) $temp             ;# new value
                    } elseif { $item eq "pid" } {
                        set temp [tasks::tset $tname $item]         ;# current value
#                       tasks::putz "item= |$item| temp= |$temp| tname= |$tname| row= |$row| column= |$column| "
                        if [catch {
                            set temp [tasks::tname $temp]
                        } err_code] {
                            set temp "$err_code"
                        }
                        set tval $::table($row,$column)     ;# table value
                        set ::table($row,$column) $temp     ;# update the table to the current
                    } else {
                        set temp [tasks::tset $tname $item] ;# current value
                        set tval $::table($row,$column)     ;# table value
                        set ::table($row,$column) $temp     ;# update the table to the current
                    }
                    
                    if { $temp != $tval } {
                        if { $changes } {
                            $::widget($row,$column) configure -bg pink  ;# show this changed
                        }
                    } else {
                        $::widget($row,$column) configure -bg grey97    ;# back to this if not changed
                    }
                }
            }
            if { $once == 0 } {
                wm geom .top 1495x312+2+2
                incr once
            }
            tasks::wait [expr {  int( $refresh_seconds * 1000 )   }]
#           wm withdraw .
        }
        
        
    } ;# end task def
    
#proc end task def

#   startup 
    tcall  $::_taskmonitor  ::tasks::mon_start   <- {*}$args
    tset _taskmonitor user "args: $args"
    return ""
} ;# end task_monitor proc

    proc send_command {} {
        tasks::Task sendcmd -import_tasks {{-package require Tk} tasks::twidgets balloon::*} {
                
                ############################################
                # RS menu code from wiki (with my changes)
                ############################################
                
            proc menu:create {w menulist} {
                if {$w=="."} {set w2 ""} else {set w2 $w}
                menu $w2.menubar ; $w config -menu $w2.menubar
                foreach {hdr items tearoff} $menulist {menu:add $w $hdr $items $tearoff} ;# mine has a 3rd item for a tearoff 0/1
            }
            proc menu:add {w top descr {tearoff 0}} {
                if {$w=="."} {set w ""}
                set it $w.menubar.m$top
                if {![winfo exists $it]} {
                    menu $it -font {consolas 12} -tearoff $tearoff
                    $w.menubar add cascade -label $top -menu $it -underline 0
                }
                foreach {label cmd} $descr {
                    if {$label=="--"} {$it add separator; continue}
                    if {[regexp {^-(.+)} $label -> label]} {
                        set state disabled
                    } else {set state normal}
                    if ![catch {$it index $label}] continue ;# label was there
                    if {[regexp {^x (.+)} $label -> label]} {
                        regsub -all " " $label "_" xlabel
                        $it add check -label $label -state $state\
                                -variable ::$xlabel -command $cmd
                    } elseif {[regexp {^R (.+)} $label -> label]} {
                        catch {$it add cascade -label $label -menu $it.r$label}
                        set radi [menu $it.r$label -tearoff 0]
                        foreach {varname default} $cmd break
                        global $varname
                        set $varname $default
                        foreach {txt cmd} [lrange $cmd 2 end] {
                            $radi add radio -label $txt -variable $varname -command $cmd
                        }
                    } else {
                        $it add command -label $label -state $state -command $cmd -font {consolas 12}
                    }
                }
            }
            
            proc menu:delete {w top label} {
                if {$w=="."} {set w ""}
                set it $w.menubar.m$top
                catch {$it delete [$it index $label]}
            }
                
                ######################################################
                # RS history entry code from wiki (with my changes)
                #####################################################
                
            namespace eval history {}
                
            proc history::add? {w {this {}}} {
                variable $w
                variable n$w
                upvar 0 $w hist
                set s [set ::[$w cget -textvariable]]
                if {$s == ""} return
                if { $this ne "" } { ;# manual entry into history
                    lappend hist $this
                    set n$w [llength $hist]
                }
                if [string compare $s [lindex $hist end]] {
            #           putz "not equal s= /$s/ hist = /[lindex $hist end]/"
                    lappend hist $s
                    set n$w [llength $hist]
                } else {
            #           putz "equal s= /$s/ hist = /[lindex $hist end]/"
                    set n$w [llength $hist] ;# correction, if used one from history, we want it on the next up
                }
            }
            proc history::move {w where} {
                variable $w
                variable n$w
                upvar 0 $w hist
                incr n$w $where
                if {[set n$w]<0} {set n$w 0}
                if {[set n$w]>=[llength $hist]+1} {
                    set n$w [llength $hist]
                }
                set ::[$w cget -textvar] [lindex $hist [set n$w]]
            }
            proc history::for {type name args} {
                switch -- $type {
                    entry {
                        uplevel $type $name $args
                        bind $name <Up> {history::move %W -1; %W selection clear; %W icursor end}
                        bind $name <Down> {history::move %W 1;%W selection clear; %W icursor end}
                        bind $name <Next> {history::move %W 99999; %W selection clear}
                        bind $name <Return> {history::add? %W ; %W selection clear}
                        variable $name {}
                        variable n$name 0
                    }
                    default {error "usage: history::for entry <w> <args>"}
                }
            }
                
#proc gui setup for sendcmd
                
            tasks::twait -> widget1 widget2
            set t_debug 0 ;# use debug window to log sent commands and return results
            
    #    ------------------------ gui setup ----------------------
            wm title . "Send Command"
            wm attributes .  -topmost 1 ; wm geom . 1000x69+10+10
            
            set ::tcl_wordchars {\S}
            set ::tcl_nonwordchars {[\[\]\{ \$\:\(\)\|\"\n\\/]}
            
            ttk::labelframe .f -text "Taskname (or pattern or tid)                      Send command"
            history::for entry .f$widget1 -textvar ent1 -font {consolas 12} -width 20 -relief groove -bd 5
            history::for entry .f$widget2 -textvar ent2 -font {consolas 14} -width 20 -relief groove -bd 5 -validate key -validatecommand {do_validate %d %P %s %V %W}
            button  .f.up                 -text " \u2191 "  -font {TkDefaultFont 14 roman}  -command [list event generate .f$widget2 <Up>]   -relief groove -bd 5
            button  .f.down               -text " \u2193 "  -font {TkDefaultFont 14 roman}  -command [list event generate .f$widget2 <Down>] -relief groove -bd 5
            button  .f.doit     -text "Send"  \
                                -command  "focus .f$widget2; event generate .f$widget2 <Return> ; event generate .f$widget2 <Up>" \
                                -relief groove -bd 5
            pack    .f                      -fill both -expand true  -side left
            pack    .f$widget1              -fill both -expand false -side left
            pack    .f$widget2              -fill both -expand true  -side left
            pack    .f.up .f.down .f.doit   -fill both -expand false -side left
            
            bind    .f$widget2 <Return> {+  do_send $ent1 $ent2}
            bind    .f$widget1 <MouseWheel>         {+  do_wheel %D 1}
            bind    .f$widget2 <MouseWheel>         {+  do_wheel %D 2}
            
            bind    .f$widget1 <Button-4>           {+  do_wheel 1 1}
            bind    .f$widget1 <Button-5>           {+  do_wheel -1 1}
            bind    .f$widget2 <Button-4>           {+  do_wheel 1 2}
            bind    .f$widget2 <Button-5>           {+  do_wheel -1 2}
            
#           bind    .f$widget2 <<Paste>>            {+ }             ;# using validate instead of this
            bind    .f$widget2 <F1>                 {+  do_extend 1} ;# for now, we only handle extending, not shrinking
            bind    .f$widget2 <Shift-Key-Escape>   {+  do_fill 1}
            bind    .f$widget2 <Key-Escape>         {+  do_fill 0}
            bind    .f$widget2 <Key-Tab>            {+  do_tab %W ; break}
            
set fhelp {Send a command to a task or thread. If the task entry is blank
it will use the main thread. Wild cards are only used for tasks.

Use an <Escape> to finish 1 square-bracket,  paren, or brace at the
right end. <Shift-Escape> will finish them all. After finishing,
the text between the brackets is selected so be careful. F1 will 
extend the selection, if any, by one char on each side.

The <tab> key will attempt to fill in variable names or commands
The mousewheel can also be used here for the up/down history.}

            balloon::balloon .f             -dismissdelay 40000 -showdelay 2000 -text $fhelp
            
            balloon::balloon .f.up          -text "Go back to previous commands from history"
            balloon::balloon .f.down        -text "Go forward to next command in history"
            balloon::balloon .f.doit        -text "This will send a command and do an <up>"

    #    ------------------------ gui setup end ------------------
        
#           tasks::putz "widget2 .f$widget2"
            tasks::putz "Results from sent commands output here.\nTask putz output goes to separate putz windows\nThe widget tree option requires BWidgets"
            
            set ::Always_on_Top 1
            set ::Add_Separator_Line 1
            set ::all_tasks {}
            set ::Color green
            proc  do_validate {action new old type widget} {
                set temp [string map  {"\t" " "} $new]
                if { $temp eq $new } {
                } else {
                    putz "cannot have tabs in a pasted string, changing to spaces" red
                    after idle [list set ::ent2 $temp]
                }
                $widget selection clear
                return 1
            }
            proc closeem {line} {
                set positions {}
                set out {}
                set in [lreverse [split $line {}]]
                set n [string length $line]
                set paren 0
                set brace 0
                set bracket 0
                set quote 0
                set ob "\{"
                set cb "\}"
            
             
                foreach char $in {
                    incr n -1
                    if       { $char eq "\"" } {
                        if { $quote } {
                            set quote 0
                        } else {
                            set quote 1 
                        }
                    } elseif { $quote > 0 } {
                    } elseif {  $char eq "\(" } {
                        if { $paren > 0 } {
                            incr paren -1
                        } else {
                            append out ")"  ; lappend positions $n
                        }
                    } elseif {  $char eq "\[" } {
                        if { $bracket > 0 } {
                            incr bracket -1
                        } else {
                            append out "\]" ; lappend positions $n
                        }
                    } elseif {  $char eq $ob } {
                        if { $brace > 0 } {
                            incr brace -1
                        } else {
                            append out $cb  ; lappend positions $n
                        }
                        
                    } elseif {  $char eq "\)" } {
                        incr paren
                    } elseif {  $char eq "\]" } {
                        incr bracket
                    } elseif {  $char eq $cb } {
                        incr brace
                    } else {
                    }
                }
                    return [list $out $positions]
            }
            proc do_fill {all} {
                set c [closeem $::ent2]
                lassign $c out positions
                if {! $all } {
                    set out [string index $out 0]
                    set positions [lindex $positions 0]
                } else {
                }
                set n -1
                set before $::ent2
                foreach p $positions {
                    set out1 [string index $out [incr n]]
                    set ::ent2 "$::ent2$out1"
                    .f$::widget2  icursor end
                    set endstr [expr {   [string length $::ent2]-1   }]
                    .f$::widget2 selection clear
                    .f$::widget2 selection from $endstr
                    .f$::widget2 selection to [expr {   $p+1   }]
                    if { $n+1 < [llength $positions] } {
                        wait 150
                    } else {
                    }
                }
                if { $before ne $::ent2 } {
                    history::add? .f$::widget2 $before
                }
            }
            proc do_extend {direction} {
                if [catch {
                    set first [.f$::widget2 index sel.first]
                    set last  [.f$::widget2 index sel.last]
                    set len [string length $::ent2]
                    if { $first < 1 || $last > $len-1 || $first >= $last } {
                        putz "Cannot extend selection (on both ends)" red
                        return
                    }
                    .f$::widget2 selection from [expr {   $first-1   }]
                    .f$::widget2 selection to   [expr {   $last+1   }]
                } err_code] {
                    putz "extend error: $err_code" red
                    return
                }
            }
            
            
####################### tab fill in ##########################################################          
            
proc EvalAttached {args} {
    global ent1 ent2
    set result ""
    set use ""
    if       { $ent1 eq "" } { ;# if blank try to get mainthread tid
        if [catch {
            set use [tsv::set main mainthread]
        } err_code] {
            error "cannot find mainthread tid: $err_code "
            return ""
        }
    } else { ;# not blank, check if a task name first, then an existing and valid tid
        if [catch {
            set use [tset $::ent1 tid] ;# is it a valid taskname
        } err_code] {
            if [catch {
                set atid [thread::exists $::ent1]
                if { $atid } {
                    set use $::ent1
                } else {
                    error "thread does not exist tid: $ent1"    
                }
            } err_code] {
                error "cannot use tid $use: $err_code "
            }
        }
    }
    if [catch {
        set zzz [thread::send $use [list uplevel #0 {*}$args]]
        set result $zzz
    } err_code err_dict] {
        error "cannot send to $use, $err_code $err_dict"
    }
    return $result
}


proc ExpandProcname str {
    set match [EvalAttached [list info commands $str*]]
    if {[llength $match] == 0} {
        set ns [EvalAttached \
                "namespace children \[namespace current\] [list $str*]"]
        if {[llength $ns]==1} {
            set match [EvalAttached [list info commands ${ns}::*]]
        } else {
            set match $ns
        }
    }
    if {[llength $match] > 1} {
        regsub -all { } [ExpandBestMatch $match $str] {\\ } str
        set match [linsert $match 0 $str]
    } else {
        regsub -all { } $match {\\ } match
    }
    if       { [llength $match] == 1  } {
        return $match
    } elseif { [llength $match] > 1  } {
        return [lrange $match 1 end]
    } elseif { [llength $match] == 0  } {
        return ""
    } else {
        error "cannot happen match length error"
    }
    
}

# borrowed from the console code, we cannot do all of it since 
# an entry has less abilities than a text widget

proc ExpandVariable str {
    if {[regexp {([^\(]*)\((.*)} $str -> ary str]} {
        ## Looks like they're trying to expand an array.
        set match [EvalAttached [list array names $ary $str*]]
        set match [lsort -dictionary $match]
        if {[llength $match] > 1} {
            set vars $ary\([ExpandBestMatch $match $str]
            foreach var $match {
                lappend vars $ary\($var\)
            }
            return [lrange $vars 1 end]
        } elseif {[llength $match] == 1} {
            set match $ary\($match\)
            return $match
        }
        ## Space transformation avoided for array names.
    } else {
        set match [EvalAttached [list info vars $str*]]
        if {[llength $match] > 1} {
            regsub -all { } [ExpandBestMatch $match $str] {\\ } str
            set match [linsert $match 0 $str]
        } else {
            regsub -all { } $match {\\ } match
            return $match
        }
    }
    return [lrange $match 1 end]
}

proc ExpandBestMatch {l {e {}}} {
    set ec [lindex $l 0]
    if {[llength $l]>1} {
        set e [expr {[string length $e] - 1}]
        set ei [expr {[string length $ec] - 1}]
        foreach ll $l {
            while {$ei>=$e && [string first $ec $ll]} {
                set ec [string range $ec 0 [incr ei -1]]
            }
        }
    }
    return $ec
}


proc choose {w choices {start 0} {max 20} {kind ?}} {
    unset -nocomplain ::the_choice
    catch {destroy .p}
    menu .p -tearoff 0
    update ; # <===========================================================
    .p  add command -label "-none- [string range $kind 6 end]" -command "set ::the_choice {-none-} " -font {arial 12}
    set n $start
    foreach choice  [lrange [lsort -dictionary $choices]  $start  [expr {   $start+$max-1   }]] {
        if { $choice eq "" } {
            continue
        }
        .p  add command -label "[incr n] $choice" -command "set ::the_choice $choice " -font {arial 12}
    }
    if { $start+$max < [llength $choices]} {
        .p  add command -label "-next-" -command "set ::the_choice {-next-} " -font {arial 12}
    }
    set coords [lrange [split [wm geom .] +] 1 end]
    set zzz [tk_popup .p {*}$coords 1]
#                                                                                   update
    if {! [info exist ::the_choice] } {
        vwait  ::the_choice
    }
    return $::the_choice
    
}

proc getchoice {w choices kind} {
                                                                                    putz "in getchoice: choices= |$choices|  [llength $choices]"
    if { [llength $choices] == 1 } {
                                                                                    putz "only the one: $choices"
        set ::the_choice $choices
        return $choices
    }
    set next 0
    set max 20
    while { 1 } {
        choose $w $choices $next $max $kind
        wait 100
        if { ![info exist ::the_choice] } {
            set ::the_choice "-none-"
        }
        if       { $::the_choice eq "-none-" } {
            set ::the_choice ""
            break
        } elseif { $::the_choice eq "-next-" } {
            incr next $max
            if { $next > [llength $choices] } {
                set ::the_choice ""
                break
            }
            continue
        } else {
            break
        }
    }
    return $::the_choice
}


proc do_tab {window} {                      ;# callback for a tab char
    set cur [$window index insert]
    set str [$window get]
    set sym [string range $str 0 $cur-1]
    set rev [string reverse $sym]
    
    
    regexp -nocase -linestop -lineanchor {([^\[^\\\] \t\n\r\}\{\"\$\)]*)(.)?} $rev -> result  prior
    set astr [string reverse $result]
    set pos1 [expr {   $cur - [string length $astr]   }]
    if { $astr eq "" } {
        return
    }
    
    set none 0
    set before $::ent2
    foreach kind {ExpandVariable ExpandProcname} {  ;# don't bother with the path name expand
        if { $pos1 == 0 && $kind eq "ExpandVariable" } { ;# we don't try if the word begins in col 0
            continue
        } elseif {$prior eq "\[" && $kind eq "ExpandVariable"} { ;# and if it is preceeded by an open bracket, we assume it's a command
            continue
        }
        set rep1 [$kind $astr]
        
        if { $rep1 eq ""  || [string length $rep1] < [string length $cur]} {
            continue
        } elseif {[llength $rep1] == 0} {
            set replacement ""
            continue
        } elseif {[llength $rep1] > 1} {
            set c [getchoice $window $rep1 $kind]           ;# more than 1, give user a choice
            if { $c eq "" } {
                return
            }
            set replacement $c
            incr none
            break
        } elseif {[llength $rep1] == 1} {
            set bg [$window cget -bg]               ;# the best we can do is flash the background, green is for ok
            $window configure -bg LightGreen
            wait 250
            $window configure -bg $bg
            set replacement $rep1
            incr none
            break
        }
    }
    if { $none == 0 } {
        set bg [$window cget -bg]                   ;# if we couldn't find anything, flash pink (red is too dark)
        $window configure -bg pink
        wait 250
        $window configure -bg $bg
        return
    }
    
    set new [string replace $str $pos1 $cur-1 $replacement]
    set rlen [string length $replacement]
    set olen [string length $result]
    set move [expr {   $rlen - $olen  }]
    $window delete 0 end
    $window insert 0 $new
    set newpos [expr {    $move + $cur   }]
    $window icursor $newpos
    if { $before ne $::ent2 } {
        history::add? .f$::widget2 $before
    } else {
    }
}
            
            
        
#proc #################################################################################         
            
            proc do_send {ent1 ent2} {
                set rcolor $::Color
                putz "ent1= |$ent1| ent2= |$ent2| " yellowonblack
                if { $ent1 eq "" } {
                    set ::ent1 [tsv::set main mainthread]
                    set ent1 $::ent1
                }
                
                if [catch {
                    set atid [thread::exists $ent1]
                } err_code] {
                    set atid 0
                }
                if { ! $atid } {
                    set senders 0
                    foreach t $::all_tasks {
                        if { [string match -nocase $ent1 $t]} {
                            incr senders
                            putz "thread::send [tset $t tid] / $t \{$ent2\}"; 
                            if {$ent2 ne ""} {
                                set bline ""
                                if { $::Add_Separator_Line } {
                                    set bline {tasks::putz "" green ;}
                                }
                                set zzz [thread::send [tset $t tid] $bline$ent2]
                                set vline "\u250B"
                                putz "return from $t: $vline$zzz$vline" $rcolor
                            } else {
                                putz "empty not sent";set zzz ""
                            } ;
                        } else {
                        }   
                    }
                    if { $senders == 0 } {
                        putz "No tasks or tid for $ent1" rederror
                    }
                } else { ;# it's a tid
                    if {$ent2 ne ""} {
                        set bline ""
                        if { $::Add_Separator_Line } {
                            set bline {tasks::putz "" green ;}
                        }
                        set zzz [thread::send $ent1 $bline$ent2]
                        set vline "\u250B"
                        putz "return from $ent1: $vline$zzz$vline"  $rcolor
                    } else {
                        putz "empty - not sent";set zzz ""
                    } ;
                }
#               event generate .f$::widget1 <Return> ;# so the task/tid entry gets into the history
                history::add? .f$::widget1
                set ::ent2 "";
                return
            }

            proc do_ontop {args} { ;# toggle on top
                wm attributes . -topmost $::Always_on_Top
            }
            proc do_minimize {args} { ;# minimize window
                set ::ent2 {wm withdraw .taskdebug ;# sent this}
                .f.doit invoke
            }
            proc do_wheel {direction which} {
                if { $which == 2 } {
                    focus -force .f$::widget2
                    if { $direction < 0 } {
                        event generate .f$::widget2 <Down>
                    } else {
                        event generate .f$::widget2 <Up>
                    }
                } else {
                    focus -force .f$::widget1
                    if { $direction < 0 } {
                        event generate .f$::widget1 <Down>
                    } else {
                        event generate .f$::widget1 <Up>
                    }
                }
            }
            proc do_widget_tree {args} {
                set ::ent2 {tasks::twidgets ;# sent this}
                .f.doit invoke
            }
            proc do_clear {args} {
                set ::ent2 {.taskdebug.ttttt delete 1.0 end ;# sent this}
                .f.doit invoke
            }
            proc do_see_end {args} {
                set ::ent2 {.taskdebug.ttttt see end ;# sent this}
                .f.doit invoke
            }
            proc do_tlg {arg} {
                
                if       { $arg == 1 } {
                    set ::ent2 {tasks::tlg }
                    focus -force .f$::widget2 
                    .f$::widget2 icursor end
                } elseif { $arg == 2 } {
                    set ::ent2 {tasks::tlg * \u250B 99 ;# * is a glob pattern}
                    focus -force .f$::widget2 
                    .f$::widget2 selection range 11 12
                    .f$::widget2 icursor 12
                } elseif { 0 } {
                    dothis
                } elseif { 0 } {
                    dothis
                } else {
                    dothis
                }
            }
            proc do_tla {arg} {
                if       { $arg == 1 } {
                    set ::ent2 {tasks::tla array}
                    focus -force .f$::widget2 
                    .f$::widget2 selection range 11 end
                    .f$::widget2 icursor end
                } elseif { $arg == 2 } {
                    set ::ent2 {tasks::tla array *}
                    focus -force .f$::widget2 
                    .f$::widget2 selection range 11 16
                    .f$::widget2 icursor 16
                } elseif { $arg == 3 } {
                    set ::ent2 {tasks::tla array * 1}
                    focus -force .f$::widget2 
                    .f$::widget2 selection range 11 16
                    .f$::widget2 icursor 16
                } elseif { 0 } {
                    dothis
                } else {
                    dothis
                }
            }
            proc do_font {size} {
                global widget2
                if { $size eq "tiny"  } {
                    .f$widget2 configure -font {consolas 9}
                } elseif       { $size eq "small" } {
                    .f$widget2 configure -font {consolas 11}
                } elseif { $size eq "medium"  } {
                    .f$widget2 configure -font {consolas 14}
                } elseif { $size eq "large"  } {
                    .f$widget2 configure -font {consolas 16}
                } else {
                    error "bad font menu"
                }
            }
            
            proc do_refresh_tasks_menu {args} {
                set tasks [tdump +,tid\t ]
                
                set tt {}
                foreach t $tasks {
                    lassign [split $t ,] name tid
                    if { ($name eq "_taskmonitor" || $name eq "sendcmd" ) && ![info exist ::t_overide] } {
                        continue
                    }
                    lappend tt $name
                }
                if { $::all_tasks == $tt } {
                    after 2000 do_refresh_tasks_menu
                    return
                }
                putz "Task menu updated to: ($tt)" green
                
                set ::all_tasks {}
                foreach t $tasks {
                    lassign [split $t ,] name tid
                    menu:delete . Task $name
                }
                foreach t $tasks {
                    lassign [split $t ,] name tid
                    if { ($name eq "_taskmonitor" || $name eq "sendcmd" ) && ![info exist ::t_overide] } {
                        continue
                    }
                    menu:add . Task [list $name "set ent1 $name; history::add? .f$::widget1"  ]
                    lappend ::all_tasks $name
                }
                after 2000 do_refresh_tasks_menu
            }
            proc do_lookup {args} {
                if {$::tcl_platform(platform) ne "windows"   } {
                    exec xdg-open "https://www.magicsplat.com/tcl-docs/docindex.html?search=$::ent2" &

                } else {
                    exec cmd.exe /c start "https://www.magicsplat.com/tcl-docs/docindex.html?search=$::ent2" &
                }
            }
            
#           we added a 3rd item for each menu, a tearoff boolean, for Task we populate dynamically, so start off empty
            menu:create . {
                Task {
                } 1
                Commands {
                    "tlg"                           {do_tlg 1}
                    "tlg pattern delim max-width"   {do_tlg 2}
                    -- {}
                    "tla array"                     {do_tla 1}
                    "tla array *"                   {do_tla 2}
                    "tla array * match-data"        {do_tla 3}
                    -- {}
                    "x Add Separator Line"          {}
                    -- {}
                    "Wiget Tree Tool"               {do_widget_tree}
                    -- {}
                    "See   putz Win at end"     {do_see_end}
                    "Hide  putz Win"            {do_minimize}
                    "Clear putz Win"            {do_clear}
                    -- {}
                    "Lookup with browser"           {do_lookup}
                    "Clear Command Entry"           {set ::ent2 ""}
                } 1
                Extra {
                    "Refresh Task Menu"             {do_refresh_tasks_menu}
                    "x Always on Top"               {do_ontop}
                    -- {}
                    "R Font-Size" {
                        Font-Size medium
                        tiny {do_font tiny}
                        small {do_font small}
                        medium {do_font medium}
                        large {do_font large}
                    }
                    "R Color" {
                        Color green
                        normal {set ::color normal}
                        green  {set ::color green}
                        red    {set ::color red}
                    }
                    -- --
                    -- --
                    "Exit"                          {exit}
                } 0
            }
            do_refresh_tasks_menu ;# also first time create too
            wm protocol . WM_DELETE_WINDOW {putz "Can't close sendcmd, use minimize \nputz windows can be closed and reopened however" yellowonblack}

            tasks::treturn ok
            thread::wait
        }
        tasks::tcall $::sendcmd ok <- .t .w       ;# this starts up the sendcmd task
    
    }   ;# end proc send_command    

# widget tree viewer, needs Bwidgets, must add tasks::twidgets to the import list, otherwise this is not imported to task
proc twidgets {} {
    
    set ::tasks::wtreescript {
        proc wtree_:_node_openclose {which} {
            set nodes [.wtree_top.sw.t nodes root]
            #puts "which - $which - $nodes"
            if { $which == "open" } {
                foreach item $nodes {
                    .wtree_top.sw.t opentree $item
                }
                
            } else {
                foreach item $nodes {
                    .wtree_top.sw.t closetree $item
                }
                
            }
        }
        
        proc _wtree_ {{root .} {level 0}} {
            set top .wtree_top
            if {  $level == 0} {
                package require BWidget
                catch {
                    $top.sw.t delete [$top.sw.t nodes root]
                    destroy $top
                }
                toplevel $top
                frame $top.f
                button $top.f.b1 -text "Open" -command {tasks::wtree_:_node_openclose open}
                button $top.f.b2 -text "close" -command {tasks::wtree_:_node_openclose close}
                button $top.f.b3 -text "refresh" -command {tasks::_wtree_}
                pack $top.f  -side top -fill x
                pack $top.f.b1 $top.f.b2 $top.f.b3 -side left -expand yes -fill both
                ScrolledWindow $top.sw
                pack $top.sw -fill both -expand 1 -side top
                Tree $top.sw.t  -deltay 25 -deltax 25 -padx 5 -borderwidth 8 -linesfill orange -padx 5
                #pack $top.sw.t
                $top.sw setwidget $top.sw.t   ;# Make ScrolledWindow manage the Tree widget
                update                ;# Process all UI events before moving on.
                $top.sw.t bindText <1> +tasks::wtree_:_node_puts
                set ::wtree_queued_inserts {}
                wm geom $top 466x326+52+52
                if { [string range $::t_debug 0 1] eq "0x"} {
                    wm withdraw .
                }
                catch {wm title $top "Widgets: $::t_name"}
                
            }
            set children [winfo children $root]
            set class [winfo class $root]
            set info ""
            if       { $class == "Button" } {
                set info [split [$root cget -text] \n]
                
            } elseif { $class == "TLabelframe" } {
                set info [split [$root cget -text] \n]
                
            } elseif { $class == "TButton" } {
                set info [split [$root cget -text] \n]
                
            } elseif { $class == "TEntry" } {
                set info "var: [$root cget -textvariable]"
            } elseif { $class == "TCheckbutton" } {
                set info [split [$root cget -text] \n]
            } elseif { $class == "TButton2" } {
                set info [split [$root cget -text] \n]
            } else {
                
            }
            
            set root [regsub -all : $root _]
            set parts [split [string range $root 1 end] .]
            if { $parts == "" } {
                set parent root
            } else {
                set parent {}
                foreach item [lrange $parts 0 end-1] {
                    append parent .$item
                }
            }
            if { $parent == "" } {
                set parent root
            }
            set cmd "$top.sw.t insert end \{$parent\}   \{$root\}       -font {courier 12} -text  \{$root - $class $info\}"
            lappend ::wtree_queued_inserts $cmd
            
            
            
            if { $children == "" } {
                return $root
            } else {
                foreach child $children {
                    set tout [_wtree_ $child [expr ( $level + 1 )]]
                }
                
            }
            if { $level == 0 } {
                #puts "\n\ndone here\n\n"
                foreach item $::wtree_queued_inserts {
                    #puts "do - $item"
                    eval $item
                }
            }
        }
        
        proc wtree_:_node_puts {args} {
            #   return
            tasks::putz ""
            tasks::putz  $args green
            wtree_:_node_lw $args
            catch {tasks::putz "[pack info $args]" green}
            #   clipboard clear ; clipboard append $args
        }
        proc wtree_:_node_lw {widget} {   # list a widget
            set w [$widget configure]
            foreach item $w {
                set opt [lindex $item 0]
                set val "---"
                catch {set val [$widget cget $opt]}
                set wid($opt) $val
            }
            #la wid
            set vline "\uFFE8 "
            set names [lsort -dictionary [array names wid]]
            set n [llength $names]
            set n2 [expr ( $n/2 )]
            set odd [expr ( $n % 2 )]
            if { $odd } {
                incr n2  ;# so this one is 1 more than half
            }
            if { $odd } {
                for {set m 0;set m2 [expr ( $m+$n2 )]} {$m < $n2} {incr m;incr m2} {
                    
                    if { $m == $n2-1 } {
                        set left [lindex $names $m]
                        set leftt [format {%-20s %-20s} $left $wid($left)]
                        tasks::putz "$leftt${vline}"
                        
                    } else {
                        set left [lindex $names $m]
                        set right [lindex $names $m2]
                        set leftt [format {%-20s %-20s} $left $wid($left)]
                        if { [string length $leftt] > 41 } {
                            set leftt [format {%s %s} $left $wid($left)]
                            set leftt [string range [format %-41s $leftt] 0 40]
                        }
                        set rightt [format {%-20s %-20s} $right $wid($right)]
                        tasks::putz "$leftt${vline}[string trimright $rightt]"
                    }
                }
                
            } else {
                for {set m 0;set m2 [expr ( $m+$n2 )]} {$m < $n2} {incr m;incr m2} {
                    set left [lindex $names $m]
                    set right [lindex $names $m2]
                    set leftt [format {%-20s %-20s} $left $wid($left)]
                    if { [string length $leftt] > 41 } {
                        set leftt [format {%s %s} $left $wid($left)]
                        set leftt [string range [format %-41s $leftt] 0 40]
                    }
                    set rightt [format {%-20s %-20s} $right $wid($right)]
                    tasks::putz "$leftt${vline}[string trimright $rightt]"
                }
                
            }
        }
        
    } ;# ::tasks::wtreescript
    
    eval $::tasks::wtreescript
    tasks::_wtree_
} ;# twidgets

proc tla {array_name {pattern *} {reverse 0} } { # list an array, if reverse, pattern is against data in array
    upvar 1 $array_name array
    if {![array exists array]} {
        error "\"$array_name\" isn't an array"
    }
    set maxl 0
    set pat $pattern
    if { $reverse != 0} { ;# use max width of all since pattern will not be the index, but the data
        set pat *
    }
    foreach name [lsort [array names array $pat]] {
        if {[string length $name] > $maxl} {
            set maxl [string length $name]
        }
    }
    set maxl [expr {$maxl + [string length $array_name] + 2}]
    if {$reverse == 0} {;# match against index
        foreach name [lsort -dictionary [array names array $pattern]] {
            set nameString [format %s(%s) $array_name $name]
            tasks::putz [format "%-*s = %s" $maxl $nameString $array($name)]
        }
    } else { ;# match against data, not the index
        foreach name [lsort [array names array]] {
            #puts stdout "compare pattern $pattern with $name - $array($name)"
            set mat [string match "*$pattern*" $array($name)]
            set outputit 0
            if {$mat && $reverse > 0} {
                set outputit 1
            } elseif {!$mat && $reverse < 0} { ;# this means it did NOT match, and if reverse is negative, then we want those not matching
                set outputit 1
            }
            if { $outputit } {
                set nameString [format %s(%s) $array_name $name]
                tasks::putz [format "%-*s = %s" $maxl $nameString $array($name)]
            }
        }
        
    }
}



proc tlg {{pat **} {delimeter |} {max 80}} {          # list globals in threads
    if { ![info exist ::___tlg___ ] } {
        set ::___tlg___  [info globals] ;lappend ::___tlg___  ___tlg___ 
    }
    set a [lsort -dictionary [info global ${pat}*]]
    foreach gvar $a {
        if { $gvar in $::___tlg___  && $pat eq "**"} {
            continue
        }
        if {[array exists ::$gvar]} { ;# it is an array get some indices
            set val "() [lsort -dictionary [array names ::$gvar]]"
        } elseif { [info exists ::${gvar}] } {
            set val ${delimeter}[set ::${gvar}]$delimeter
            regsub -all {\n} $val [apply {code {eval set str "\\u[string map "U+ {}" $code]"}} 2936] val ;# or 21B2
        } else {
            continue ;# skip if we cant get the value
        }
        catch {
            tasks::putz [format "--- %-20s = %s" $gvar [string range $val 0 $max]]
        }
    }
}
# from the wiki
 namespace eval ::balloon {
   proc this {} "return [namespace current];";
 
   variable state;
 
   array unset state;
   array set state {};
 
   proc balloon {w args} {
     variable state;
 
     if {[info exists state($w.background)]} {
       foreach var [array names $w.*] {
         set [lindex [split $var "."] end] $state($var);
       }
     } else {
       set background   lightyellow;
       set dismissdelay 10000;
       set foreground   black;
       set label        "";
       set showdelay    1000;
       set text         "";
       set textvariable "";
     }
 
     foreach {option value} $args {
       set var  [string range $option 1 end];
 
       switch -exact -- $option {
         -bg         -
         -background -
         -fg         -
         -foreground {
           if {[string match "f*" $var]} {
             set var  foreground;
           } else {
             set var  background;
           }
 
           if {[catch {winfo rgb $parent $value;}]} {
             error "expected valid $var colour name or value, but got \"$value\"";
           }
         }
         -dismissdelay -
         -showdelay    {
           if {![string is integer -strict $value]} {
             error "expected integer delay value in ms, but got \"$value\"";
           }
         }
         -label        {}
         -text         {}
         -textvariable {}
         default  {
           error "bad option \"$option\": must be -background, -dismissdelay, -foreground, -label, -showdelay, or -text";
         }
       }
 
       set $var  $value;
     }
 
     array unset state $w.*;
 
     if {$showdelay == -1} {
       bind $w <Any-Enter> {};
       bind $w <Any-Leave> {};
       return;
     }

     set state($w.background)   $background;
     set state($w.foreground)   $foreground;
     set state($w.dismissdelay) $dismissdelay;
     set state($w.label)        $label;
     set state($w.showdelay)    $showdelay;
     set state($w.text)         $text;
     set state($w.textvariable) $textvariable;
 
 # FIX by [Vitus Wagner]
    if {$showdelay} {
      bind $w <Any-Enter> [list \
         after \
           $showdelay \
           [concat [namespace code showCB] %W] \
       ];
       bind $w <Any-Leave> [concat [namespace code destroyCB] %W];
     }
 
     return;
   }
 
   proc destroyCB {w} {
     variable state;
 
     catch {destroy $w.balloon;};
 
     if {[info exists state($w.id)] && ($state($w.id) != "")} {
       catch {after cancel $state($w.id);};
 
       set state($w.id)  "";
     }
 
     return;
   }
 
   proc showCB {w} {
     if {[eval winfo containing [winfo pointerxy .]] != $w} {
       return;
     }
     
     variable state;
 
     set top    $w.balloon;
     set width  0;
     set height 0;
 
     catch {destroy $top;}

    if {!$state($w.showdelay)} {
      return;
    }
 
     toplevel $top \
       -relief      solid \
       -background  $state($w.foreground) \
       -borderwidth 1;
 
     wm withdraw         $top;
     wm overrideredirect $top 1;
     wm sizefrom         $top program;
     wm resizable        $top 0 0;
     wm attributes       $top -topmost 1;# to force it if the window is topmost, else we behind it and hidden
 
     if {$state($w.label) != ""} {
       pack [label $top.label \
         -text       $state($w.label) \
         -background $state($w.background) \
         -foreground $state($w.foreground) \
         -font       {{San Serif} 10 bold} \
         -anchor     w \
         -justify    left \
       ] -side top -fill x -expand 0;
 
       update idletasks;
 
       set width  [winfo reqwidth $top.label];
       set height [winfo reqheight $top.label];
     }
 
     if {($state($w.text) != "") ||
         ($state($w.textvariable) != "")} {
       if {$state($w.textvariable) != ""} {
         upvar 0 $state($w.textvariable) textvariable;
 
         set state($w.text) $textvariable;
       }
       
       pack [message $top.text \
         -text       $state($w.text) \
         -background $state($w.background) \
         -foreground $state($w.foreground) \
         -font       {{San Serif} 10} \
         -aspect     10000 \
         -justify    left \
       ] -side top -fill x -expand 0;
 
       update idletasks;
 
       catch {
         if {$width < [winfo reqwidth $top.text]} {
           set width [winfo reqwidth $top.text];
         }
 
         incr height [winfo reqheight $top.text];
       }
     }
 
     catch {
       update idletasks;
 
       if {[winfo pointerx $w]+$width > [winfo screenwidth $w] && 0} { ;# no longer doing this, so works better on multi-monitor systems
         set x [expr {[winfo screenwidth $w] - 10 - $width}];
       } else {
         set x [expr {[winfo pointerx $w] + 10}];
       }
       
       wm geometry $top \
         ${width}x${height}+${x}+[expr {[winfo pointery $w]+10}];
       wm deiconify $top;
 
       raise $top;
 
       set state($w.id) [after \
         $state($w.dismissdelay) \
         [concat [namespace code destroyCB] $w] \
       ];
     }
 
     return;
   }
 
   namespace export -clear balloon;
 }



namespace export {*}[info proc] twidgets tla tlg send_command
}
# end of tasks namespace eval

======
 

<<enddiscussion>>
----
<<discussion>>Examples using only the 5 primitives
**** Small example ****

This example runs the proc '''sum''' in a separate thread, perhaps to keep the GUI responsive. It is called first synchronously, and then a second time asynchronously. 
======
    namespace import tasks::*                ;# easiest to just import them all, but could limit to tasks::\[Ttp]* etc.

    proc sum args {foreach arg $args {incr s $arg} ;return $s} ;# sum the arglist items
   
    Task sumserver  -import_tasks {sum} {   ;# import all the tasks::* and also sum, this is a repeating task
            set t_debug 1                   ;# turn on debug tracing
            twait argv                      ;# wait for work and get the args
                set result [sum {*}$argv]   ;# call sum with the input args (note imported proc)
                putz "result= |$result| "   ;# output some debug info
            treturn $result                 ;# send back the results, sets a variable with the result, then repeat from top
    }
    
#   call synchronously:
    
    tcall $sumserver resultvar <- 100 200 300
    puts "resultvar= |$resultvar| " 
    
#   call asynchronously, then wait for it after doing something else 
  
    tcall $sumserver -async resultvar <- 1 2 3 4 5 6 7
#      ... can do something else while it crunches in the background ...
    tvwait resultvar

    puts "resultvar= |$resultvar| " 
    tdump                                   ;#some debug info about the task(s)

======
Here's the output on a linux system with the debug turned on, but where the tk window cannot (currently) be used:

======
$ tclsh wiki-example.tcl
sumserver  ! sname(share name) = || tname(use)= |sumserver| ::t_name(me)= |sumserver| 
sumserver  ! queue not empty len= 1 contents: {tid0x7feb1e590740 ::resultvar {100 200 300}}
sumserver  ! 10:48:03.079 job 1: worklen= |3|     work= |100 200 300| parentid= tid0x7feb1e590740 globalvar= ::resultvar 
sumserver  ! args varname= |argv| rest of variables= ||
sumserver  ! result= |600| 
resultvar= |600| 
sumserver  ! sname(share name) = || tname(use)= |sumserver| ::t_name(me)= |sumserver| 
sumserver  ! queue not empty len= 1 contents: {tid0x7feb1e590740 ::resultvar {1 2 3 4 5 6 7}}
sumserver  ! 10:48:09.153 job 2: worklen= |3|     work= |1 2 3 4 5 6 7| parentid= tid0x7feb1e590740 globalvar= ::resultvar 
sumserver  ! args varname= |argv| rest of variables= ||
sumserver  ! result= |28| 
sumserver  ! sname(share name) = || tname(use)= |sumserver| ::t_name(me)= |sumserver| 
sumserver  ! queue is empty, so wait 0
resultvar= |28| 

------ Task(s) dump -----------------------------------------
tsv::names  = |main tvar tids|
tsv::tids   = |tid0x7feb1d685700 tid0x7feb1e590740|
---------------------------------------------------------------
tid/names   = |tid0x7feb1e590740 mainthread tid0x7feb1d685700 sumserver|
---------------------------------------------------------------
mainthread tid: tid0x7feb1e590740  exists: 1
sumserver  tid: tid0x7feb1d685700  exists: 1
                 (sumserver,cond)     = |cid1| 
                 (sumserver,count)    = |2| 
                 (sumserver,error)    = || 
                 (sumserver,gvar)     = |::resultvar| 
                 (sumserver,mutex)    = |mid0| 
                 (sumserver,pid)      = |tid0x7feb1e590740| 
                 (sumserver,queue)    = || 
                 (sumserver,result)   = |28| 
                 (sumserver,script)   = |#Preamble??namespace eval tasks {}?set ::t_pid tid0x7feb1e590740?set ::t_name sumserver?set| 
                 (sumserver,share)    = || 
                 (sumserver,tid)      = |tid0x7feb1d685700| 
---------------------------------------------------------------
sumserver  ! queue is empty, so wait 50
sumserver  ! queue is empty, so wait 100



======

This example demonstrates using a namespace and array elements for the helper tasks and the result answers. 
======
    namespace import tasks::*
    namespace eval foo {}
    set script {
        twait args                         ;# all the args in a single list, no lassign's needed
        treturn [tcl::mathop::+ {*}$args]
    }
    Task foo::main                -import_tasks $script
    Task foo::helper(1)/foo::main -import_tasks $script
    Task foo::helper(2)/foo::main -import_tasks $script
    
    tcall $foo::main -async foo::answer(1) <- 1 2 3
    tcall $foo::main -async foo::answer(2) <- 1 2 3 4
    tcall $foo::main -async foo::answer(3) <- 1 2 3 4 5
    
    
    foreach i {1 2 3} {
        tvwait foo::answer($i)             ;# wait for all 3 jobs to complete
    }
    parray foo::answer
    tdump -result|,tid                     ;# dump values for (last) result and thread id


# results:
#    
#   foo::answer(1) = 6
#   foo::answer(2) = 10
#   foo::answer(3) = 15
#
#                  (foo::helper(1),result)     = |10| 
#                  (foo::helper(1),tid)        = |tid00004D08| 
#                  (foo::helper(2),result)     = |15| 
#                  (foo::helper(2),tid)        = |tid000037CC| 
#                  (foo::main,result)          = |6| 
#                  (foo::main,tid)             = |tid00003578| 

======




<<enddiscussion>>

<<discussion>>Examples and details using tgroup and Tproc
The '''tgroup''' procedure is a quick way to launch a group of tasks, sharing a single queue, that can be run given a set of arglists. They will run in parallel if possible. The general form is:

===
 to start a new group

     tgroup groupname '''-tasks''' ?-?N .... args to a task beginning with the options (used only 1 time to create a task group)

 to process arglists

     tgroup groupname '''-call'''    {arglist 1} {arglist 2} ... (only 1 of these per -wait and -reset)
     tgroup groupname '''-foreach''' {arglist 1} {arglist 2} ... (can be repeated)

 to wait for all jobs to be done

     tgroup groupname '''-wait''' all                            (wait for all async jobs started since a -reset)
   
 to combine -reset -foreach and -wait all

     tgroup groupname '''-run'''  {arglist 1} {arglist 2} ...    (can use multiple times after -tasks)

 resets the counts to state just after using -tasks

     tgroup groupname '''-reset'''                               (reset indices to 0, clears old args and results from group array)
===
----


The first argument to each '''tgroup''' call is the tasks '''group name '''which is used to create task names (with helpers): group0, group1/group0, group2/group0, .... for a total of N tasks, as given by the '''-tasks''' N option. If it's negative, then use abs(N) and set a flag for traces.  

The group name can also be a qualified namespace name, e.g. '''ns::groupname'''. The namespace must have been created earlier in the program, e.g. '''namespace eval ns {}'''.

Note: The groupname is always global or an explict namespace qualifer. If tgroup is used inside a local scope (e.g. proc) the group name will still be global or an explict namespace can be used.
----
    *  '''-tasks'''

The '''-tasks''' N option starts N tasks/threads. The arguments that follow this option are identical to those in the Task procedure which follow the taskname argument. This option calls the '''Task '''procedure to create the N tasks. It is run just once per task group creatiton. Once created, sets of -run, -foreach, and -call can be issued, and the results found in the group array. After a -reset, these calls can be re-issued for more results. 
----
    *  '''-foreach''' and '''-call'''

The '''-foreach''' option calls the tasks -async for each arglist that follows. This option can be used with one or more arglists (and one or more times) as convenient. The results will be saved in the group array for each arglist until a -reset is used. 

The '''-call''' option also calls the tasks -async for each arglist that follows. If there are fewer arglists than tasks, the list of arglists will repeat at the first one until N jobs are queued, where N is the number of tasks.  Unlike -foreach, it is an error to include more arglists than were created using -tasks N. See the example below that uses a trace option. 

With each of these 2 options If the trace flag was set, a trace is put on each job result, using the group name as a callback procedure.

----
    *  '''-wait'''

The '''-wait all''' option will wait for all the work to complete. It is used once after the previous options have been run.

----
    *  '''-run'''

The option '''-run''' (supplied with args) combines a '''-reset''', '''-foreach arg arg...''' and '''-wait all'''. All the jobs are run '''-async'''. The -reset first clears any args and prior results from the group array.  Each run will produce results for the args given to the '''-run''' option.

===tcl

    tgroup fibonacci '''-tasks''' 4 $script      ;# create 4 tasks

    tgroup fibonacci '''-run''' 10 20 30 40      ;# run 4 jobs and wait
#        ... do somethine with the 4 results ...
    tgroup fibonacci '''-run''' 20 20 30         ;# run 3 more jobs and wait 
#        ... do somethine with the 3 results ...
    tgroup fibonacci '''-run''' 30 20            ;# run 2 more jobs and wait 
#        ... do somethine with the 2 results ...

#   results for each of the -run calls will be found in the group array (fibonacci in this case)
#   the group array also saves the arglists. 
===

    *  '''-reset'''

The '''-reset''' option will clear out any previous results and args, and resets the job count to zero, so further saved results will use indices rvar,* where * = 0 .. n-1 jobs. 

This can be used with the '''-foreach''' option above, which can be run multiple times, and then use the '''-wait all''' option to wait for all the previous jobs started by a -foreach to be done. It will also reset after a '''-call''' and '''-wait all''' pair and so another pair can be run on the same tasks created by the -tasks option.

For example the following will run 3 sets of 2 jobs. It uses the one '''-tasks''' setup, then clears any previous results from '''-foreach''' and '''-wait all''''s and runs 2 jobs. It then loops back 2 more times to clear the results first, and and then another set of 2 jobs. Strictly speaking, the -reset is not needed the first time through the loop, since -tasks already did a reset, but it does no harm.

===tcl

    tgroup fibonacci '''-tasks '''4 $script             ;# create 4 tasks

# Run 3 sets of 2 jobs each using above 4 tasks

    foreach m {1 2 3} {

        tgroup fibonacci '''-reset'''                   ;# reset all counts, args, and results
        tgroup fibonacci '''-foreach''' [[list 1 $m]]     ;# run 1 job that gets sent 2 args
        tgroup fibonacci '''-foreach''' [[list 2 $m]]     ;# another job one with 2 args
        tgroup fibonacci '''-wait''' all                ;# this waits for the 2 -foreach jobs

        # use results for the above 2 -foreach's found in the array fibonacci(rvar,0..1)

    }

===


----
The group name is also used to create a global array with the args and results, plus other info. Results are in rvar,* and arglists in args,* as can be seen in the following example.

The example script below will compute the sum of their arglist numbers and do a busy wait we can monitor for cpu time. It uses the -run option which first does a -reset and then inserts each of the arglists -async into the queue and then does a -wait for all jobs to complete. On a multi-core system the jobs can run in parallel to improve performance. 

======
    namespace import tasks::*
;   proc sum {args} {
        xwait 2000                          ;# simulate 2 seconds of heavy compute
        return [tcl::mathop::+ {*}$args]    ;# use the multi arg add operator
    }
    
    tgroup summer -tasks 4  -import {sum} {   ;# create 4 tasks using the same script
            twait argv
            treturn [sum {*}$argv]
    }
    
    tgroup summer -run {1 2 3} {4 5 6} {7 8 9} ;# run 3 jobs and wait for them 
    
    parray summer args*
    puts ""
    parray summer rvar*

======
The result is:
======
summer(args,0) = 1 2 3
summer(args,1) = 4 5 6
summer(args,2) = 7 8 9

summer(rvar,0) = 6
summer(rvar,1) = 15
summer(rvar,2) = 24

======
Here's an example where we use a trace, by using a -N for number of tasks. The traces use the group name as a proc to be the callback of the trace, which sends 3 args, varname, element, operation. This example uses -call and so the arglist is repeated to fill out the number of tasks.
======
    namespace import tasks::*
;   proc sum {args} {
        lassign $args first
        xwait [expr {   200 * $first   }]   ;# use first number to determine busy wait time
        return [tcl::mathop::+ {*}$args]    ;# use the multi arg add operator
    }
;   proc Time {} {
        set ms [clock milliseconds]
        set secs [expr {   $ms / 1000   }]
        set ms [string range $ms end-2 end]
        return [string range [clock format $secs] 11 18].$ms
    }
    puts "[Time] starting"
#####################################################################

    tgroup summer -tasks -8  -import {sum} { ;# setup 8 tasks, set trace flag 
        twait argv
        treturn [sum {*}$argv]
    }
        
;   proc summer {args} {                     ;# trace callback at each task completion
        lassign $args aname element op
        set value [set ${aname}($element)]
        puts "[Time] [format %-26s |$args| ] aname= |$aname| element= [format %-10s |$element| ] op= |$op| value= |$value| "
    }
    
    tgroup summer -call {1 2 3} {4 5 6} {7 8 9} {10 11 12} ;# when fewer arglists, repeat at front
    tgroup summer -wait all
    
    puts ""
    parray summer args*
    puts ""
    parray summer rvar*

# output:    
#    16:33:02.303 starting
#    16:33:03.006 |::::summer rvar,4 write|  aname= |::::summer| element= |rvar,4|   op= |write| value= |6| 
#    16:33:03.042 |::::summer rvar,0 write|  aname= |::::summer| element= |rvar,0|   op= |write| value= |6| 
#    16:33:04.186 |::::summer rvar,5 write|  aname= |::::summer| element= |rvar,5|   op= |write| value= |15| 
#    16:33:04.226 |::::summer rvar,1 write|  aname= |::::summer| element= |rvar,1|   op= |write| value= |15| 
#    16:33:05.033 |::::summer rvar,2 write|  aname= |::::summer| element= |rvar,2|   op= |write| value= |24| 
#    16:33:05.172 |::::summer rvar,6 write|  aname= |::::summer| element= |rvar,6|   op= |write| value= |24| 
#    16:33:05.520 |::::summer rvar,7 write|  aname= |::::summer| element= |rvar,7|   op= |write| value= |33| 
#    16:33:05.824 |::::summer rvar,3 write|  aname= |::::summer| element= |rvar,3|   op= |write| value= |33| 
#    
#    summer(args,0) = 1 2 3
#    summer(args,1) = 4 5 6
#    summer(args,2) = 7 8 9
#    summer(args,3) = 10 11 12
#    summer(args,4) = 1 2 3
#    summer(args,5) = 4 5 6
#    summer(args,6) = 7 8 9
#    summer(args,7) = 10 11 12
#    
#    summer(rvar,0) = 6
#    summer(rvar,1) = 15
#    summer(rvar,2) = 24
#    summer(rvar,3) = 33
#    summer(rvar,4) = 6
#    summer(rvar,5) = 15
#    summer(rvar,6) = 24
#    summer(rvar,7) = 33

======
This next example compares a sequential vs. a task compute of the total number of digits of 100 fibonacci numbers. The task method is more code, but it also computes the numbers twice, once using a trace callback. Then it traverses the output array of answers. Both the array and the callback have the same name: ''fibonacci''  since '''tgroup''' uses the group name for the array with the output, and also the trace callback.

This example runs 8 tasks (threads) which gain about a 5x speed up over a sequential method. Each task did 12 or 13 jobs (100 / 8) on a 4 core 8 hyperthread intel chip. 
======
    namespace import tasks::*
    
    set nCPUs  8

    set first 20001
    set last  20100
    set tm [time { ;# one thread last-first+1 jobs
############################ sequentially  ########################
        package require math
        proc fibonacci_len {n} {
            return [string length [math::fibonacci $n]]
        }
        
        for {set n $first} {$n <= $last } {incr n} {
            incr total1 [fibonacci_len $n]
        }
###################################################################
    }]
    puts "total1= |[comma $total1]| $tm"
 
 
    
    set tm [time { ;# one thread per cpu, last-first+1 jobs
############################# using tasks #########################
        proc fibonacci {arr element op} {               ;# trace callback
            incr ::total3 [set ${arr}($element)]        ;# sum up each as they finish
        }
        tgroup fibonacci -tasks -$nCPUs -import {fibonacci_len} { ;# set up 1 task per cpu hyperthread
            package require math
            twait ->  n
            treturn [fibonacci_len $n]
        }
        for {set n $first} {$n <= $last } {incr n} {    ;# run the task last-first+1 times
            tgroup fibonacci -foreach $n
        }
        tgroup fibonacci -wait all
        
        set m -1
        for {set n $first} {$n <= $last } {incr n} {    ;# sum up the answers from the array
            incr total2 $fibonacci(rvar,[incr m])
        }
###################################################################       
    }]
    puts "total2= |[comma $total2]| $tm"    
    puts "total3= |[comma $total3]| $tm"    
    tdump -count
    
#   total1= |419,047| 5426745 microseconds per iteration
#   total2= |419,047| 1163442 microseconds per iteration
#   total3= |419,047| 1163442 microseconds per iteration
#                    (fibonacci0,count)   = |13| 
#                    (fibonacci1,count)   = |13| 
#                    (fibonacci2,count)   = |13| 
#                    (fibonacci3,count)   = |13| 
#                    (fibonacci4,count)   = |12| 
#                    (fibonacci5,count)   = |12| 
#                    (fibonacci6,count)   = |12| 
#                    (fibonacci7,count)   = |12| 

======
Below is the same computation using '''Tproc''' and '''tgroup'''. Tproc combines the creation of the fibonacci_len proc along with the tasks which each also import the procedure. 

The Tproc options are to create 8 tasks that each minimally import only '''twait''' and '''treturn''' from tasks::*. A Tproc initializer is used to load the math package outside the created proc fibonacci_len so it's only done once in each task. The commented out '''puts''' can be used to view the Tproc generated thread script.

======
namespace import tasks::*

set first 20001
set last  20100

set tm [lindex [time {                              ;# timimg of a tasks run using Tproc/tgroup
    
    Tproc fibonacci_len {n} {
        return [string length [math::fibonacci $n]]
    } -tasks 8 -min_import_tasks [list {-package require math}]
    
    for {set n $first} {$n <= $last } {incr n} {    ;# run the task last-first+1 times
        tgroup fibonacci_len -foreach $n
    }
    tgroup fibonacci_len -wait all
    
    foreach result [array names fibonacci_len rvar,* ] {
        incr total2 $fibonacci_len($result) 
    }
    
} 1] 0]

#puts [tset fibonacci_len0 script]
puts "total2= |[comma $total2 "_" ]| [comma $tm] microseconds"
tdump -count    

#   total2= |419_047| 1,152,205 microseconds
#                    (fibonacci_len0,count)      = |13| 
#                    (fibonacci_len1,count)      = |13| 
#                    (fibonacci_len2,count)      = |13| 
#                    (fibonacci_len3,count)      = |12| 
#                    (fibonacci_len4,count)      = |12| 
#                    (fibonacci_len5,count)      = |13| 
#                    (fibonacci_len6,count)      = |12| 
#                    (fibonacci_len7,count)      = |12| 
======


This next example demonstrates that the taskname can be a namespace qualified name, for those averse to using the global namespace. Note also that only 3 jobs ran and so the counts were 1 for 3 tasks and 0 for others.
======
    namespace import tasks::*
    proc fibonacci_len {n} {
        return [string length [math::fibonacci $n]]
    }
    namespace eval fib {}
    tgroup fib::fibonacci -tasks 8 -import {fibonacci_len} { ;# set up 1 task per cpu hyperthread
        package require math
        twait ->  n
        treturn [fibonacci_len $n]
    }
    tgroup fib::fibonacci -run 10 20 30

    parray fib::fibonacci rvar*
    tdump -count
    
#   fib::fibonacci(rvar,0) = 2
#   fib::fibonacci(rvar,1) = 4
#   fib::fibonacci(rvar,2) = 6
#                 (fib::fibonacci0,count) = |1| 
#                 (fib::fibonacci1,count) = |1| 
#                 (fib::fibonacci2,count) = |1| 
#                 (fib::fibonacci3,count) = |0| 
#                 (fib::fibonacci4,count) = |0| 
#                 (fib::fibonacci5,count) = |0| 
#                 (fib::fibonacci6,count) = |0| 
#                 (fib::fibonacci7,count) = |0| 

======

<<enddiscussion>>
----

<<discussion>>Example non modal tk_messageBox

In a recent '''comp.lang.tcl''' posting, the topic was how to use '''tk_messageBox''' non-modally. Below is how one can use Tasks to accomplish that. 

If we set up only a single task, then any further calls to tk_messageBoxNm will be queued up until the user dismisses the on screen dialog. 

However, for this example, we demonstrate how one could permit up to 3 messages on screen, since the rest of the program is no longer blocked. If 3 messages are awaiting acknowledgment, then any further ones will wait in the task group queue.


This example sends 4 messages with a variety of types. It uses a 2 second delay between them (to give the demo a better audio/visual effect). When all 4 are finally dismissed, the '''tgroup -wait all''' will return and a message is written to stdout with puts.
======
    namespace import tasks::*
    pack [ button  .path    -text "hello" -command {puts hello-world}]   -fill both -expand true
    tgroup  tk_messageBoxNm -tasks 3 -import_tasks [list {-package require Tk; wm withdraw .} ] { ;# each thread needs to load Tk 
        twait argv
        treturn [tk_messageBox {*}$argv]                                                          ;# pass along the args from the user call
    }

#   Demo with 4 messages, foobar1-4, and 4 different messageBox styles.

    foreach {message type} [list   foobar1 ok   foobar2 okcancel   foobar3 yesno   foobar4 yesnocancel] {
        tgroup tk_messageBoxNm -foreach "-message $message -type $type"   ;# -foreach sends in requests -async
        wait 2000                                                         ;# delay 2 seconds so we can hear all the bells 
    }
    tgroup tk_messageBoxNm -wait all                                      ;# now wait for all 4 to have been acknowledged
    puts "after all 4 are acknowledged" 


======


<<enddiscussion>>


----
The next two examples demonstrate how some lower level thread commands can be used along with the Task system. 
<<discussion>>Example to combine with thread::send
This example demonstrates how one can combine lower level thread::send calls with Tasks. The task waits for input, but does not block the event queue forever (it issues an '''update''' every 50 ms while waiting for '''tcall''' input).
======
    namespace import tasks::*
    
    Task test -import  {
        twait argv a1 a2
        putz "argv= |$argv| a1= |$a1| a2= |$a2| "
        treturn   " this is a string with a1= |$a1| a2= |$a2| "
    }
    
    wait 1000
    
    thread::send -async $test [list putz "this should open a tk window on windows (or output to stdout on linux)"]
    
    wait 1000
    
    tcall   $test result some input
    puts "result= <$result> "

======
Here's the output (on windows)
======
The Tk window has this:

this should open a tk window on windows (or output to stdout on linux)
argv= |some input| a1= |some| a2= |input| 

And the console will have this:

result= < this is a string with a1= |some| a2= |input| >  
======
<<enddiscussion>>

<<discussion>>Example to combine with thread::cancel
This example demonstrates using thread::cancel calls with Tasks. 

When a cancel arrives as an event, it throws a cancel error. If you intend to use a cancel, you can catch it, or any thing else that does a return to the event loop, such as the wait call in this code. If it cancels before the treturn, the result-var will still be unset. Here's some test code.


======
    namespace import tasks::*
    ;   proc sum {args} {
        putz "sum up: $args"
        return [tcl::mathop::+ {*}$args]    ;# use the multi arg add operator
    }
    Task test  -import {sum} {
        set t_debug 2                       ;# putz (no debug) sent back to console or stdout
        if [catch {
            twait argv                      ;# wait for work and get the args
            putz "started the job"
            wait 2000                       ;# this is a non-busy wait that can get canceled too
            putz "after the wait 2000 in the task"
        } err_code] {
            putz "task got an error = $err_code"
            break     ;# out of our hidden while loop, to exit the task/thread
        }
        set result [sum {*}$argv]   ;# call sum with the input args (note imported proc)
        putz "result= |$result| "
        treturn $result                 ;# send back the results, sets a variable with the result
    }
    
    tcall $test result  <- 5 10 15      ;# show that it works
    puts "result= |$result| "
    
    tcall $test -async result <- 10 20 30  ;# but this one will end up being cancelled
    wait 1000
    thread::cancel $test
    wait 1000
    tvwait result $test                 ;# since the task may have exited, use this
    
    if [catch {
        puts "result= |$result| "
    } err_code] {
        puts "error outputing the result: $err_code"
    }
    
    wait 5000
    tdump

======
Here's the output to a windows console:
======
test       ! started the job
test       ! after the wait 2000 in the task
test       ! sum up: 5 10 15
test       ! result= |30| 
result= |30| 
test       ! started the job
test       ! task got an error = eval canceled
Task: tid0000358C does not exist, while waiting on ::result
error outputing the result: can't read "result": no such variable

------ Task(s) dump -----------------------------------------
tsv::names  = |main tvar tids|
tsv::tids   = |tid0000358C tid00002CE0|
---------------------------------------------------------------
tid/names   = |tid00002CE0 mainthread tid0000358C test|
---------------------------------------------------------------
mainthread tid: tid00002CE0  exists: 1
test       tid: tid0000358C  exists: 0
                 (test,cond)          = |cid1| 
                 (test,count)         = |2| 
                 (test,error)         = || 
                 (test,gvar)          = |::result| 
                 (test,mutex)         = |mid0| 
                 (test,pid)           = |tid00002CE0| 
                 (test,queue)         = || 
                 (test,result)        = |30| 
                 (test,script)        = |#Preamble??namespace eval tasks {}?set ::t_pid tid00002CE0?set ::t_name test?set ::t_debug | 
                 (test,share)         = || 
                 (test,tid)           = |tid0000358C| 
---------------------------------------------------------------
======
<<enddiscussion>>
----
This example demonstrates some additional techniques that can be used with Tasks. It demonstrates the use of a direct thread::send call between tasks.

<<discussion>>Example producer/consumer with a buffer task

Using tasks to experiment with the N-producer/N-consumer single queue (also known as the ''bounded buffer size'') problem.

Here we have several producer and consumer tasks which communicate through the intermediary of a buffer task. 

The queue is in buffer's thread interpreter (global) memory. All of the producer/consumer tasks call the buffer task requesting some data off the queue, or to put some data on the queue (fifo). These requests are also queued fifo, as with any task. Each task includes a variable that buffer will thread::send to signal with.

Buffer returns 0/1 as to the success of a request, which depends on the state of the queue, full, empty, or in between, and which operation (produce or consume) is desired. If not sucessful, the caller is put on a queue (there is 1 for each type) which is also stored along with the data queue in buffer's interpreter global memory.

The included variable name is used to signal back to the caller task when the queue status has changed. All waiting tasks (of the corresponding type) are signaled and they will all then resume from waiting for the signal. Then they will each attempt another try at either producing or consuming, but typically, only 1 will be sucessful, and so the others will go back to waiting.

This example runs best on windows, where all the tasks have a window where one can pause any or all of them. On linux, there will still be a bit of a gui, but most of the output will be to stdout. You can pipe through grep however.


======
    package require Tk
    namespace import tasks::*
    
    proc addwaiter {id type var } {
        lappend ::waiters($type) [list $id $var]
    }
    
    proc signalwaiters {type} {
        while { [llength $::waiters($type)] > 0 } {                  ;# signal all waiters of same "type"
            lassign [lindex $::waiters($type) 0] id varname          ;# task id an the varname to wait on
            putz "signal $type id= |$id| [format %-13s [tname $id]] varname= |$varname| "
            thread::send -async $id [list set ::$varname $type/666]  ;# set the waiters wait var, that resumes him
            set ::waiters($type) [lrange $::waiters($type) 1 end]    ;# remove the first waiter from queue
        }
    }
    
    proc dumpq {} {
        putz ""
        foreach type {produce consume} {
            putz "--- $type --- <$::waiters($type)>" green
            foreach item $::waiters($type) {
                lassign $item id var
                putz "id= |$id| [format %-15s [tname $id] ] var= |$var| "
            }
        }
        putz "--- queue   --- <$::queue>\n" green
    }
    
    
#   
#   ########################## buffer ###############################################
    
    Task buffer -import {addwaiter signalwaiters dumpq} {
        
        twait -> qsize          ;# first time called, we just get our max queue size
        treturn ok              ;#
        
        putz "Buffer Queue max size= |$qsize| "
        catch {wm geom .taskdebug 1109x495+-5+6}
        
        set queue {}            ;# this is our queue of data produced and consumed
        
        set waiters(consume) {} ;# these are the lists of consumers who are blocked
        set waiters(produce) {} ;# and the producers
        
        package require Tk
        toplevel .top           ;# our queue text entry with the items and the length
        entry   .top.queue    -text "queue"   -textvariable ::queue        -font {courier 18} -width 60
        entry   .top.queue2   -text "length"  -textvariable ::queuesize    -font {courier 18} -width 3
        
        ttk::labelframe .top.delay    -text "Delay"
        ttk::spinbox .top.delay.sb    -from 0 -to 1000 -increment 25    -textvariable ::delay_buffer -width 5 -font {courier 18}
        
        pack    .top.delay                    -side right
        pack    .top.queue      -expand true  -side right -fill both
        pack    .top.queue2     -expand true  -side left  -fill both
        pack    .top.delay.sb   -expand true              -fill both
        
        wm geom .top 1255x62+374+859
        
        wm attributes .top  -topmost 1
        set ::delay_buffer 0
        while { 1 } {
            wait $::delay_buffer
            twait -> type data var                      ;# called with real requests, if type is consume, data is just a place holder
            
            set pid [tset buffer pid]                   ;# get our parent (caller) id so we can signal if needed
            putz "$pid [format %-14s [tname $pid] ] type= |$type| data= |$data| var= |$var| " green
            set ::queuesize [llength $queue]            ;# for our queue size text entry
            
            if       { $type eq "produce" } {
                
                putz "   produce:  len/max= [llength $queue] / $qsize   <$queue> before insert" red
                
                if { [llength $queue] >= $qsize } {     ;# is there room for another
                    addwaiter $pid produce $var         ;# no put this guy on our producer waiting list
                    treturn 0                           ;# return 0 if the queue is full
                } else {
                    lappend queue $data                 ;# add data to the end of the queue (fifo)
                    set ::queuesize [llength $queue]    ;# for our queue size text entry
                    signalwaiters consume               ;# signal all waiting consumers that there's new data available
                    treturn 1                           ;# return 1 when data added to queue sucessfully
                }
                
            } elseif { $type eq "consume" } {
                
                putz "   consume:  len/max= [llength $queue] / $qsize   <$queue> before consume" red
                
                if { [llength $queue]  == 0} {          ;# is there anything to consume
                    addwaiter $pid consume $var         ;# no put this guy on our consumer waiting list
                    treturn [list 0 0]                  ;# {code data} - data is just a place holder here
                } else {
                    set data    [lindex $queue 0]       ;# get the next one off the data queue
                    set queue   [lrange $queue 1 end]   ;# now remove that one
                    set ::queuesize [llength $queue]    ;# for our queue size text entry
                    putz "   remove <$data> queue now:    <$queue> "
                    signalwaiters produce               ;# signal all producers there's room now
                    treturn [list 1 $data]              ;# return code 1, and some data
                }
                
            } elseif { $type eq "dump" } {
                
                dumpq
                wait 3000 ;# time to look at the dump
                
            } else {
                error "bad type"
            }
        }
    }
    
#   ########################### producer ####################################
    set pscript {
        twait -> bid delay geom first   ;# one time we get called with the buffer task id
        treturn ok
        
        putz "producer init"
        catch {wm geom .taskdebug $geom}
        set data [expr {   $first - 1   }]
        while { 1 } {
            putz "produce during [comma $delay] miliseconds" green
            wait $delay ;#simulate time to produce
            tpause_check
            incr data   ;# this is what we produce, just keep incr'ing it
            set try 0   ;# how many tries before we can give this successfully to the buffer task
            while { 1 } {
                unset -nocomplain                   ::prod_full_var ;# in order to wait on a var, we must unset it first
                tcall $bid rvar  <-   produce $data ::prod_full_var ;# sync call to the buffer, with our signal var as a parm
                incr try                                            ;# with multiple producers, we all get a shot at the queue
                if { $rvar } {                                      ;# rvar is 1/0 for sucess or no room in buffer
                    putz "fits   on try number: $try    data we inserted = |$data|" red
                    break                                           ;# leave this loop and go back to producing a new data item
                } else {
                    putz "no-fit on try number: $try    try again, tvwait on ::prod_full_var"
                    tvwait ::prod_full_var      ;# the buffer task will save prod_full_var and signal us when room in queue
                }
            }
        }
        
    }
    Task producer  -import $pscript
    Task producer2 -import $pscript
    
#   ################################# consumer ####################################################
    
    set cscript {
        twait -> bid delay1 modulo delay2  geom ;# buffer task/thread id, 2 delays with a modulo on delay2
        treturn ok                              ;# we return only to resume the callback that started us going
        
        putz "consumer init"
        catch {wm geom .taskdebug $geom}
        while { 1 } {
            set try 0
            while { 1 } {
                tpause_check
                
                unset -nocomplain                         ::cons_empty_var
                tcall   $bid     rvar  <-     consume 0   ::cons_empty_var   ;# returns list of {code data} code 0/1
                
                lassign $::rvar   code        data
                if { $code  } {
                    break           ;# the data was returned from the queue
                } else {            ;# the queue was empty, so we need to wait for a signal after a producer queues some data
                    putz  "Queue empty, wait for a signal try: [incr try]" red
                    tvwait ::cons_empty_var
                }
            }
            
            putz "Got one $data" red
            wait $delay1
            if { [incr counter] % $modulo == 0 } {
                catch {wm title . "delaying $delay2"}
                wait $delay2
                catch {wm title . "continue"}
            }
        }
    }
    Task consumer  -import  $cscript
    Task consumer2 -import  $cscript
    Task consumer3 -import  $cscript
#    Task consumer4 -import  $cscript
    
    
#   ################################# consume 1 button callback ####################################################
    
    proc consume1 {args} {
        incr ::level
        if { $::level > 1 } {
#           putz "busy in the last one, level = $::level so ignoring this one"
        } else {
            while { 1 } {
                unset -nocomplain                  ::cons_empty_var
                tcall $::buffer rvar  <- consume 0 ::cons_empty_var
                lassign $::rvar code data
                putz "consume reequest [format %-15s |$::rvar| ] code= |$code| data= |$data| "
                if { $code  } {
                    break
                } else {
                    tvwait cons_empty_var
                }
            }
            putz "Got one $data" red
        }
        incr ::level -1
        
    }
    
#   ##################################### some gui buttons #######################################################
    
    button  .consume    -text "consume" -command    consume1             ;# do just 1 consume, report to console
    button  .dump       -text "dump"    -command    dump                 ;# dump the queues in the buffer task
    
    pack    .consume    -fill both      -expand     true
    pack    .dump       -fill both      -expand     true
    
    wm geom . 369x105+1+857
    
#   ###################################### start up our tasks ####################################################
#   These next 6 tcall's are sync calls and we don't care about the return values, so we use <- for that variable
    
    tcall $::buffer    <-   10                                       ;# send buffer his max size
    
    tcall $::producer  <-  $::buffer 199  792x222+1112+7   0         ;# buffer id, delay to produce, window geom, starting data value
    tcall $::producer2 <-  $::buffer 100  792x229+1119+272 10000     ;# buffer id, delay to produce, window geom start at 10k
    
    after 5000  {tcall  $::consumer   <- $::buffer 300 10 2000 517x220+-6+543}    ;# delay starting our consumers
    after 15000 {tcall  $::consumer2  <- $::buffer 25  30 3000 531x221+517+544}   ;# delay, modulo, delay2, geom
    after 17000 {tcall  $::consumer3  <- $::buffer 300 10 2000 521x220+1055+545}
    
    tdump                                                                ;# threads dump to console
    
    proc dump {} {
        tcall $::buffer -async xxxx <- dump                              ;# send to buffer ask for a queue dump
    }
    
    wait 2000
    dump

======

<<enddiscussion>>
----
This example demonstrates that using multi-tasking can provide performance benefits even for a program that does not do heavy compute, but rather just does many simultaneous web requests.
<<discussion>>Example web page extractions using Tproc
The below example uses twapi and https (on windows) or tls (on linux) to extract the titles from 200 RFC's. It does it sequentially and using 10 tasks created by the Tproc command. Tasks were >8x faster. The results include the size of each rfc and its title.

    *  Inside Tproc and tgroup

Tproc calls '''proc''' to create the procedure '''rfc::do_url''' and then calls '''tgroup''' to create '''ntasks''' task threads that each import rfc::do_url. The sequential code calls rfc::do_url directly with the results saved in the array '''ans'''.

The tgroup '''-foreach''' sub-command is used to place 200 arglists into the groups queue (asynchronously). Each of the 10 Tproc created tasks concurrently get arglists from the shared job queue and call rfc::do_url to get a result. 

The results are sent back to the caller thread (main) and stored in an array also named rfc::do_url using indices '''rvar,*''' for *=0..199.  Then a tgroup '''-wait all''' waits for all 200 to complete.

    *  putz debugging and tdump

Each task uses a debugging '''putz''' call. In the main thread, it goes to the console; in each task (because t_debug = 2) putz does a thread::send to the main with a puts statement, so that also goes to the console. On Windows, a t_debug value of 0 can alternatively be used to create separate debugging text windows one for each task if desired.  The '''tdump''' utility command is used to show how many jobs each task worked on.

    *  initializers and proc imports

Note the use of the Tproc initializer code stored in the '''ilist''' list variable, which follows the body of the procedure. It closely mimics the main thread version. This results in the http/https init code being inserted outside of the procedure, so it is done only once per task. This also demonstrates importing the time stamping procedure '''Time''' and also how to set the t_debug to 2. Explicit namespaces are also demo-ed.

The use of 10 tasks doing the https requests concurrently provided the speed up. 


======
    namespace import tasks::*
    
;   proc Time {} {                              ;# import this to each task
        set ms [clock milliseconds]             ;# format current time with 3 digit ms
        set secs [expr {   $ms / 1000   }]
        set ms [string range $ms end-2 end]
        return [string range [clock format $secs] 11 18].$ms
    }
# ------------------------------- main thread  ----------------------------------  
    package require http                        
    if { $::tcl_platform(platform) ne "windows"  } {
        package require tls
        http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 1 -tls1.2 1 ]
    } else {
        console show
        package require twapi_crypto
        http::register https 443 [list ::twapi::tls_socket]
    }
# ----------------------------- Tproc init code ---------------------------------    
    set     ilist        Time                                                    
    lappend ilist        {-set ::t_debug 2 }                                     \
                         {-package require http} 
    if { $::tcl_platform(platform) ne "windows"  } {
        lappend ilist   {-package require tls}                                   \
                        {-http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 1 -tls1.2 1 ]} 
    } else {
        lappend ilist   {-package require twapi_crypto}                          \
                        {-http::register https 443 [list ::twapi::tls_socket]}   
    }                                                                    
 
    set from 1
    set to   200
    
    set ntasks 10
    puts "ntasks= |$ntasks| " ; update
    
    namespace eval rfc {}                       ;# demo using a namespace
    set tm0 [lindex [time {                     ;# timing of the task create
#---------------------------------------------------------------------------
#--              
        Tproc rfc::do_url {url n {debug no}} {
            set tok [http::geturl $url]
            set result [http::data $tok]
            set extract " ---no title found $n---"
            regexp {.*<title>(RFC [0-9]+:[^\n]+)</title>.*} $result ->  extract
            http::cleanup $tok
            if { $debug && ((($n % 50) == 0) || ($n == 1))} {
                putz "[Time] do RFC ($n) = $extract" ;# goes to console or stdout
            }
            return [list [format %6s [string length $result] ] $extract]
            
        }  -tasks $ntasks    -import_tasks    $ilist                          
            
#--
#---------------------------------------------------------------------------               

    } 1] 0]
    
    
    set tm1 [lindex [time {                     ;# timing of a sequential run
#----------------------------------------------------------------------------
#--      
        for {set n $from} {$n <= $to} {incr n} {
            set url "https://www.rfc-editor.org/rfc/rfc${n}.html"
            set rfc::ans($n) [rfc::do_url $url $n yes]
        }
#--
#----------------------------------------------------------------------------        
    } 1] 0]
    
    for {set n $from} {$n <= $to} {incr n} {    ;# dump results from array ans
        if { $n <= 5 || $n > $to - 5 } {
                puts "== $rfc::ans($n)"
        } elseif {$n == 6} {
            puts "   ..."
        }
    }
    
    
    puts "\n--------------\n"
  
    
    set tm2 [lindex [time {                        ;# timimg of a tasks run
#--------------------------------------------------------------------------
#--       
        for {set n $from} {$n <= $to} {incr n} {
            set url "https://www.rfc-editor.org/rfc/rfc${n}.html"
            tgroup rfc::do_url -foreach [list $url $n yes] ;# launch each job -async
        }
        tgroup rfc::do_url -wait all                       ;# wait for to-from+1 jobs
#--
#--------------------------------------------------------------------------       
        
    } 1] 0]
    
    set m -1                                       ;# tgroup output indices = rvar,0 .. rvar,$njobs-1
    for {set n $from} {$n <= $to} {incr n} {       ;# dump results from array
        incr m
        if { $n <= 5 || $n > $to - 5 } {
            puts "-- $rfc::do_url(rvar,$m)"        ;# tgroup uses same name for the array as the Tproc
        } elseif {$n == 6} {
            puts "   ..."
        }
    }
    
    tdump -count
    
    puts "[format %10s [comma $tm0] ] microseconds create $ntasks tasks"
    puts "[format %10s [comma $tm1] ] microseconds sequential"
    puts "[format %10s [comma $tm2] ] microseconds tgroup"
    puts "ratio: sequential/tasks = [expr {   $tm1 * 1.0 / ($tm0 + $tm2)   }]"


# ntasks= |10| 
# 20:58:16.560 do RFC (1) = RFC 1: Host Software 
# 20:58:23.089 do RFC (50) = RFC 50:  Comments on the Meyer Proposal 
# 20:58:29.852 do RFC (100) = RFC 100:  Categorization and guide to NWG/RFCs 
# 20:58:36.520 do RFC (150) = RFC 150:  Use of IPC Facilities: A Working Paper 
# 20:58:43.183 do RFC (200) = RFC 200:  RFC list by number 
# == { 30199} {RFC 1: Host Software }
# == { 26441} {RFC 2: Host software }
# == {  9962} {RFC 3:  Documentation conventions }
# == { 14866} {RFC 4:  Network timetable }
# == { 35063} {RFC 5:  Decode Encode Language (DEL) }
#    ...
# == { 14834} {RFC 196:  Mail Box Protocol }
# == { 15047} {RFC 197:  Initial Connection Protocol - Reviewed }
# == {  8219} {RFC 198:  Site Certification - Lincoln Labs 360/67 }
# == { 27665} {RFC 199: Suggestions for a Network Data-Tablet Graphics Protocol }
# == { 27720} {RFC 200:  RFC list by number }
# 
# --------------
# 
# rfc::do_url4 ! 20:58:43.367 do RFC (1) = RFC 1: Host Software 
# rfc::do_url5 ! 20:58:43.972 do RFC (50) = RFC 50:  Comments on the Meyer Proposal 
# rfc::do_url0 ! 20:58:44.650 do RFC (100) = RFC 100:  Categorization and guide to NWG/RFCs 
# rfc::do_url0 ! 20:58:45.288 do RFC (150) = RFC 150:  Use of IPC Facilities: A Working Paper 
# rfc::do_url8 ! 20:58:46.042 do RFC (200) = RFC 200:  RFC list by number 
# -- { 30199} {RFC 1: Host Software }
# -- { 26441} {RFC 2: Host software }
# -- {  9962} {RFC 3:  Documentation conventions }
# -- { 14866} {RFC 4:  Network timetable }
# -- { 35063} {RFC 5:  Decode Encode Language (DEL) }
#    ...
# -- { 14834} {RFC 196:  Mail Box Protocol }
# -- { 15047} {RFC 197:  Initial Connection Protocol - Reviewed }
# -- {  8219} {RFC 198:  Site Certification - Lincoln Labs 360/67 }
# -- { 27665} {RFC 199: Suggestions for a Network Data-Tablet Graphics Protocol }
# -- { 27720} {RFC 200:  RFC list by number }
#                  (rfc::do_url0,count)        = |20| 
#                  (rfc::do_url1,count)        = |20| 
#                  (rfc::do_url2,count)        = |20| 
#                  (rfc::do_url3,count)        = |21| 
#                  (rfc::do_url4,count)        = |20| 
#                  (rfc::do_url5,count)        = |18| 
#                  (rfc::do_url6,count)        = |20| 
#                  (rfc::do_url7,count)        = |20| 
#                  (rfc::do_url8,count)        = |21| 
#                  (rfc::do_url9,count)        = |20| 
#    184,990 microseconds create 10 tasks
# 26,823,532 microseconds sequential
#  2,854,554 microseconds tgroup
# ratio: sequential/tasks = 8.824853991256584




======

<<enddiscussion>>
----
Version 1.12 includes new features in the debugging utilities. send_command has tab expansion (for commands and variables) and escape expansion for finishing brackets. Browser lookup is also supported using Ashok's magicsplat docs page.

Version 1.11 includes new utilities for debugging tasks (tlg, tla, twidgets, and sendcmd). tasks::send_command can be run from the program or using the button in the task monitor. The task monitor is run via: tasks::task_monitor.

Version 1.10 includes a few changes to putz windows (now their own toplevels) and the new Task Monitor and repos commands to line up putz windows.

Version 1.9 includes a few bug fixes  - in particular, tgroup groupnames are always in the global or namespace scope and tgroup can now be called from a local scope (e.g. proc).

Version 1.8 includes a new global to modify the twait timeout when checking a tasks queue: t_twait_timeout (default 50 ms). There are also some performance improvements. Currently, a minimal Tproc call is about 3.5x longer than doing a simple thread::send with a value returned. Tproc overhead is approximately 65 usec where a proc is about .7 usec (4gz intel i7 timing). Of course, this overhead is not important if the Tproc does any substantial work.

Please place any user comments below.


<<categories>> Concept | Threads