msncam.tcl

Linux下的MSN聊天程序源码

				set source [getObjOption $sid source]
				$grabber configure -source $source
				$grabber start

				setObjOption $sid grab_proc "Grab_Windows"

			} elseif { [set ::tcl_platform(os)] == "Darwin" } {
				#Add grabber to the window
				if {![::CAMGUI::CreateGrabberWindowMac]} {
					::MSNCAM::CancelCam $chatid $sid
					return
				}
				setObjOption $sid grab_proc "Grab_Mac"

			} elseif { [set ::tcl_platform(os)] == "Linux" } {
				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 { ::Capture::Open $dev $channel } grabber] } {
					::MSNCAM::CancelCam $chatid $sid
					msg_box "[trans badwebcam]\n$grabber"
					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] && $set_b > 0 && $set_b < 65535 } {
						::Capture::SetBrightness $grabber $set_b
					}
					if {[string is integer -strict $set_c] && $set_c > 0 && $set_c < 65535 } {
						::Capture::SetContrast $grabber $set_c
					}
					if {[string is integer -strict $set_h] && $set_h > 0 && $set_h < 65535 } {
						::Capture::SetHue $grabber $set_h
					}
					if {[string is integer -strict $set_co] && $set_co > 0 && $set_co < 65535 } {
						::Capture::SetColour $grabber $set_co
					}
				}
				
				setObjOption $sid grab_proc "Grab_Linux"

				#scale $window.b -from 0 -to 65535 -resolution 1 -showvalue 1 -label "B" -command "::Capture::SetBrightness $grabber" -orient horizontal
				#scale $window.c -from 0 -to 65535 -resolution 1 -showvalue 1 -label "C" -command "::Capture::SetContrast $grabber" -orient horizontal
				#$window.b set 49500
				#$window.c set 39000
				#pack $window.b -expand true -fill x
				#pack $window.c -expand true -fill x

			} else {
				return
			}
			status_log "Created grabber : $grabber"
			set ::grabbers($grabber) [list]
			setObjOption $sid grabber $grabber
			set grab_proc [getObjOption $sid grab_proc]
			status_log "grab_proc is $grab_proc - [getObjOption $sid grab_proc]\n" red
			status_log "SID of this connection is $sid\n" red
		}

		if { $window == "" } {
			set window .webcam_$sid

			#Don't show the sending frame on Mac OS X (we already have the grabber)
			if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
				set img [image create photo [TmpImgName]]
				set w .grabber

				if { [winfo exists $w] } {
					if {![winfo exists $w.label]} {
						label $w.label -text "[trans webcamsending]"
						pack $w.label
					}
					#Add button for each contact you are sending webcam
					set buttontext [trunc [::abook::getDisplayNick $chatid] . 200 splainf]
					button $w.delete_$sid -command "::MSNCAM::CancelCam $chatid $sid" -text $buttontext
					pack $w.delete_$sid
					if {![info exists ::activegrabbers]} {
						set ::activegrabbers 0
					}
					set ::activegrabbers [expr {$::activegrabbers + 1}]
				}

			} else {
				set img [image create photo [TmpImgName]]
				toplevel $window
				wm title $window "$chatid - [::abook::getDisplayNick $chatid]"
				label $window.l -image $img
				pack $window.l
				bind $window.l <Destroy> "image delete $img"
				button $window.pause -command "::MSNCAM::PausePlayCam $window $socket" -text "[trans pausewebcamsend]"
				pack $window.pause -expand true -fill x
				button $window.settings -command "::CAMGUI::ShowPropertiesPage $grabber $img" -text "[trans changevideosettings]"
				pack $window.settings -expand true -fill x
				button $window.q -command "::MSNCAM::CancelCam $chatid $sid" -text "[trans stopwebcamsend]"
				pack $window.q -expand true -fill x
				wm protocol $window WM_DELETE_WINDOW "::MSNCAM::CancelCam $chatid $sid"
			}

			if {![catch {tk windowingsystem} wsystem] && $wsystem == "aqua"} {
				if {![winfo exists ::grabbers($grabber)]} {
					setObjOption $sid grab_proc "Grab_Mac"
					set ::grabbers($grabber) [list]
					setObjOption $sid grabber $grabber
					set grab_proc [getObjOption $sid grab_proc]
					status_log "grab_proc is $grab_proc - [getObjOption $sid grab_proc]\n" red
					status_log "SID of this connection is $sid\n" red
				}
			}

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

			lappend windows $window
			set ::grabbers($grabber) $windows

			setObjOption $sid window $window
			setObjOption $sid image $img
		}

		if { $grab_proc == "" } {
			if { [set ::tcl_platform(platform)] == "windows" } {
				setObjOption $sid grab_proc "Grab_Windows"

			} elseif { [set ::tcl_platform(os)] == "Darwin" } {
				setObjOption $sid grab_proc "Grab_Mac"

			} elseif { [set ::tcl_platform(os)] == "Linux" } {
				setObjOption $sid grab_proc "Grab_Linux"

			} else {
				return
			}
			set grab_proc [getObjOption $sid grab_proc]
			status_log "grab_proc is $grab_proc - [getObjOption $sid grab_proc]\n" red
		}


		if {[catch {$grab_proc $grabber $socket $encoder $img} res]} {
			status_log "Trying to call the grabber but get an error $res\n" red
		} 

	}

	proc Grab_Windows {grabber socket encoder img} {

		if { $encoder == "" } {
			set encoder [::Webcamsn::NewEncoder HIGH]
			setObjOption $socket codec $encoder
		}

		if { ![catch { $grabber picture $img} res] } {
			::MSNCAM::SendFrame $socket $encoder $img
		} else {
		    status_log "error grabbing : $res\n" red
		}
		#catch {fileevent $socket writable "::MSNCAM::WriteToSock $socket"}
	}

	proc Grab_Linux {grabber socket encoder img} {
		if { [::config::getKey lowrescam] == 1 } {
			set cam_res LOW
		} else {
			set cam_res HIGH
		}
		if { ([info exists ::test_webcam_send_log] && $::test_webcam_send_log != "") ||
		     ![catch { ::Capture::Grab $grabber $img $cam_res} res] } {
			if { !([info exists ::test_webcam_send_log] && 
			      $::test_webcam_send_log != "") &&$encoder == "" } {
				if { $res == "" } { set res $cam_res }
				set encoder [::Webcamsn::NewEncoder $res]
				setObjOption $socket codec $encoder
			}
			::MSNCAM::SendFrame $socket $encoder $img
		} else {
		    status_log "error grabbing : $res\n" red
		}
		#catch {fileevent $socket writable "::MSNCAM::WriteToSock $socket"}
	}

	proc Grab_Mac { grabber socket encoder img } {

		if { $encoder == "" } {
			set encoder [::Webcamsn::NewEncoder HIGH]
			setObjOption $socket codec $encoder
		}

		if {[winfo ismapped $grabber]} {
			set socker_ [getObjOption $img socket]
			set encoder_ [getObjOption $img encoder]

			if { $socker_ == "" || $encoder_ == "" } {
				setObjOption $img socket $socket
				setObjOption $img encoder $encoder
			}
			$grabber image ImageReady_Mac $img
			::CAMGUI::ImageReady_Mac $grabber $img
		}

		#catch {fileevent $socket writable "::MSNCAM::WriteToSock $socket"}

	}
	
	proc ImageReady_Mac {w img } {
		set socket [getObjOption $img socket]
		set encoder [getObjOption $img encoder]
		if { $socket == "" || $encoder == "" } { return }
		::MSNCAM::SendFrame $socket $encoder $img
	}
	
	#We use that proc when we try to create the grabber window
	proc CreateGrabberWindowMac {} {
		set w .grabber
		#Stop if the grabber is already there
		if { [winfo exists $w] } {
			return 1
		}
		
		toplevel $w
		wm protocol $w WM_DELETE_WINDOW "::CAMGUI::CloseGrabberWindowMac"
		if { [::config::getKey lowrescam] == 1 } {
			set camwidth 160
		} else {
			set camwidth 320
		}
	
		#Add grabber to the window
		#Show message error if it's not possible
		if { ![catch {seqgrabber $w.seq -width $camwidth} res] } {
			
			catch {$w.seq configure -volume 0}
			pack $w.seq
					
			#Add button to change settings
			button $w.settings -command "::CAMGUI::ChooseDeviceMac" -text "[trans changevideosettings]"
			pack $w.settings
			
			#Add zoom option
			label $w.zoomtext -text "[trans zoom]:" -font sboldf
			spinbox $w.zoom -from 1 -to 5 -increment 0.5 -width 2 -command "catch {$w.seq configure -zoom %s}"
			pack $w.zoomtext
			pack $w.zoom
		} else {
			destroy $w
			#If it's not possible to create the video frame, show the error
			::amsn::messageBox "$res" ok error "[trans failed]"
			return 0
		}
		
		return 1
	}
	
	#This proc is used when someone try to close the grabber window
	proc CloseGrabberWindowMac {} {
		#If the variable activegrabbers doesn't exist, create one and delete the window
		if {![info exists ::activegrabbers]} {
			destroy .grabber
			set ::activegrabbers 0
		}
		
		#If there's no webcam grabber active, destroy the window
		if {$::activegrabbers < 1} {
			destroy .grabber
			set ::activegrabbers 0
		} else {
			msg_box "[trans webcamclosebefcancel]"
		}
	}

	proc IsGrabberValid { grabber } {
#		status_log "Testing grabber : $grabber"
		if { !([info exists ::capture_loaded] && $::capture_loaded) } { return 0 }

		if { [set ::tcl_platform(platform)] == "windows" } {
			return [winfo exists $grabber]
		} elseif { [set ::tcl_platform(os)] == "Darwin" } {
			return [winfo exists $grabber]
		} elseif { [set ::tcl_platform(os)] == "Linux" } {
			return [::Capture::IsValid $grabber]
		} else {
			return 0
		}
	}

	proc CloseGrabber { grabber window } {
		if { !([info exists ::capture_loaded] && $::capture_loaded ) } { return }

		if { ![info exists ::grabbers($grabber)] } { return }

		set windows $::grabbers($grabber)
		#status_log "For grabber $grabber : windows are $windows"
		set idx [lsearch $windows $window]

		if { $idx == -1 } {
			status_log "Window $window not found in $windows"
			return
		}
		set windows [lreplace $windows $idx $idx]
		status_log "Removed window $window idx : $idx from windows"
		status_log "Now windows is $windows"
		set ::grabbers($grabber) $windows

		if { [llength $windows] > 0 } { return }

		if { [set ::tcl_platform(os)] == "Linux" } {
			::Capture::Close $grabber
		} elseif { [set ::tcl_platform(os)] == "Darwin" } {
			destroy $grabber
			destroy .grabber
		} elseif { [set ::tcl_platform(platform)] == "windows" } {
			destroy $grabber
		}
		unset ::grabbers($grabber)

	}

	proc CaptureLoaded { } {
		if { [info exists ::capture_loaded] && $::capture_loaded } { return 1 }

		if { [set ::tcl_platform(platform)] == "windows" } {
			set extension "tkvideo"
		} elseif { [set ::tcl_platform(os)] == "Darwin" } {
			set extension "QuickTimeTcl"
		} elseif { [set ::tcl_platform(os)] == "Linux" } {
			set extension "capture"
		} else {
			set ::capture_loaded 0
			return 0
		}

		if { [catch {package require $extension}] } {
			set ::capture_loaded 0
			return 0
		} else {
			
			#Verify for that pwc_driver
			if { [set ::tcl_platform(os)] == "Linux" }  {
				catch { exec /sbin/lsmod } pwc_driver
				if {[string first $pwc_driver "pwc"] != -1 } {
					set ::pwc_driver 1
				} else {
					set ::pwc_driver 0
				}
			}
			set ::capture_loaded 1
			array set ::grabbers {}
			return 1
		}

	}

	proc ExtensionLoaded { } {
		if { [info exists ::webcamsn_loaded] && $::webcamsn_loaded } { return 1}

		if { [catch {package require webcamsn}] } {
			set ::webcamsn_loaded 0
			return 0
		} else {
			foreach lib [info loaded] {
				if { [lindex $lib 1] == "Webcamsn" } {
					set ::webcamsn_loaded 1
					return 1
				} 
			}
		}
	}

	proc AcceptOrRefuse {chatid dest branchuid cseq uid sid producer} {
		SendMessageFIFO [list ::CAMGUI::AcceptOrRefuseWrapped $chatid $dest $branchuid $cseq $uid $sid $producer] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
	}
	#Executed when we receive a request to accept or refuse a webcam session
	proc AcceptOrRefuseWrapped {chatid dest branchuid cseq uid sid producer} {
		
		#Grey line
		::amsn::WinWrite $chatid "\n" green
		::amsn::WinWriteIcon $chatid greyline 3
		::amsn::WinWrite $chatid "\n" green
		
		::amsn::WinWriteIcon $chatid winwritecam 3 2
		#Show invitation
		::amsn::WinWrite $chatid "[timestamp] [trans webcaminvitereceived [::abook::getDisplayNick $chatid]]" green
		
		#Accept and refuse actions
		::amsn::WinWrite $chatid " - (" green
		::amsn::WinWriteClickable $chatid "[trans accept]" [list ::CAMGUI::InvitationAccepted $chatid $dest $branchuid $cseq $uid $sid $producer] acceptwebcam$sid
		::amsn::WinWrite $chatid " / " green
		::amsn::WinWriteClickable $chatid "[trans reject]" [list ::CAMGUI::InvitationRejected $chatid $sid $branchuid $uid] nowebcam$sid
		::amsn::WinWrite $chatid ")\n" green
		
		#Grey line
		::amsn::WinWriteIcon $chatid greyline 3

	}
	
	proc GotVideoConferenceInvitation {chatid} {			
		SendMessageFIFO [list ::CAMGUI::GotVideoConferenceInvitationWrapped $chatid] "::amsn::messages_stack($chatid)" "::amsn::messages_flushing($chatid)"
	}
	
	
	#Show a message when we receive a video-conference invitation to ask the user if he wants
	#To ask to receive/send webcam because video-conference is not supported
	proc GotVideoConferenceInvitationWrapped {chatid} {
		
		#Grey line
		::amsn::WinWrite $chatid "\n" green
		::amsn::WinWriteIcon $chatid greyline 3
		::amsn::WinWrite $chatid "\n" green
		#WebcamIcon
		::amsn::WinWriteIcon $chatid winwritecam 3 2
		#Description of the problem
		::amsn::WinWrite $chatid "[timestamp] [trans videoconversationrequest]\n" green
		#Choices of action
		::amsn::WinWriteClickable $chatid "[trans clickhere]" [list ::CAMGUI::AskWebcamAfterVideoInvitation $chatid] askwebcam$chatid
		::amsn::WinWrite $chatid " [trans askcontactwebcam]" green
		::amsn::WinWriteClickable $chatid "[trans clickhere]" [list ::CAMGUI::SendInviteCamAfterVideoInvitation $chatid] sendwebcam$chatid	
		::amsn::WinWrite $chatid " [trans asksendingyourwebcam]" green
			
	}
	#After we clicke