home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 5 / hacker05 / 05_HACK_05.ISO / programacao / freewrap / TCLLIBsampleApp.exe / sample / tcllib / tcllib1.0 / struct / stack.tcl < prev    next >
Encoding:
Text File  |  2001-08-17  |  6.0 KB  |  267 lines
  1. # stack.tcl --
  2. #
  3. #    Stack implementation for Tcl.
  4. #
  5. # Copyright (c) 1998-2000 by Ajuba Solutions.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. # 
  10. # RCS: @(#) $Id: stack.tcl,v 1.3 2000/06/02 18:43:56 ericm Exp $
  11.  
  12. namespace eval ::struct {}
  13.  
  14. namespace eval ::struct::stack {
  15.     # The stacks array holds all of the stacks you've made
  16.     variable stacks
  17.     
  18.     # counter is used to give a unique name for unnamed stacks
  19.     variable counter 0
  20.  
  21.     # commands is the list of subcommands recognized by the stack
  22.     variable commands [list \
  23.         "clear"    \
  24.         "destroy"    \
  25.         "peek"    \
  26.         "pop"    \
  27.         "push"    \
  28.         "rotate"    \
  29.         "size"    \
  30.         ]
  31.  
  32.     # Only export one command, the one used to instantiate a new stack
  33.     namespace export stack
  34. }
  35.  
  36. # ::struct::stack::stack --
  37. #
  38. #    Create a new stack with a given name; if no name is given, use
  39. #    stackX, where X is a number.
  40. #
  41. # Arguments:
  42. #    name    name of the stack; if null, generate one.
  43. #
  44. # Results:
  45. #    name    name of the stack created
  46.  
  47. proc ::struct::stack::stack {{name ""}} {
  48.     variable stacks
  49.     variable counter
  50.     
  51.     if { [llength [info level 0]] == 1 } {
  52.     incr counter
  53.     set name "stack${counter}"
  54.     }
  55.  
  56.     if { ![string equal [info commands ::$name] ""] } {
  57.     error "command \"$name\" already exists, unable to create stack"
  58.     }
  59.     set stacks($name) [list ]
  60.  
  61.     # Create the command to manipulate the stack
  62.     interp alias {} ::$name {} ::struct::stack::StackProc $name
  63.  
  64.     return $name
  65. }
  66.  
  67. ##########################
  68. # Private functions follow
  69.  
  70. # ::struct::stack::StackProc --
  71. #
  72. #    Command that processes all stack object commands.
  73. #
  74. # Arguments:
  75. #    name    name of the stack object to manipulate.
  76. #    args    command name and args for the command
  77. #
  78. # Results:
  79. #    Varies based on command to perform
  80.  
  81. proc ::struct::stack::StackProc {name cmd args} {
  82.     # Split the args into command and args components
  83.     if { [lsearch -exact $::struct::stack::commands $cmd] == -1 } {
  84.     set optlist [join $::struct::stack::commands ", "]
  85.     set optlist [linsert $optlist "end-1" "or"]
  86.     error "bad option \"$cmd\": must be $optlist"
  87.     }
  88.     eval [list ::struct::stack::_$cmd $name] $args
  89. }
  90.  
  91. # ::struct::stack::_clear --
  92. #
  93. #    Clear a stack.
  94. #
  95. # Arguments:
  96. #    name    name of the stack object.
  97. #
  98. # Results:
  99. #    None.
  100.  
  101. proc ::struct::stack::_clear {name} {
  102.     set ::struct::stack::stacks($name) [list ]
  103.     return
  104. }
  105.  
  106. # ::struct::stack::_destroy --
  107. #
  108. #    Destroy a stack object by removing it's storage space and 
  109. #    eliminating it's proc.
  110. #
  111. # Arguments:
  112. #    name    name of the stack object.
  113. #
  114. # Results:
  115. #    None.
  116.  
  117. proc ::struct::stack::_destroy {name} {
  118.     unset ::struct::stack::stacks($name)
  119.     interp alias {} ::$name {}
  120.     return
  121. }
  122.  
  123. # ::struct::stack::_peek --
  124. #
  125. #    Retrive the value of an item on the stack without popping it.
  126. #
  127. # Arguments:
  128. #    name    name of the stack object.
  129. #    count    number of items to pop; defaults to 1
  130. #
  131. # Results:
  132. #    items    top count items from the stack; if there are not enough items
  133. #        to fufill the request, throws an error.
  134.  
  135. proc ::struct::stack::_peek {name {count 1}} {
  136.     variable stacks
  137.     if { $count < 1 } {
  138.     error "invalid item count $count"
  139.     }
  140.  
  141.     if { $count > [llength $stacks($name)] } {
  142.     error "insufficient items on stack to fill request"
  143.     }
  144.  
  145.     if { $count == 1 } {
  146.     # Handle this as a special case, so single item pops aren't listified
  147.     set item [lindex $stacks($name) end]
  148.     return $item
  149.     }
  150.  
  151.     # Otherwise, return a list of items
  152.     set result [list ]
  153.     for {set i 0} {$i < $count} {incr i} {
  154.     lappend result [lindex $stacks($name) "end-${i}"]
  155.     }
  156.     return $result
  157. }
  158.  
  159. # ::struct::stack::_pop --
  160. #
  161. #    Pop an item off a stack.
  162. #
  163. # Arguments:
  164. #    name    name of the stack object.
  165. #    count    number of items to pop; defaults to 1
  166. #
  167. # Results:
  168. #    item    top count items from the stack; if the stack is empty, 
  169. #        returns a list of count nulls.
  170.  
  171. proc ::struct::stack::_pop {name {count 1}} {
  172.     variable stacks
  173.     if { $count > [llength $stacks($name)] } {
  174.     error "insufficient items on stack to fill request"
  175.     } elseif { $count < 1 } {
  176.     error "invalid item count $count"
  177.     }
  178.  
  179.     if { $count == 1 } {
  180.     # Handle this as a special case, so single item pops aren't listified
  181.     set item [lindex $stacks($name) end]
  182.     set stacks($name) [lreplace $stacks($name) end end]
  183.     return $item
  184.     }
  185.  
  186.     # Otherwise, return a list of items
  187.     set result [list ]
  188.     for {set i 0} {$i < $count} {incr i} {
  189.     lappend result [lindex $stacks($name) "end-${i}"]
  190.     }
  191.  
  192.     # Remove these items from the stack
  193.     incr i -1
  194.     set stacks($name) [lreplace $stacks($name) "end-${i}" end]
  195.  
  196.     return $result
  197. }
  198.  
  199. # ::struct::stack::_push --
  200. #
  201. #    Push an item onto a stack.
  202. #
  203. # Arguments:
  204. #    name    name of the stack object
  205. #    args    items to push.
  206. #
  207. # Results:
  208. #    None.
  209.  
  210. proc ::struct::stack::_push {name args} {
  211.     if { [llength $args] == 0 } {
  212.     error "wrong # args: should be \"$name push item ?item ...?\""
  213.     }
  214.     foreach item $args {
  215.     lappend ::struct::stack::stacks($name) $item
  216.     }
  217. }
  218.  
  219. # ::struct::stack::_rotate --
  220. #
  221. #    Rotate the top count number of items by step number of steps.
  222. #
  223. # Arguments:
  224. #    name    name of the stack object.
  225. #    count    number of items to rotate.
  226. #    steps    number of steps to rotate.
  227. #
  228. # Results:
  229. #    None.
  230.  
  231. proc ::struct::stack::_rotate {name count steps} {
  232.     variable stacks
  233.     set len [llength $stacks($name)]
  234.     if { $count > $len } {
  235.     error "insufficient items on stack to fill request"
  236.     }
  237.  
  238.     # Rotation algorithm:
  239.     # do
  240.     #   Find the insertion point in the stack
  241.     #   Move the end item to the insertion point
  242.     # repeat $steps times
  243.  
  244.     set start [expr {$len - $count}]
  245.     set steps [expr {$steps % $count}]
  246.     for {set i 0} {$i < $steps} {incr i} {
  247.     set item [lindex $stacks($name) end]
  248.     set stacks($name) [lreplace $stacks($name) end end]
  249.     set stacks($name) [linsert $stacks($name) $start $item]
  250.     }
  251.     return
  252. }
  253.  
  254. # ::struct::stack::_size --
  255. #
  256. #    Return the number of objects on a stack.
  257. #
  258. # Arguments:
  259. #    name    name of the stack object.
  260. #
  261. # Results:
  262. #    count    number of items on the stack.
  263.  
  264. proc ::struct::stack::_size {name} {
  265.     return [llength $::struct::stack::stacks($name)]
  266. }
  267.