camshoot.tcl

Linux下的MSN聊天程序源码

##################################################
#  This plugin implements  ...                   #
#  (c) Karel Demeyer, 2005                       #
#  ============================================  #
##################################################


##############################
# ::camshoot                 #
#  All camshoot related code #
##############################
namespace eval ::camshoot {



	################################################
	# Init( dir )                                  #
	#  Registration & initialization of the plugin #
	################################################
	proc Init { dir } {
		::plugins::RegisterPlugin "Cam Shooter"

		#Register the events to the plugin system
		::plugins::RegisterEvent "Cam Shooter" xtra_choosepic_buttons CreateShootButton
		
		set langdir [file join $dir "lang"]
		set lang [::config::getGlobalKey language]
		#It's important to load the english file and then the current language lang file
		load_lang en $langdir
		load_lang $lang $langdir
		
	}



	proc CreateShootButton { event evpar } {
		upvar 2 $evpar newvar

		button $newvar(win).webcam -command "::camshoot::webcampicture" -text "[trans webcamshot]"
		grid $newvar(win).webcam -row 4 -column 3 -padx 3 -pady 3 -stick new
	
	
	}
	
	#Create .webcampicture window
	#With that window we can get a picture from our webcam and use it as a display picture
	#Actually only compatible with QuickTimeTcl, but support for TkVideo could be added
	proc webcampicture {} {
		if { ! [info exists ::capture_loaded] } { ::CAMGUI::CaptureLoaded }
		if { ! $::capture_loaded } { return }

		set source [::config::getKey "webcamDevice" "0"]
		set window .dp_preview

		if { [set ::tcl_platform(platform)] == "windows" } {
			if { [winfo exists $window] } {
				raise $window
				return
			}

			set grabber .dpgrabber
			set grabber [tkvideo $grabber]
			if { [catch {$grabber configure -source $source}] } {
				msg_box "[trans badwebcam]"
				destroy $grabber
				return
			}
			$grabber start

			set img [image create photo]
			toplevel $window
			wm title $window "[trans webcamshot]"
			label $window.l -image $img
			pack $window.l
			button $window.settings -command "::CAMGUI::ShowPropertiesPage $grabber $img" -text "[trans changevideosettings]"
			pack $window.settings -expand true -fill x
			button $window.shot -text "[trans takesnapshot]" -command "::camshoot::webcampicture_shot $window"
			pack $window.shot -expand true -fill x
			bind $window <Destroy> "destroy $grabber"
			after 0 "::CAMGUI::PreviewWindows $grabber $img"

		} elseif { [set ::tcl_platform(os)] == "Darwin" } {
			#Add grabber to the window
			set w .grabber
			if {![::CAMGUI::CreateGrabberWindowMac]} {
				return
			}

			#Action button to take the picture
			if {![winfo exists $w.shot]} {
				button $w.shot -text "[trans takesnapshot]" -command "::camshoot::webcampicture_shot $w"
				pack $w.shot
			}

		} elseif { [set ::tcl_platform(os)] == "Linux" } {
			if { [winfo exists $window] } {
				raise $window
				return
			}

			if {$source == "0" } { 
				set source "/dev/video0:0"
			}
			set pos [string last ":" $source]
			set dev [string range $source 0 [expr $pos-1]]
			set channel [string range $source [expr $pos+1] end]

			
			if { [catch {set grabber [::Capture::Open $dev $channel]}] } {
				msg_box "[trans badwebcam]"
				return
			}
			
			if { ![info exists ::webcam_settings_bug] || $::webcam_settings_bug == 0} {
				set settings [::config::getKey "webcam$dev:$channel" "0:0:0:0"]
				set settings [split $settings ":"]
				set set_b [lindex $settings 0]
				set set_c [lindex $settings 1]
				set set_h [lindex $settings 2]
				set set_co [lindex $settings 3]

				if {[string is integer -strict $set_b]} {
					::Capture::SetBrightness $grabber $set_b
				}
				if {[string is integer -strict $set_c]} {
					::Capture::SetContrast $grabber $set_c
				}
				if {[string is integer -strict $set_h]} {
					::Capture::SetHue $grabber $set_h
				}
				if {[string is integer -strict $set_co]} {
					::Capture::SetColour $grabber $set_co
				}
			}

			set img [image create photo]
			toplevel $window
			wm title $window "[trans webcamshot]"
			label $window.l -image $img
			pack $window.l
			button $window.settings -command "::CAMGUI::ShowPropertiesPage $grabber $img" -text "[trans changevideosettings]"
			pack $window.settings -expand true -fill x
			button $window.shot -text "[trans takesnapshot]" -command "::camshoot::webcampicture_shot $window"
			pack $window.shot -expand true -fill x
			bind $window <Destroy> "::CAMGUI::CloseGrabber $grabber $window"

			if { [info exists ::grabbers($grabber)] } {
				set windows $::grabbers($grabber)
			} else {
				set windows [list]
			}
	
			lappend windows $window
			set ::grabbers($grabber) $windows

			after 0 "::CAMGUI::PreviewLinux $grabber $img"

		}
	}

