An easy wrapper for the famous mplayer to embed videos into Tcl/Tk applications.
Provide
#!/usr/bin/tclsh # Author: Detlef Groth # License MIT # Version 0.2 working and usable # Version 0.2 adds support for direct play of youtube videos # Version 0.3 fixes issue if youtube-dl is not installed but tried to load an youtube video # Version 0.4 fix vnc issues and missing medium and small tags issues in youtube videos # youtube-dl script is required for youtube urls see https://rg3.github.io/youtube-dl/ package require Tk package require snit package provide SnitMPlayer 0.4 snit::widget SnitMPlayer { option -infile "" variable mplayer "" variable position 0:00 variable container "" variable toolbar "" variable treeview constructor {args} { $self configurelist $args pack [panedwindow $win.pan -orient horizontal] -side left -expand yes -fill both -pady 2 -padx 2 ttk::treeview $win.pan.tv -columns [list title id] -show headings $win.pan.tv heading title -text Title $win.pan.tv heading id -text VideoId set treeview $win.pan.tv bind $treeview <Double-1> [mymethod tvOnClick %W %x %y] frame $win.pan.f frame $win.pan.f.container -container yes set container $win.pan.f.container #$win.pan.tv configure -width 200 #.$win.pan.f configure -width 100 $win.pan add $win.pan.tv $win.pan.f pack $win.pan.f.container -fill both -expand yes #-cookies -cookies-file ${COOKIE_FILE} $($1) set toolbar [frame $win.pan.f.toolbar] pack [button $toolbar.btnopen -command [mymethod fileOpen] -image fileopen-16] -side left -padx 5 -pady 5 pack [button $toolbar.btnpaase -command [mymethod mplayerCmd] -image playpause16] -side left -padx 5 -pady 5 pack [button $toolbar.btnstart -command [mymethod mplayerCmd "set_property time_pos 0"] -image player_start-16] -side left -padx 5 -pady 5 pack [button $toolbar.btnforward -command [mymethod mplayerCmd "seek -10"] -image 1leftarrow-16] -side left -padx 5 -pady 5 pack [button $toolbar.btnbackward -command [mymethod mplayerCmd "seek +10"] -image 1rightarrow-16] -side left -padx 5 -pady 5 pack [button $toolbar.btnend -command [mymethod mplayerCmd "seek 99.5 1"] -image player_end-16] -side left -padx 5 -pady 5 pack [button $toolbar.btnaudiodn -command [mymethod mplayerCmd "volume -10"] -image actitemdelete16] -side left -padx 5 -pady 5 pack [button $toolbar.btnaudioup -command [mymethod mplayerCmd "volume +10"] -image actitemadd16] -side left -padx 5 -pady 5 pack [entry $toolbar.pos -textvariable [myvar position] -width 6] -side left -padx 5 -pady 5 bind $toolbar.pos <Return> [mymethod gotoPosition] pack [button $toolbar.btnexit -command [mymethod exit] -image actcross16] -side left -padx 5 -pady 5 #$self openVideo $options(-infile) } typeconstructor { image create photo 1leftarrow-16 -data { R0lGODlhEAAQAIAAAP///wAAACH5BAEAAAAALAAAAAAQABAAAAIdhI+pyxqd woNGTmgvy9px/IEWBWRkKZ2oWrKu4hcAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo 1rightarrow-16 -data { R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIdhI+pyxCt woNHTmpvy3rxnnwQh1mUI52o6rCu6hcAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo player_start-16 -data { R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIjhI+pyxud wlNyguqkqRZh3h0gl43hpoElqlHt9UKw7NG27BcAIf5oQ3JlYXRlZCBieSBC TVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4 LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5j b20AOw== } image create photo player_end-16 -data { R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIjhI+py8Eb 3ENRggrxjRnrVIWcIoYd91FaenysMU6wTNeLXwAAIf5oQ3JlYXRlZCBieSBC TVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4 LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5j b20AOw== } image create photo player_stop-16 -data { R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIahI+py+1v gpySUWpvXXqrHmSaeJEYhKYq6hcAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQ cm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmln aHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo fileopen-16 -data { R0lGODlhEAAQAIUAAPwCBAQCBOSmZPzSnPzChPzGhPyuZEwyHExOTFROTFxa VFRSTMSGTPT29Ozu7Nze3NTS1MzKzMTGxLy6vLS2tLSytDQyNOTm5OTi5Ly+ vKyqrKSmpIyOjLR+RNTW1MzOzJyenGxqZBweHKSinJSWlExKTMTCxKyurGxu bBQSFAwKDJyanERCRERGRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAaR QIBwGCgGhkhkEWA8HpNPojFJFU6ryitTiw0IBgRBkxsYFAiGtDodDZwPCERC EV8sEk0CI9FoOB4BEBESExQVFgEEBw8PFxcYEBIZGhscCEwdCxAPGA8eHxkU GyAhIkwHEREQqxEZExUjJCVWCBAZJhEmGRUnoygpQioZGxsnxsQrHByzQiJx z3EsLSwWpkJ+QQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9u IDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2 ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo playpause16 -data { R0lGODlhEAAQAIAAAPwCBAQCBCH5BAEAAAAALAAAAAAQABAAAAIfhI+py+1v goxzyUCxrZd18ClfmIyVyJ1lqkHuC0N+AQAh/mhDcmVhdGVkIGJ5IEJNUFRv R0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFs bCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } image create photo actitemadd16 -data { R0lGODlhEAAQAIQAAPwCBERCBKSepJyenJyWnJyanJSWlJSOlJSSlIyKjIyG jISGhIR+hGRiZHx+fHx2fERGBHx6fAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA AAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVpICCOZGkG aGqSgTAMRLCOQTEY8SzWBHHIpRTKgED8hDtBoWBoHhKKxYIRaABqBYTh8Iwy HI/qtdA7GBQJKYPxgFgDRKPC64hEwm9heuEQillTdVUNhFYsEQ5sfysBYA94 On6LK4WFJH4hACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZlcnNpb24g Mi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyByZXNlcnZl ZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= } image create photo actitemdelete16 -data { R0lGODlhEAAQAIMAAPwCBERCBKSmpGRiZJSWlJyanIyKjIR+hHx6fAAAAAAA AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAQ4EMhJq704681n +GAYSoFgnqgZDEBAFEbxxnOxtoeh77xxB4jgIYgYEn+i5IcFGDifUGhnSq1a /BEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkg RGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0 cDovL3d3dy5kZXZlbGNvci5jb20AOw== } image create photo actcross16 -data { R0lGODlhEAAQAIIAAASC/PwCBMQCBEQCBIQCBAAAAAAAAAAAACH5BAEAAAAA LAAAAAAQABAAAAMuCLrc/hCGFyYLQjQsquLDQ2ScEEJjZkYfyQKlJa2j7AQn MM7NfucLze1FLD78CQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJz aW9uIDIuNQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVz ZXJ2ZWQuDQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 } } destructor { if {$mplayer ne ""} { puts $mplayer "quit" flush $mplayer } } method tvOnClick {w x y} { puts "$w $x $y" set row [$treeview identify item $x $y] set id [lindex [$treeview item $row -values] 1] $self mplayerCmd "stop" $self openVideo https://www.youtube.com/watch?v=$id } method addToolbar {} { pack $toolbar -side top -expand false -anchor c } method ReadPipe {chan} { set d [read $chan] foreach line [split $d \n] { set line [string trim $line] puts $line } if {[eof $chan]} { fileevent $chan readable {} close $chan set mplayer "" } } method getPlaylist {playlist} { if {[auto_execok youtube-dl] eq ""} { tk_messageBox -title "Error!" -icon error -message "This feature requires youtube-dl commandline application" -type ok return } set pll [list] if {[file exists /tmp/$playlist.txt]} { if [catch {open /tmp/$playlist.txt r} infh] { puts stderr "Cannot open $playlist.txt: $infh" exit } else { while {[gets $infh line] >= 0} { lappend pll [lindex [split $line "\t"] 0] lappend pll [lindex [split $line "\t"] 1] } close $infh } } else { set out [open /tmp/$playlist.txt w 0600] set res [exec youtube-dl --get-id --get-title $playlist -i] foreach {title id} [split $res "\n"] { lappend pll $id lappend pll $title puts $out "$id\t$title" } close $out } set x 0 foreach {id title} $pll { if {[incr x] == 1} { $self openVideo https://www.youtube.com/watch?v=$id } $treeview insert {} end -values [list $title $id] } } method getFormat {url} { set res [exec youtube-dl -F $url] array set has [list] foreach line [split $res "\n"] { if {[regexp {([0-9]{2})\s+(3gp|mp4)\s+(320|640).+(small|medium)} $line -> f format size res] } { #puts $line set has($res) $f } if {[regexp {([0-9]{2,3})\s+(3gp|mp4)\s+([56][0-9]{2}x[34][0-9]{2})} $line -> f format size] } { #puts $line if {![regexp {only} $line]} { set has(medium) $f } } if {[regexp {([0-9]{2,3})\s+(3gp|mp4)\s+([2-4][0-9]{3}x3[0-9]{2})} $line -> f format size] } { #puts $line if {![regexp {only} $line]} { set has(small) $f } } } if {[info exists has(medium)]} { return $has(medium) } elseif {[info exists has(small)]} { return $has(small) } else { error no-video-stream-found } } method openVideo {filename} { if {[regexp {^PL} $filename]} { $self getPlaylist $filename return } if {[regexp {https://www.youtube} $filename]} { if {[auto_execok youtube-dl] eq ""} { tk_messageBox -title "Error!" -icon error -message "This feature requires youtube-dl commandline application" -type ok # dummy pipe for local files starting # but does not work :( channel closes # just start an idle pipe waiting for local file input set fid [open "|mplayer -zoom -slave -idle -fstype fullscreen -wid [winfo id $container]" r+] #puts "fid=$fid" } else { set f [$self getFormat $filename] set url [exec youtube-dl -g -f $f --cookies /tmp/cookie.txt $filename] # need to remove -quit set fid [open "|mplayer -zoom -slave -idle -fstype fullscreen -wid [winfo id $container] -fs -cookies -cookies-file /tmp/cookie.txt $url" r+] } } else { set fid [open "|mplayer -zoom -slave -ss 0:00 -quiet -idle -fstype fullscreen -wid [winfo id $container] $filename" r+] } fconfigure $fid -blocking 0 -buffering line fileevent $fid readable [mymethod ReadPipe $fid] set mplayer $fid } method fileOpen {} { set types { {{Video Files} {.avi .mp4} } {{Audio Files} {.mp3 .ogg} } {{All Files} * } } set filename [tk_getOpenFile -filetypes $types] if {$filename != ""} { $self mplayerCmd stop after 500 # Open the file ... $self mplayerCmd "loadfile $filename" } } method mplayerCmd {{arg pause}} { puts $mplayer $arg flush $mplayer } method gotoPosition {} { set pos [split $position ":"] set seconds [expr {[lindex $pos 0]*60+[lindex $pos 1]}] $self mplayerCmd "seek $seconds 2" } method exit {} { $self mplayerCmd "stop" #rename $win "" } } if {$argv0 eq [info script]} { #SnitMPlayer .top -infile /run/media/dgroth/0123-4567/Videos/Bariuke/Cortez_Killer_Young_Bariuke_D.mp4 #exit if {[llength $argv] <= 1 } { SnitMPlayer .smp pack .smp -fill both -expand yes .smp addToolbar if {[llength $argv] == 1} { .smp openVideo [lindex $argv 0] } else { # default with no arguments .smp openVideo https://www.youtube.com/watch?v=ATUyKlQpC4k } } else { set nb [ttk::notebook .nb] set x 0 foreach video $argv { puts $argv SnitMPlayer $nb.smp[incr x] $nb add $nb.smp$x -text "# $x" $nb.smp$x addToolbar $nb.smp$x openVideo [lindex $argv [expr {$x - 1}]] if {$x > 1} { after 200 $nb.smp$x mplayerCmd pause } } pack $nb -fill both -expand yes } }
Command line check:
$ tclsh SnitMPlayer.tcl https://www.youtube.com/watch?v=zE_3ZYi6iTU
Please discuss here ...