diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/struct1.0/pkgIndex.tcl | 11 | ||||
| -rw-r--r-- | library/struct1.0/queue.tcl | 239 | ||||
| -rw-r--r-- | library/struct1.0/stack.tcl | 276 | ||||
| -rw-r--r-- | library/struct1.0/struct.tcl | 8 |
4 files changed, 0 insertions, 534 deletions
diff --git a/library/struct1.0/pkgIndex.tcl b/library/struct1.0/pkgIndex.tcl deleted file mode 100644 index c1c4b4e..0000000 --- a/library/struct1.0/pkgIndex.tcl +++ /dev/null @@ -1,11 +0,0 @@ -# Tcl package index file, version 1.1 -# This file is generated by the "pkg_mkIndex" command -# and sourced either when an application starts up or -# by a "package unknown" script. It invokes the -# "package ifneeded" command to set up package-related -# information so that packages will be loaded automatically -# in response to "package require" commands. When this -# script is sourced, the variable $dir must contain the -# full path name of this file's directory. - -package ifneeded struct 1.0 [list source [file join $dir struct.tcl]] diff --git a/library/struct1.0/queue.tcl b/library/struct1.0/queue.tcl deleted file mode 100644 index 22cf939..0000000 --- a/library/struct1.0/queue.tcl +++ /dev/null @@ -1,239 +0,0 @@ -# queue.tcl -- -# -# Queue implementation for Tcl. -# -# Copyright (c) 1998-2000 by Scriptics Corporation. -# All rights reserved. -# -# RCS: @(#) $Id: queue.tcl,v 1.1 2000/02/05 03:20:20 ericm Exp $ - -namespace eval ::struct {} - -namespace eval ::struct::queue { - # The queues array holds all of the queues you've made - variable queues - - # counter is used to give a unique name for unnamed queues - variable counter 0 - - # commands is the list of subcommands recognized by the queue - variable commands [list \ - "clear" \ - "destroy" \ - "get" \ - "peek" \ - "put" \ - "size" \ - ] - - # Only export one command, the one used to instantiate a new queue - namespace export queue -} - -# ::struct::queue::queue -- -# -# Create a new queue with a given name; if no name is given, use -# queueX, where X is a number. -# -# Arguments: -# name name of the queue; if null, generate one. -# -# Results: -# name name of the queue created - -proc ::struct::queue::queue {{name ""}} { - variable queues - variable counter - - if { [llength [info level 0]] == 1 } { - incr counter - set name "queue${counter}" - } - - if { ![string equal [info commands ::$name] ""] } { - error "command \"$name\" already exists, unable to create queue" - } - - # Initialize the queue as empty - set queues($name) [list ] - - # Create the command to manipulate the queue - interp alias {} ::$name {} ::struct::queue::QueueProc $name - - return $name -} - -########################## -# Private functions follow - -# ::struct::queue::QueueProc -- -# -# Command that processes all queue object commands. -# -# Arguments: -# name name of the queue object to manipulate. -# args command name and args for the command -# -# Results: -# Varies based on command to perform - -proc ::struct::queue::QueueProc {name {cmd ""} args} { - # Make sure this queue exists - if { ![info exists ::struct::queue::queues($name)] } { - error "unknown queue \"$name\"" - } - - # Do minimal args checks here - if { [llength [info level 0]] == 2 } { - error "wrong # args: should be \"$name option ?arg arg ...?\"" - } - - # Split the args into command and args components - if { [string equal [info commands ::struct::queue::_$cmd] ""] } { - variable commands - set optlist [join $commands ", "] - set optlist [linsert $optlist "end-1" "or"] - error "bad option \"$cmd\": must be $optlist" - } - return [uplevel 1 [list ::struct::queue::_$cmd $name] $args] -} - -# ::struct::queue::_clear -- -# -# Clear a queue. -# -# Arguments: -# name name of the queue object. -# -# Results: -# None. - -proc ::struct::queue::_clear {name} { - variable queues - set queues($name) [list ] - return -} - -# ::struct::queue::_destroy -- -# -# Destroy a queue object by removing it's storage space and -# eliminating it's proc. -# -# Arguments: -# name name of the queue object. -# -# Results: -# None. - -proc ::struct::queue::_destroy {name} { - variable queues - unset queues($name) - interp alias {} ::$name {} - return -} - -# ::struct::queue::_get -- -# -# Get an item from a queue. -# -# Arguments: -# name name of the queue object. -# count number of items to get; defaults to 1 -# -# Results: -# item first count items from the queue; if there are not enough -# items in the queue, throws an error. - -proc ::struct::queue::_get {name {count 1}} { - variable queues - if { $count < 1 } { - error "invalid item count $count" - } - - if { $count > [llength $queues($name)] } { - error "insufficient items in queue to fill request" - } - - if { $count == 1 } { - # Handle this as a special case, so single item gets aren't listified - set item [lindex $queues($name) 0] - set queues($name) [lreplace $queues($name) 0 0] - return $item - } - - # Otherwise, return a list of items - set index [expr {$count - 1}] - set result [lrange $queues($name) 0 $index] - set queues($name) [lreplace $queues($name) 0 $index] - - return $result -} - -# ::struct::queue::_peek -- -# -# Retrive the value of an item on the queue without removing it. -# -# Arguments: -# name name of the queue object. -# count number of items to peek; defaults to 1 -# -# Results: -# items top count items from the queue; if there are not enough items -# to fufill the request, throws an error. - -proc ::struct::queue::_peek {name {count 1}} { - variable queues - if { $count < 1 } { - error "invalid item count $count" - } - - if { $count > [llength $queues($name)] } { - error "insufficient items in queue to fill request" - } - - if { $count == 1 } { - # Handle this as a special case, so single item pops aren't listified - return [lindex $queues($name) 0] - } - - # Otherwise, return a list of items - set index [expr {$count - 1}] - return [lrange $queues($name) 0 $index] -} - -# ::struct::queue::_put -- -# -# Put an item into a queue. -# -# Arguments: -# name name of the queue object -# args items to put. -# -# Results: -# None. - -proc ::struct::queue::_put {name args} { - variable queues - if { [llength $args] == 0 } { - error "wrong # args: should be \"$name put item ?item ...?\"" - } - foreach item $args { - lappend queues($name) $item - } - return -} - -# ::struct::queue::_size -- -# -# Return the number of objects on a queue. -# -# Arguments: -# name name of the queue object. -# -# Results: -# count number of items on the queue. - -proc ::struct::queue::_size {name} { - variable queues - return [llength $queues($name)] -} diff --git a/library/struct1.0/stack.tcl b/library/struct1.0/stack.tcl deleted file mode 100644 index 50272b7..0000000 --- a/library/struct1.0/stack.tcl +++ /dev/null @@ -1,276 +0,0 @@ -# stack.tcl -- -# -# Stack implementation for Tcl. -# -# Copyright (c) 1998-2000 by Scriptics Corporation. -# All rights reserved. -# -# RCS: @(#) $Id: stack.tcl,v 1.1 2000/02/05 03:20:20 ericm Exp $ - -namespace eval ::struct {} - -namespace eval ::struct::stack { - # The stacks array holds all of the stacks you've made - variable stacks - - # counter is used to give a unique name for unnamed stacks - variable counter 0 - - # commands is the list of subcommands recognized by the stack - variable commands [list \ - "clear" \ - "destroy" \ - "peek" \ - "pop" \ - "push" \ - "rotate" \ - "size" \ - ] - - # Only export one command, the one used to instantiate a new stack - namespace export stack -} - -# ::struct::stack::stack -- -# -# Create a new stack with a given name; if no name is given, use -# stackX, where X is a number. -# -# Arguments: -# name name of the stack; if null, generate one. -# -# Results: -# name name of the stack created - -proc ::struct::stack::stack {{name ""}} { - variable stacks - variable counter - - if { [llength [info level 0]] == 1 } { - incr counter - set name "stack${counter}" - } - - if { ![string equal [info commands ::$name] ""] } { - error "command \"$name\" already exists, unable to create stack" - } - set stacks($name) [list ] - - # Create the command to manipulate the stack - interp alias {} ::$name {} ::struct::stack::StackProc $name - - return $name -} - -########################## -# Private functions follow - -# ::struct::stack::StackProc -- -# -# Command that processes all stack object commands. -# -# Arguments: -# name name of the stack object to manipulate. -# args command name and args for the command -# -# Results: -# Varies based on command to perform - -proc ::struct::stack::StackProc {name {cmd ""} args} { - # Make sure this stack exists - if { ![info exists ::struct::stack::stacks($name)] } { - error "unknown stack \"$name\"" - } - - # Do minimal args checks here - if { [llength [info level 0]] == 2 } { - error "wrong # args: should be \"$name option ?arg arg ...?\"" - } - - # Split the args into command and args components - if { [llength [info commands ::struct::stack::_$cmd]] == 0 } { - variable commands - set optlist [join $commands ", "] - set optlist [linsert $optlist "end-1" "or"] - error "bad option \"$cmd\": must be $optlist" - } - return [eval [list ::struct::stack::_$cmd $name] $args] -} - -# ::struct::stack::_clear -- -# -# Clear a stack. -# -# Arguments: -# name name of the stack object. -# -# Results: -# None. - -proc ::struct::stack::_clear {name} { - set ::struct::stack::stacks($name) [list ] - return -} - -# ::struct::stack::_destroy -- -# -# Destroy a stack object by removing it's storage space and -# eliminating it's proc. -# -# Arguments: -# name name of the stack object. -# -# Results: -# None. - -proc ::struct::stack::_destroy {name} { - unset ::struct::stack::stacks($name) - interp alias {} ::$name {} - return -} - -# ::struct::stack::_peek -- -# -# Retrive the value of an item on the stack without popping it. -# -# Arguments: -# name name of the stack object. -# count number of items to pop; defaults to 1 -# -# Results: -# items top count items from the stack; if there are not enough items -# to fufill the request, throws an error. - -proc ::struct::stack::_peek {name {count 1}} { - variable stacks - if { $count < 1 } { - error "invalid item count $count" - } - - if { $count > [llength $stacks($name)] } { - error "insufficient items on stack to fill request" - } - - if { $count == 1 } { - # Handle this as a special case, so single item pops aren't listified - set item [lindex $stacks($name) end] - return $item - } - - # Otherwise, return a list of items - set result [list ] - for {set i 0} {$i < $count} {incr i} { - lappend result [lindex $stacks($name) "end-${i}"] - } - return $result -} - -# ::struct::stack::_pop -- -# -# Pop an item off a stack. -# -# Arguments: -# name name of the stack object. -# count number of items to pop; defaults to 1 -# -# Results: -# item top count items from the stack; if the stack is empty, -# returns a list of count nulls. - -proc ::struct::stack::_pop {name {count 1}} { - variable stacks - if { $count > [llength $stacks($name)] } { - error "insufficient items on stack to fill request" - } elseif { $count < 1 } { - error "invalid item count $count" - } - - if { $count == 1 } { - # Handle this as a special case, so single item pops aren't listified - set item [lindex $stacks($name) end] - set stacks($name) [lreplace $stacks($name) end end] - return $item - } - - # Otherwise, return a list of items - set result [list ] - for {set i 0} {$i < $count} {incr i} { - lappend result [lindex $stacks($name) "end-${i}"] - } - - # Remove these items from the stack - incr i -1 - set stacks($name) [lreplace $stacks($name) "end-${i}" end] - - return $result -} - -# ::struct::stack::_push -- -# -# Push an item onto a stack. -# -# Arguments: -# name name of the stack object -# args items to push. -# -# Results: -# None. - -proc ::struct::stack::_push {name args} { - if { [llength $args] == 0 } { - error "wrong # args: should be \"$name push item ?item ...?\"" - } - foreach item $args { - lappend ::struct::stack::stacks($name) $item - } - return -} - -# ::struct::stack::_rotate -- -# -# Rotate the top count number of items by step number of steps. -# -# Arguments: -# name name of the stack object. -# count number of items to rotate. -# steps number of steps to rotate. -# -# Results: -# None. - -proc ::struct::stack::_rotate {name count steps} { - variable stacks - set len [llength $stacks($name)] - if { $count > $len } { - error "insufficient items on stack to fill request" - } - - # Rotation algorithm: - # do - # Find the insertion point in the stack - # Move the end item to the insertion point - # repeat $steps times - - set start [expr {$len - $count}] - set steps [expr {$steps % $count}] - for {set i 0} {$i < $steps} {incr i} { - set item [lindex $stacks($name) end] - set stacks($name) [lreplace $stacks($name) end end] - set stacks($name) [linsert $stacks($name) $start $item] - } - return -} - -# ::struct::stack::_size -- -# -# Return the number of objects on a stack. -# -# Arguments: -# name name of the stack object. -# -# Results: -# count number of items on the stack. - -proc ::struct::stack::_size {name} { - return [llength $::struct::stack::stacks($name)] -} diff --git a/library/struct1.0/struct.tcl b/library/struct1.0/struct.tcl deleted file mode 100644 index ecacdba..0000000 --- a/library/struct1.0/struct.tcl +++ /dev/null @@ -1,8 +0,0 @@ -package provide struct 1.0 -source [file join [file dirname [info script]] stack.tcl] -source [file join [file dirname [info script]] queue.tcl] -namespace eval struct { - namespace export * - namespace import stack::* - namespace import queue::* -} |