My Tips

私が頻繁に再作成するコード

Tcl

c#のプロパティのset/getのような実装

	proc Config { name args } {
		global _config_
		switch [llength $args] {
			0 {
				return $_config_($name)
			}
			1 {
				set _config_($name) [lindex $args 0]
				return $_config_($name)
			}
		}
	}
	Config version 1 ;# これで設定
	puts "version [Config version]" ;# これで取得

	itcl::class A {
	    variable a
		public method A { args } {
			switch [llength $args] {
				0 {
					return $a
				}
				1 {
					set a [lindex $args 0]
					return $a
				}
			}
		}
	}
	

関数名でプロパティの空間を分けるような実装

下の例では、_config_, _gvar_という大域変数が用いられる。

	proc storage { vname name args } {
		upvar #0 $vname x
		if {[llength $args] > 0} {
			set x($name) [lindex $args 0]
		}
		return $x($name)
	}

	proc config { name args } { return [eval [subst "storage _config_ $name $args"]] }
	proc gvar { name args } { return [eval [subst "storage _gvar_ $name $args"]] }

	# 使い方
	config version 1.0
	gvar state idle
	if ![string compare idle [gvar state]] {
	    ...
	}
	

操作を指定してプロパティを実装

	proc Config { cmd name args } {
		global _config_
		switch $cmd {
			Set {
				if {[llength $args] > 0} {
					set _config_($name) [lindex $args 0]
				}
				return $_config_($name)
			}
			Get {
				return $_config_($name)
			}
			Exists {
				return [info exists _config_($name)]
			}
		}
	}
	

Tk

ボックスを線でつなぐ

	    # scx scy - center position of source box.
	    # dcy dcy - center position of destination box.
	    # sw  sh  - width/height of source box.
	    # dw  dh  - width/height of destination box

		set dx [expr $dcx - $scx]
		set dy [expr $dcy - $scy]
		set slope [expr (($dy+0.0)/($dx+0.0))]
		set spoints [InterceptPoints $scx $scy $sw $sh $slope]
		set dpoints [InterceptPoints $dcx $dcy $dw $dh $slope]
		# find shortest 2 points which can construct a line.
		set min -1
		for {set i 0} {$i < [llength $spoints]} {incr i} {
			set sxy [lindex $spoints $i]
			for {set j 0} {$j < [llength $dpoints]} {incr j} {
				set dxy [lindex $dpoints $j]
				set d [Distance $sxy $dxy]
				if {$min == -1 || $d < $min} {
					set min $d
					set x1 [lindex $sxy 0]
					set y1 [lindex $sxy 1]
					set x2 [lindex $dxy 0]
					set y2 [lindex $dxy 1]
				}
			}
		}
		# draw line from (x1,y1) to (x2, y2).

	public method InterceptPoints { cx cy w h slope } {
		set x1 [expr -$w/2]
		set y1 [expr -$h/2]
		set x2 [expr $x1+$w]
		set y2 [expr $y1+$h]
		#        L1            Y = aX
		#    +--------+        X = (1/a)Y
		# L4 |        | L2
		#    +--------+
		#        L3
		
		# L1
		set ty(1) $y1
		set tx(1) [expr (1./$slope)*$ty(1)]
		# L2
		set tx(2) $x2
		set ty(2) [expr $slope*$tx(2)]
		# L3
		set ty(3) $y2
		set tx(3) [expr (1./$slope)*$ty(3)]
		# L4
		set tx(4) $x1
		set ty(4) [expr $slope*$tx(4)]

		set points {}
		for {set i 1} {$i <= 4} {incr i} {
			if {$tx($i) > [expr $x1-1] && $tx($i) < [expr $x2+1] && $ty($i) > [expr $y1-1] && $ty($i) < [expr $y2+1]} {
				lappend points [list [expr $cx+$tx($i)] [expr $cy+$ty($i)]]
			}
		}
		return $points
	}
		
	public method Distance { xy1 xy2 } {
		if {$xy1 == {} || $xy2 == {}} {
			return
		}
		set x1 [lindex $xy1 0]
		set y1 [lindex $xy1 1]
		set x2 [lindex $xy2 0]
		set y2 [lindex $xy2 1]
		set dx [expr $x2-$x1]
		set dy [expr $y2-$y1]
		return [expr sqrt(($dx*$dx) + ($dy*$dy))]
	}