# Copyright:   2018-2024 Paul Obermeier (obermeier@poSoft.de)
#
#              See the file "Mawt_License.txt" for information on 
#              usage and redistribution of this file, and for a
#              DISCLAIMER OF ALL WARRANTIES.
#
# Description: Tcl script implementing a simple movie player to test the
#              video related functions of the Tcl FFMPEG wrapping.

package require Tk
package require tablelist
package require autoscroll
package require poTcllib
package require poTklib
package require mawt

proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

proc poBmp:play {} {
    return {
    #define play_width 16
    #define play_height 16
    static unsigned char play_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x21, 0x80, 0x61, 0x80, 0xe1, 0x80,
       0xe1, 0x81, 0xe1, 0x83, 0xe1, 0x87, 0xe1, 0x83, 0xe1, 0x81, 0xe1, 0x80,
       0x61, 0x80, 0x21, 0x80, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpPlay [image create bitmap -data [poBmp:play]]

proc poBmp:stop {} {
    return {
    #define stop_width 16
    #define stop_height 16
    static unsigned char stop_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87,
       0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87,
       0xe1, 0x87, 0xe1, 0x87, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpStop [image create bitmap -data [poBmp:stop]]

proc poBmp:reverse {} {
    return {
    #define reverse_width 16
    #define reverse_height 16
    static unsigned char reverse_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x39, 0x90, 0x39, 0x98, 0x39, 0x9c,
       0x39, 0x9e, 0x39, 0x9f, 0xb9, 0x9f, 0x39, 0x9f, 0x39, 0x9e, 0x39, 0x9c,
       0x39, 0x98, 0x39, 0x90, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpReverse [image create bitmap -data [poBmp:reverse]]

proc poBmp:forward {} {
    return {
    #define forward_width 16
    #define forward_height 16
    static unsigned char forward_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x09, 0x9c, 0x19, 0x9c, 0x39, 0x9c,
       0x79, 0x9c, 0xf9, 0x9c, 0xf9, 0x9d, 0xf9, 0x9c, 0x79, 0x9c, 0x39, 0x9c,
       0x19, 0x9c, 0x09, 0x9c, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpForward [image create bitmap -data [poBmp:forward]]

proc poBmp:pause {} {
    return {
    #define pause_width 16
    #define pause_height 16
    static char pause_bits[] = {
      0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86,
      0x61, 0x86, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86,
      0x61, 0x86, 0x61, 0x86, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpPause [image create bitmap -data [poBmp:pause]]

proc poBmp:update {} {
    return {
    #define endless_width 16
    #define endless_height 16
    static char endless_bits[] = {
      0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0xf1, 0x81, 0x09, 0x82, 0x05, 0x84,
      0x05, 0x84, 0x05, 0x84, 0x05, 0x9f, 0x05, 0x8e, 0x09, 0x84, 0x71, 0x80,
      0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpUpdate [image create bitmap -data [poBmp:update]]

proc TogglePlayPause {} {
    global gDemo

    if { $gDemo(play) } {
        Pause
    } else {
        Resume
    }
}

proc Resume {} {
    global gDemo

    set gDemo(play) true
    .fr.controls.play configure -image $::bmpPause
    poToolhelp AddBinding .fr.controls.play "Pause (p)"
    UpdateImg
}

proc Pause {} {
    global gDemo

    set gDemo(play) false
    .fr.controls.play configure -image $::bmpPlay
    poToolhelp AddBinding .fr.controls.play "Play (p)"
}

proc Stop {} {
    global gDemo

    set gDemo(play) false
    .fr.controls.play configure -image $::bmpPlay
    set gDemo(curFrame) 1
    UpdateImg true
}

proc Step { { dir 1 } } {
    global gDemo

    incr gDemo(curFrame) $dir
    if { $gDemo(curFrame) < 1 } {
        set gDemo(curFrame) 1
    } elseif { $gDemo(curFrame) > $gDemo(numFrames) } {
        set gDemo(curFrame) $gDemo(numFrames)
    }
    UpdateImg true
}

proc Shuffle { val } {
    global gDemo

    set gDemo(curFrame) [expr int($val)]
    UpdateImg true
}

proc GetMovieInfo { movieFile } {
    set videoObj [mawt Video new $movieFile "r"]
    dict set infoDict width [$videoObj GetWidth]
    dict set infoDict height [$videoObj GetHeight]
    dict set infoDict numFrames [$videoObj GetNumFrames]
    dict set infoDict frameRate [expr int([$videoObj GetFramerate] + 0.5)]
    dict set infoDict duration  [$videoObj GetDurationAsString]
    $videoObj Close
    $videoObj destroy
    return $infoDict
}

proc LoadMovie { movieFile } {
    global gDemo

    # First get information about the movie.
    set movieDict [GetMovieInfo $movieFile]
    set gDemo(width)     [dict get $movieDict width]
    set gDemo(height)    [dict get $movieDict height]
    set gDemo(numFrames) [dict get $movieDict numFrames]
    set gDemo(frameRate) [dict get $movieDict frameRate]

    # Open the movie file and allocate memory for one frame.
    set gDemo(videoObj) [mawt Video new $movieFile "r"]
    mawt SetDebugMode 1

    set numBytes [$gDemo(videoObj) Start]
    if { [info exists gDemo(VideoBuf)] } {
        $gDemo(VideoBuf) destroy
    }
    set gDemo(VideoBuf) [mawt Vector new $numBytes]
 
    set gDemo(curFrame) 1
    .fr.scale.slider configure -from 1 -to $gDemo(numFrames)
}

proc UpdateImg { { setImg false } } {
    global gDemo

    # Grab next frame from video stream.
    $gDemo(videoObj) Lock
    if { $setImg } {
        $gDemo(videoObj) GetImage [$gDemo(VideoBuf) Get] $gDemo(flipImgs) [expr {$gDemo(curFrame)-1}]
    } else {
        $gDemo(videoObj) GetNextImage [$gDemo(VideoBuf) Get] $gDemo(flipImgs)
    }
    $gDemo(videoObj) Unlock
   
    $gDemo(VideoBuf) ToPhoto VideoFrame $gDemo(width) $gDemo(height)
    update
   
    if { $gDemo(play) } {
        incr gDemo(curFrame)
        if { $gDemo(curFrame) <= $gDemo(numFrames) } {
            after idle [list UpdateImg]
        }
    }
}

proc SelectMovie { tableId } {
    global gDemo

    set rowIndList [$tableId curselection]
    set rowCont [$tableId get [lindex $rowIndList 0]]
    set movieFile [lindex $rowCont 0]
    LoadMovie [file join $gDemo(curDir) $movieFile]
    Stop
}

proc InsertMovieInfo { movieFile } {
    global gDemo

    set name [file tail $movieFile]
    set info [GetMovieInfo $movieFile]
    set row [list $name \
             [dict get $info width] \
             [dict get $info height] \
             [dict get $info duration] \
             [dict get $info numFrames] \
             [dict get $info frameRate] \
            ]
    $gDemo(table) insert end $row
    set gDemo(curDir) [file dirname $movieFile]
}

proc BrowseDir { dir } {
    global gDemo

    $gDemo(table) delete end
    set movieList [glob -nocomplain -directory $dir -- {*}$gDemo(movieExt)]
    foreach movie $movieList {
        InsertMovieInfo $movie
    }
}

proc Cleanup {} {
    global gDemo

    $gDemo(VideoBuf) delete
    uplevel #0 unset gDemo
}

proc ExitProg {} {
    global gDemo

    if { [info exists gDemo(videoObj)] } {
        $gDemo(videoObj) Close
        $gDemo(videoObj) destroy
    }
    exit
}

set gDemo(curFrame)  0
set gDemo(numFrames) 0

ttk::frame .fr
pack .fr -expand 1 -fill both
ttk::frame .fr.filelist
ttk::frame .fr.display
ttk::frame .fr.scale
ttk::frame .fr.controls
grid  .fr.filelist -row 0 -column 0 -sticky news
grid  .fr.display  -row 1 -column 0 -sticky news
grid  .fr.scale    -row 2 -column 0 -sticky news
grid  .fr.controls -row 3 -column 0 -sticky news
grid rowconfigure    .fr 1 -weight 1
grid columnconfigure .fr 0 -weight 1

set gDemo(table) [poWin CreateScrolledTablelist .fr.filelist true "Movie list" \
                  -stripebackground #e0e8f0 \
                  -exportselection false \
                  -labelcommand tablelist::sortByColumn \
                  -width 60 \
                  -showseparators yes -showlabels true -stretch all]

bind $gDemo(table) <<TablelistSelect>> "SelectMovie $gDemo(table)"
$gDemo(table) configure -columns {0 "Filename"   "left" 
                                  0 "Width"      "left"
                                  0 "Height"     "left"
                                  0 "Duration"   "left"
                                  0 "Frames"     "left"
                                  0 "Frame Rate" "left"}
$gDemo(table) columnconfigure 0 -sortmode ascii
$gDemo(table) columnconfigure 1 -sortmode integer
$gDemo(table) columnconfigure 2 -sortmode integer
$gDemo(table) columnconfigure 3 -sortmode ascii
$gDemo(table) columnconfigure 4 -sortmode integer
$gDemo(table) columnconfigure 5 -sortmode integer

set gDemo(label) .fr.display.l
ttk::label $gDemo(label)
pack $gDemo(label) -fill both -expand 1
image create photo VideoFrame
$gDemo(label) configure -image VideoFrame

ttk::scale .fr.scale.slider -orient horizontal \
           -variable gDemo(curFrame) -command Shuffle
pack .fr.scale.slider -expand 1 -fill x

ttk::button .fr.controls.play -image $bmpPlay   -command TogglePlayPause
ttk::button .fr.controls.stop -image $bmpStop   -command Stop
ttk::button .fr.controls.fwd  -image $bmpForward -command { Step 1 }
ttk::button .fr.controls.rev  -image $bmpReverse -command { Step -1 }
ttk::label  .fr.controls.cur -textvariable gDemo(curFrame)
ttk::label  .fr.controls.of  -text "of"
ttk::label  .fr.controls.num -textvariable gDemo(numFrames)
pack .fr.controls.play .fr.controls.stop .fr.controls.fwd .fr.controls.rev -side left
pack .fr.controls.num .fr.controls.of .fr.controls.cur -side right

poToolhelp AddBinding .fr.controls.play "Play (p)"
poToolhelp AddBinding .fr.controls.stop "Stop (s)"
poToolhelp AddBinding .fr.controls.fwd  "Step forwards (->)"
poToolhelp AddBinding .fr.controls.rev  "Step backwards (<-)"

bind . <p>     "TogglePlayPause"
bind . <s>     "Stop"
bind . <Left>  "Step -1"
bind . <Right> "Step 1"

bind . <Escape>  ExitProg
wm protocol . WM_DELETE_WINDOW "ExitProg"
wm title . "MAWT demo: A simple movie player"

set gDemo(flipImgs) 0
set gDemo(movieExt) "*.ts *.m2ts *.avi *.mp4 *.mpeg *.mov *.mpg *.flv *.VOB"

set curArg 0
if { $argc > 0 } {
    set fileOrDirName [lindex $argv $curArg]
    if { [file isdirectory $fileOrDirName] } {
        BrowseDir $fileOrDirName
    } elseif { [file isfile $fileOrDirName] } {
        LoadMovie $fileOrDirName
        Stop
        $gDemo(table) delete end
        InsertMovieInfo $fileOrDirName
    } else {
        puts "Usage: $argv0 MoveFile or Directory"
        exit 0
    }
} else {
    BrowseDir [pwd]
}

focus .
