camshoot.tcl

Linux下的MSN聊天程序源码

#		reloadAvailablePics
	}

	#Save the display picture somewhere on the hard disk
	proc webcampicture_saveas {w image} {
		set idx 1
		while { [file exists [file join [::config::getKey receiveddir] webcam{$idx}.jpg]] } { incr idx }
		set file "webcam${idx}.jpg"
		if {[catch {set filename [tk_getSaveFile -initialfile $file -initialdir [::config::getKey receiveddir]]} res]} {
			status_log "Error in webcampicture_saveas: $res \n"
			set filename [tk_getSaveFile -initialfile $file -initialdir [set ::HOME]]
		}

		set preview [image create photo]
		foreach {x0 y0 x1 y1} [::PrintBox::Done $w.mid.stillpreview] break
		if {$x1 > [image width $image]} { set x1 [image width $image]}
		if {$y1 > [image height $image]} { set y1 [image height $image]}
		$preview copy $image -from [expr int($x0)] [expr int($y0)] [expr int($x1)] [expr int($y1)]

		if {$filename != ""} {
			if {[catch {::picture::Save $preview $filename cxjpg} res]} {
				msg_box $res
			}
		}

		destroy $preview
		destroy $w

	}






#END OF PLUGIN'S OWN CODE, CLOSE "namespace" BRACKET
}




#PrintBox to select the area of the cam to set as DP : got from wiki.tcl.tk
namespace eval ::PrintBox {
	variable xy {}                              ;# Coordinates of print box
	variable CURSORS                            ;# Cursors to use while resizing
	variable bxy {}                             ;# Button down location
	variable bdown 0                            ;# Button is down flag
	variable minSize 64                        ;# Minimum size of print box
	variable grabSize 1                        ;# Size of "grab" area
	variable debug 0
	
	if {$::tcl_platform(platform) == "windows"} {
		array set CURSORS {
		L size_we      R size_we
		B size_ns      T size_ns
		TL size_nw_se  BR size_nw_se
		TR size_ne_sw  BL size_ne_sw
		}
	} else {
		array set CURSORS {
		L sb_h_double_arrow      R sb_h_double_arrow
		B sb_v_double_arrow      T sb_v_double_arrow
		TL top_left_corner       BR bottom_right_corner
		TR top_right_corner      BL bottom_left_corner
		}
	}