	#Create the window to accept or refuse the photo
	proc webcampicture_shot {window} {

		set w .webcampicturedoyoulikeit

		if { [winfo exists $w] } {
			destroy $w
		}
		toplevel $w

		set preview [image create photo]
		if { [set ::tcl_platform(platform)] == "windows" } {
			$preview copy [$window.l cget -image]
		} elseif { [set ::tcl_platform(os)] == "Darwin" } {
			.grabber.seq picture $preview
		} elseif { [set ::tcl_platform(os)] == "Linux" } {
			$preview copy [$window.l cget -image]
		}



		#Create upper informational frame
		set up $w.infotext
		frame $up
		label $up.label -text "[trans cutimagebox]"  -font sboldf
		pack $up.label
		

		#create middle frame
		set mid $w.mid
		frame $mid


		#create picture (middle-left)
		canvas $mid.stillpreview -width 320 -height 240
		$mid.stillpreview create image 0 0 -anchor nw -image $preview
		::PrintBox::Create $mid.stillpreview


		#create the frame where the buttons are to resize the selection box (middle-right)
		frame $mid.resel -class Degt
		button $mid.resel.huge -text "[trans huge]" -command "set ::PrintBox::xy {0 0 192 192}; ::PrintBox::Resize $w.mid.stillpreview"
		button $mid.resel.large -text "[trans large]" -command "set ::PrintBox::xy {0 0 128 128}; ::PrintBox::Resize $w.mid.stillpreview"
		button $mid.resel.default -text "[trans default2]" -command "set ::PrintBox::xy {0 0 96 96}; ::PrintBox::Resize $w.mid.stillpreview"
		button $mid.resel.small -text "[trans small]" -command "set ::PrintBox::xy {0 0 64 64}; ::PrintBox::Resize $w.mid.stillpreview"
		label $mid.resel.text -text "[trans cutimageboxreset]"
		
		pack $mid.resel.text $mid.resel.small $mid.resel.default $mid.resel.large $mid.resel.huge -side top -pady 3

		pack $mid.stillpreview $mid.resel -side left -fill y


		#create lower frame
		set low $w.lowerframe
		frame $low 
		button $low.use -text "[trans useasdp]" -command "::camshoot::webcampicture_save $w $preview"
		button $low.saveas -text "[trans saveas]" -command "::camshoot::webcampicture_saveas $w $preview"
		button $low.cancel -text "[trans cancel]" -command "destroy $w"
		pack $low.use $low.saveas $low.cancel -side right -padx 5


		#pack everything in the window
		pack $up $mid $low -side top -fill both



		bind $w <Destroy> "destroy $preview"


		wm title $w "[trans changedisplaypic]"
		moveinscreen $w 30
		after 0 "$w.mid.resel.default invoke"

	}
	#Use the picture as a display picture
	proc webcampicture_save {w image} {
		global HOME selected_image

		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)]

		set idx 1
		while { [file exists [file join $HOME displaypic webcam$idx.png]] } { incr idx }
		set file "[file join $HOME displaypic webcam$idx.png]"

		#We first save it in PNG
		if {[catch {::picture::Save $preview $file cxpng} res]} {
			msg_box $res
		}
		destroy $preview
		destroy $w

		#Open pictureBrowser if user closed it
		if {![winfo exists .picbrowser]} {
			pictureBrowser
		}
		
		#Set image_name
		set image_name [image create photo -file [::skin::GetSkinFile displaypic $file] -format cximage]
		#Change picture in .mypic frame of .picbrowser
		.picbrowser.mypic configure -image $image_name

		#Set selected_image global variable
		set selected_image "[filenoext [file tail $file]].png"

		#Write inside .dat file
		set desc_file "[filenoext [file tail $file]].dat"
		set fd [open [file join $HOME displaypic $desc_file] w]
		#status_log "Writing description to $desc_file\n"
		puts $fd "[clock format [clock seconds] -format %x]\n[filenoext [file tail $file]].png"
		close $fd


		lappend image_names $image_name
		#status_log "Created $image_name\n"
		destroy .webcampicturedoyoulikeit
		raise .picbrowser