summaryrefslogtreecommitdiffstats
path: root/library/struct1.0
diff options
context:
space:
mode:
Diffstat (limited to 'library/struct1.0')
-rw-r--r--library/struct1.0/pkgIndex.tcl11
-rw-r--r--library/struct1.0/queue.tcl239
-rw-r--r--library/struct1.0/stack.tcl276
-rw-r--r--library/struct1.0/struct.tcl8
4 files changed, 534 insertions, 0 deletions
diff --git a/library/struct1.0/pkgIndex.tcl b/library/struct1.0/pkgIndex.tcl
new file mode 100644
index 0000000..c1c4b4e
--- /dev/null
+++ b/library/struct1.0/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# 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
new file mode 100644
index 0000000..22cf939
--- /dev/null
+++ b/library/struct1.0/queue.tcl
@@ -0,0 +1,239 @@
+# 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
new file mode 100644
index 0000000..50272b7
--- /dev/null
+++ b/library/struct1.0/stack.tcl
@@ -0,0 +1,276 @@
+# 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
new file mode 100644
index 0000000..ecacdba
--- /dev/null
+++ b/library/struct1.0/struct.tcl
@@ -0,0 +1,8 @@
+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::*
+}