#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

#---------------
# Manage a queued list of items.
#---------------
#/param   qid     queue id, a unique string
#/param   action  action to be performes on the queue
#/param   value   relevant value
#/returns
#
proc queue { action {qid ""} {value ""}  } {
        
        set cmds [list add clear delete destroy fetch foreach front get item lower names new prioritize raise rear reverse remove search ]
        
        if { [lsearch $cmds $action] == -1 } {  
                set msg "No such cmd \"$action\". Must be one of: $cmds." 
                error $msg 
                } 

        if { ![namespace exists ::Q] } { namespace eval ::Q {} } 

        if { $action eq "names" } { return [string map "::Q:: {}" [info vars ::Q::*]] }

        if { $action ne "new" && ![info exists ::Q::$qid] } { 
                set msg "No such queue \"$qid\". Must be one of: $cmds." 
                error $msg 
                } 
        
        set res ""
        
        switch $action {
                new { 
                        # create new queue and initialize as an empty string
                        set ::Q::$qid "" 
                        }
                clear { 
                        # clear the contents of an existing queue
                        set ::Q::$qid "" 
                        } 
                add { 
                        # append item to the end of the queue
                        foreach item [split $value] { lappend ::Q::$qid $item }
                        }
                fetch { 
                        # return complete list of items in the specified queue
                        return [set ::Q::$qid] 
                        }
                foreach { 
                        # process each item in the queue usings named proceedure
                        set tmp [queue get $qid]
                        while {$tmp ne ""} { $value $tmp ; set tmp [queue get $qid] }
                        }
                get { 
                        # retrieve next item in the queue, for processing and then remove
                        set res [lindex [set ::Q::$qid] 0] 
                        set ::Q::$qid [lrange [set ::Q::$qid] 1 end]                 
                        }
                front { 
                        # retrieve the first item in the specified queue
                        set res [lindex [set ::Q::$qid] 0] 
                        } 
                item {        
                        # retrieve the item in the specified queue
                        set res [lindex [set ::Q::$qid] $value]                         
                        }         
                last { 
                        # retrieve final item in the specified queue
                        set res [lindex [set ::Q::$qid] end] 
                        }
                reverse { 
                        # reverse the items in the specified queue
                        set ::Q::$qid [lreverse [set ::Q::$qid]] 
                        }
                raise - 
                lower {
                        # raise or lower position of indexed item in queue
                        if { $action eq "raise" } {
                                set pos(from) [expr $value-1]
                                set pos(to) $value 
                        } else {
                                set pos(from) $value
                                set pos(to) [expr $value+1]                                          
                        }
                        
                        set tmp [lreverse [lrange [set ::Q::$qid] $pos(from) $pos(to)] ]
                        lassign $tmp a b
                        set ::Q::$qid [lreplace [set ::Q::$qid] $pos(from) $pos(to) $a $b ]
                        }
                remove { 
                        # remove item from queue based upon contents
                        set ::Q::$qid [lsearch -all -inline -not -exact [set ::Q::$qid] $value] 
                        } 
                delete { 
                        # delete item from queue based upon index
                        set ::Q::$qid  [lreplace [set ::Q::$qid] $value $value] 
                        } 
                search { 
                        # search for item in queue based upon contents, return index if found, else -1
                        set res [lsearch [set ::Q::$qid] $value] 
                        }
                prioritize {
                        # move item to the heade of the queue
                        set item [lindex [set ::Q::$qid] $value] 
                        set ::Q::$qid [lreplace [lreplace [set ::Q::$qid] $value $value] -1 -1 $item]
                        }
                destroy { 
                        # destroy queue and its contents
                        unset ::Q::$qid  
                        }
        }
        
        return $res
}


#---------------
# Script Main Function
#---------------
# Arguments:
#        args
# Returns:
#        none
#
proc main { args } {

        puts "READY..."
        
        # create sample queues
        queue new 001
        queue new 002
        queue new 003
        
        # add items
        foreach item { 0 1 2 3 4 5 6 7 8 9 } {
                queue add 001 $item
        }
        
        foreach item { A B C D E F G H I J } {
                queue add 002 $item
        }        
        
        queue add 003 [list "/home/apple.txt" "/home/blackberry.txt" "/home/cherry.txt"]
        
        
        # display contents
        foreach item [queue names] {
                puts "$item : [queue fetch $item]"
        }

        # other operations
        puts "'5' is item [queue search 002 H] in queue 002."
        puts "Item 4 in queue 002 is '[queue item 002 4]'."
        
        puts [queue remove 001 5]

        # shuffle the contents
        queue prioritize 001 5
        queue raise 002 3
        queue lower 001 3 
        queue reverse 001

        # process the available queues
        foreach q [queue names] {
                puts \n
                while 1 {
                        set item [queue get $q]
                        if { $item eq "" } { break } 
                        puts ${q}:$item
                        puts [queue fetch $q]
                        after 50
                }
        }

        
        queue new 004
        
        # add items
        foreach item { how now brown cow she sells sea shells by the sea shore } {
                queue add 004 $item
        }
        
        proc myPuts {args} {
                puts ~~~>$args
        }        
        
        queue foreach 004 myPuts
                
        puts "DONE!"
}

main