home *** CD-ROM | disk | FTP | other *** search
/ Chip: Linux Special / CorelLinux_CHIP.iso / VMware / bin / vmware-wizard / lib / util.tcl < prev   
Encoding:
Text File  |  1999-08-24  |  2.3 KB  |  142 lines
  1.  
  2. proc assert {exp} {
  3.     if ![uplevel "expr {$exp}"] {
  4.         error "ASSERT failed"
  5.     }
  6. }
  7.  
  8.  
  9. ###
  10. ### perl-like array operators
  11. ###
  12.  
  13. proc lsplice {list offset length {new {}}} {
  14.     upvar $list l
  15.     set last [expr {$offset + $length - 1}]
  16.     set ret [lrange $l $offset $last]
  17.     if {$offset > $last} {
  18.         set l [eval linsert {$l} {[expr $last + 1]} $new]
  19.     } else {
  20.         set l [eval lreplace {$l} {$offset} {$last} $new]
  21.     }
  22.     set ret
  23. }
  24.  
  25. proc lshift {list} {
  26.     upvar $list l
  27.     set ret [lindex $l 0]
  28.     set l [lrange $l 1 end]
  29.     set ret
  30. }
  31.  
  32. proc lunshift {list val} {
  33.     upvar $list l
  34.     set l [linsert $l 0 $val]
  35. }
  36.  
  37. proc lpush {list val} {
  38.     upvar $list l
  39.     lappend l $val
  40. }
  41.  
  42. proc lpop {list} {
  43.     upvar $list l
  44.     set last [expr {[llength $l] - 1}]
  45.     set ret [lindex $l $last]
  46.     set l [lreplace $l $last $last] 
  47.     set ret
  48. }
  49.  
  50. proc lmax {list} {
  51.     set max [lindex $list 0]
  52.     foreach l $list {
  53.         if {$l > $max} {
  54.             set max $l
  55.         }
  56.     }
  57.     set max
  58. }
  59.  
  60. proc lmin {list} {
  61.     set min [lindex $list 0]
  62.     foreach l $list {
  63.         if {$l < $min} {
  64.             set min $l
  65.         }
  66.     }
  67.     set min
  68. }
  69.  
  70. proc lprepend {list args} {
  71.     upvar $list l
  72.     eval set l \[linsert \$l 0 $args\]
  73.     return $l
  74. }
  75.  
  76. proc lreverse {list} {
  77.     set result {}
  78.     foreach element $list {
  79.         set result [linsert $result 0 $element]
  80.     }
  81.     return $result
  82. }
  83.  
  84.  
  85.  
  86. ###
  87. ### string ops
  88. ###
  89.  
  90. proc string_delete {str start {end {}}} {
  91.     if {$end == {}} {
  92.         set end $start
  93.     }
  94.     set start [string range $str 0 [expr {$start - 1}]]
  95.     set end [string range $str [expr {$end + 1}] end]
  96.     return "$start$end"
  97. }
  98.  
  99.  
  100. ###
  101. ### random -- courtesy of Don Libes, slightly hacked since then.
  102. ###
  103.  
  104. proc random {args} {
  105.     global _ran
  106.     
  107.     if { [llength $args]>1 } {
  108.         set _ran [lindex $args 1]
  109.     } else {
  110.         set period 233280
  111.         if { [info exists _ran] } {
  112.             set _ran [expr { ($_ran*9301 + 49297) % $period }]
  113.         } else {
  114.             set _ran [expr { [clock seconds] % $period } ]
  115.         }
  116.         return [expr { int($args*($_ran/double($period))) } ]
  117.     }
  118. }
  119.  
  120. random seed [clock seconds]
  121.  
  122.  
  123. ###
  124. ### other
  125. ###
  126.  
  127. proc max {args} {
  128.     lmax $args
  129. }
  130.  
  131. proc min {args} {
  132.     lmin $args
  133. }
  134.  
  135. proc map {list f} {
  136.     set ret {}
  137.     foreach l $list {
  138.         lappend ret [$f $l]
  139.     }
  140.     set ret
  141. }
  142.