	##+##########################################################################
	#
	# ::PrintBox::Create -- creates the print box on top of canvas W
	#
	proc Create {W} {
		variable xy
		variable CURSORS
		variable bdown 0
		
		# Get initial location
		set w [winfo width $W]
		set h [winfo height $W]
		
		set x0 [$W canvasx 0]
		set y0 [$W canvasy 0]
		set x1 [expr {int($x0 + $w - $w / 8)}]
		set y1 [expr {int($y0 + $h - $h / 8)}]
		set x0 [expr {int($x0 + $w / 8)}]
		set y0 [expr {int($y0 + $h / 8)}]
		set xy [list $x0 $y0 $x1 $y1]
		
		# Create stubs items that ::PrintBox::Resize will size correctly
		$W delete pBox
#		$W create line 0 0 1 1 -tag {pBox diag1} -width 2 -fill red
#		$W create line 0 1 1 $y0 -tag {pBox diag2} -width 2 -fill red
		$W create rect 0 0 1 1 -tag {pBox pBoxx} -width 1 -outline red \
			-fill gray -stipple gray25
		$W bind pBoxx <Enter> [list $W config -cursor hand2]
		$W bind pBoxx <ButtonPress-1> [list ::PrintBox::PBDown $W box %x %y]
		$W bind pBoxx <B1-Motion> [list ::PrintBox::PBMotion $W box %x %y]
		
		foreach {color1 color2} {{} {}} break
		if {$::PrintBox::debug} {
			foreach {color1 color2} {yellow blue} break
		}
		
		# Hidden rectangles that we bind to for resizing
		$W create rect 0 0 0 1 -fill $color1 -stipple gray25 -width 0 -tag {pBox L}
		$W create rect 1 0 1 1 -fill $color1 -stipple gray25 -width 0 -tag {pBox R}
		$W create rect 0 0 1 0 -fill $color1 -stipple gray25 -width 0 -tag {pBox T}
		$W create rect 0 1 1 1 -fill $color1 -stipple gray25 -width 0 -tag {pBox B}
		$W create rect 0 0 0 0 -fill $color2 -stipple gray25 -width 0 -tag {pBox TL}
		$W create rect 1 0 1 0 -fill $color2 -stipple gray25 -width 0 -tag {pBox TR}
		$W create rect 0 1 0 1 -fill $color2 -stipple gray25 -width 0 -tag {pBox BL}
		$W create rect 1 1 1 1 -fill $color2 -stipple gray25 -width 0 -tag {pBox BR}
		
		foreach tag [array names CURSORS] {
			$W bind $tag <Enter> [list ::PrintBox::PBEnter $W $tag]
			$W bind $tag <Leave> [list ::PrintBox::PBLeave $W $tag]
			$W bind $tag <B1-Motion> [list ::PrintBox::PBMotion $W $tag %x %y]
			$W bind $tag <ButtonRelease-1> [list ::PrintBox::PBUp $W $tag]
			$W bind $tag <ButtonPress-1> [list ::PrintBox::PBDown $W $tag %x %y]
		}
		
		::PrintBox::Resize $W
	}
	##+##########################################################################
	#
	# ::PrintBox::Done -- kills the print box and returns its coordinates
	#
	proc Done {W} {
		variable xy
		$W delete pBox
		return $xy
	}
	##+##########################################################################
	#
	# ::PrintBox::Resize -- resizes the print box to ::PrintBox::xy size
	#
	proc Resize {W} {
		variable xy
		variable grabSize
		
		foreach {x0 y0 x1 y1} $xy break
		$W coords pBoxx $x0 $y0 $x1 $y1
		$W coords diag1 $x0 $y0 $x1 $y1
		$W coords diag2 $x1 $y0 $x0 $y1
		
		set w1 [$W itemcget pBoxx -width]           ;# NB. width extends outward
		set w2 [expr {-1 * ($w1 + $grabSize)}]
		
		foreach {x0 y0 x1 y1} [::PrintBox::GrowBox $x0 $y0 $x1 $y1 $w1] break
		foreach {x0_ y0_ x1_ y1_} [::PrintBox::GrowBox $x0 $y0 $x1 $y1 $w2] break
		$W coords L $x0 $y0_ $x0_ $y1_
		$W coords R $x1 $y0_ $x1_ $y1_
		$W coords T $x0_ $y0 $x1_ $y0_
		$W coords B $x0_ $y1 $x1_ $y1_
		$W coords TL $x0 $y0 $x0_ $y0_
		$W coords TR $x1 $y0 $x1_ $y0_
		$W coords BL $x0 $y1 $x0_ $y1_
		$W coords BR $x1 $y1 $x1_ $y1_
	}
	##+##########################################################################
	#
	# ::PrintBox::GrowBox -- grows (or shrinks) rectangle coordinates
	#
	proc GrowBox {x0 y0 x1 y1 d} {
		list [expr {$x0-$d}] [expr {$y0-$d}] [expr {$x1+$d}] [expr {$y1+$d}]
	}
	##+##########################################################################
	#
	# ::PrintBox::PBDown -- handles button down in a print box
	#
	proc PBDown {W tag x y} {
		variable bxy [list $x $y]
		variable bdown 1
	}
	##+##########################################################################
	#
	# ::PrintBox::PBUp -- handles button up in a print box
	#
	proc PBUp {W tag} {
		variable bdown 0
	}
	##+##########################################################################
	#
	# ::PrintBox::PBEnter -- handles <Enter> in a print box
	#
	proc PBEnter {W tag} {
		$W config -cursor $::PrintBox::CURSORS($tag)
	}
	##+##########################################################################
	#
	# ::PrintBox::PBLeave -- handles <Leave> in a print box
	#
	proc PBLeave {W tag} {
		variable bdown
		if {! $bdown} {
			$W config -cursor {}
		}
	}
	##+##########################################################################
	#
	# ::PrintBox::PBMotion -- handles button motion, moving or resizing as needed
	#
	proc PBMotion {W tag x y} {
		variable bxy
		variable xy
		variable minSize
		
		foreach {x0 y0 x1 y1} $xy break
		foreach {dx dy} $bxy break
		set dx [expr {$x - $dx}]
		set dy [expr {$y - $dy}]
		
		set w [winfo width $W]
		set h [winfo height $W]
		set wx0 [$W canvasx 0]
		set wy0 [$W canvasy 0]
		set wx1 [$W canvasx $w]
		set wy1 [$W canvasy $h]
		
		if {$tag eq "box"} {                        ;# Move the print box
			if {$x0 + $dx < $wx0} {set dx [expr {$wx0 - $x0}]}
			if {$x1 + $dx > $wx1} {set dx [expr {$wx1 - $x1}]}
			if {$y0 + $dy < $wy0} {set dy [expr {$wy0 - $y0}]}
			if {$y1 + $dy > $wy1} {set dy [expr {$wy1 - $y1}]}
		
			set x0 [expr {$x0 + $dx}]
			set x1 [expr {$x1 + $dx}]
			set y0 [expr {$y0 + $dy}]
			set y1 [expr {$y1 + $dy}]
		
			set xy [list $x0 $y0 $x1 $y1]
			set bxy [list $x $y]
		} else {                                    ;# Resize the print box
			if {$tag eq "L" || $tag eq "TL" || $tag eq "BL"} {
				set x0_ [expr {$x0 + $dx}]
				if {$x0_ < $wx0} {
					lset xy 0 $wx0
					lset bxy 0 0
				} elseif {$x1 - $x0_ >= $minSize} {
					lset xy 0 $x0_
					lset bxy 0 $x
				}
			}
			if {$tag eq "R" || $tag eq "TR" || $tag eq "BR"} {
				set x1_ [expr {$x1 + $dx}]
				if {$x1_ > $wx1} {
					lset xy 2 $wx1
					lset bxy 0 $w
				} elseif {$x1_ - $x0 >= $minSize} {
					lset xy 2 $x1_
					lset bxy 0 $x
				}
			}
			if {$tag eq "T" || $tag eq "TR" || $tag eq "TL"} {
				set y0_ [expr {$y0 + $dy}]
				if {$y0_ < $wy0} {
					lset xy 1 $wy0
					lset bxy 1 0
				} elseif {$y1 - $y0_ >= $minSize} {
					lset xy 1 $y0_
					lset bxy 1 $y
				}
			}
			if {$tag eq "B" || $tag eq "BR" || $tag eq "BL"} {
				set y1_ [expr {$y1 + $dy}]
				if {$y1_ > $wy1} {
					lset xy 3 $wy1
					lset bxy 1 $h
				} elseif {$y1_ - $y0 > $minSize} {
					lset xy 3 $y1_
					lset bxy 1 $y
				}
			}
		}
		::PrintBox::Resize $W
	}
}