File: array.tcl

package info (click to toggle)
swig 1.1p5-1
  • links: PTS
  • area: main
  • in suites: hamm
  • size: 9,448 kB
  • ctags: 5,025
  • sloc: cpp: 21,599; ansic: 13,333; yacc: 3,297; python: 2,794; makefile: 2,197; perl: 1,984; tcl: 1,583; sh: 736; lisp: 201; objc: 143
file content (26 lines) | stat: -rw-r--r-- 646 bytes parent folder | download | duplicates (4) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
# A mildly amusing array example that turns C pointers into Tcl "objects"

catch { load ./array.so }
catch { load ./array.dll }

proc Array {type size} {
    set ptr [new_$type $size]
    set code {
	set method [lindex $args 0] 
	set parms [concat $ptr [lrange $args 1 end]] 
	switch $method { 
	    get {return [eval "get_$type $parms"]} 
	    set {return [eval "set_$type $parms"]} 
	    delete {eval "delete_$type $ptr; rename $ptr {}"}
	}
    }
    uplevel "proc $ptr args {set ptr $ptr; set type $type;$code}"
    return $ptr
}

proc ClearArray {array size value} {
    for {set i 0} {$i < $size} {incr i 1} {
	$array set $i $value
    }
}