# ibisa - Image-Based Identification/Search for Archaeology
# Copyright (C) 2008, 2009 Anthony Beurive'

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

package provide iworker 1.0
package require threads 1.0

namespace eval ::iworker {
}

proc ::iworker::init {} {
    variable tclDir
    set dict [info frame 0]
    set file [dict get $dict file]
    set tclDir [file dirname $file]
}

::iworker::init

proc ::iworker::new {} {
    variable counter
    incr counter

    set iworker iworker#$counter
    lappend mapping %NAME% $iworker
    lappend mapping %TCLDIR% ${::iworker::tclDir}

    variable iworker.code.template
    eval [string map $mapping ${iworker.code.template}]
    ${iworker} init

    variable iworkers
    set iworkers($iworker) 1
    return $iworker
}

proc ::iworker::delete {iworker} {
    namespace delete ::$iworker
    variable iworkers
    unset iworkers($iworker)
}

proc ::iworker::names {} {
    variable iworkers
    return [array names iworkers]
}


set ::iworker::iworker.code.template {

    # Global procedure.
    proc ::%NAME% {cmd args} {
        # First, look in this worker namespace.
        set targets [info procs ::%NAME%::$cmd]
        if {[llength $targets] > 0} {
            set target [lindex $targets 0]
            return [eval $target $args]
        }

        # Second, look in the iworker namespace.
        set targets [info procs ::iworker::$cmd]
        if {[llength $targets] > 0} {
            # Run the command in the interpreter of the child thread.
            # It should know about it since it uses an iworker
            # namespace with the same procedures.
            set target [lindex $targets 0]
            return [eval ::%NAME%::run $target $args]
        }

        # Third, ask the interpreter of the child thread about the
        # command, and make it run it if it knows about it.
        if [::%NAME%::run ::iworker::know:command $cmd] {
            return [eval ::%NAME%::run $cmd $args]
        }

        # Really not lucky.  Raise an error.  If you don't want to go
        # through all these steps, directly call the 'run' procedure!
        error "can't find command: $cmd"
    }


    # Namespace.
    namespace eval ::%NAME% {
        variable thread ""
    }

    proc ::%NAME%::init {} {
        #puts "%NAME%: hello!"
        init:thread
    }

    proc ::%NAME%::init:thread {} {
        variable thread.init.script {
            set _tclDir "%TCLDIR%"
            set _libDir [file join [file dirname $_tclDir] lib]
            set auto_path [eval list {$_tclDir} {$_libDir} $auto_path]
            unset _tclDir _libDir

            package require chrono
            package require image
            wm withdraw .

            package require iworker
            set ::iworker::worker %NAME%
            set ::iworker::parent:thread %PARENT%
        }

        lappend mapping %PARENT% [thread::id]
        set script [string map $mapping ${thread.init.script}]

        variable thread [thread::create -joinable]
        thread::send:init:script $thread $script
    }

    proc ::%NAME%::delete {} {
        variable thread
        if {$thread != "" &&
            [thread::exists $thread] &&
            [thread::release $thread] >= 0} {
            thread::join $thread
        }

        #puts "%NAME%: bye!"
        ::iworker::delete %NAME%
    }

    proc ::%NAME%::run {cmd args} {
        variable thread
        if {$thread == ""} { init:thread }

        variable sync
        variable idx
        set key [incr idx]

        append script [eval list $cmd $args]
        thread::send -async -head $thread $script ::%NAME%::sync($key)
        vwait ::%NAME%::sync($key)

        set result $sync($key)
        unset sync($key)
        return $result
    }

    proc ::%NAME%::run:async {cmd args} {
        variable thread
        if {$thread == ""} { init:thread }
        append script [eval list $cmd $args]
        thread::send -async $thread $script
    }

}


# For child interpreters in threads.

namespace eval ::iworker {
    # Parent worker.
    variable worker ""
    # Parent thread, as reported by parent worker.
    variable parent:thread ""
    # A variable to indicate if current operations should stop.
    variable cancel 0
}

proc ::iworker::cancel {{bool 1}} {
    variable cancel $bool
}

proc ::iworker::cancel:requested {} {
    variable cancel
    update idletasks
    return $cancel
}

proc ::iworker::know:command {cmd} {
    #puts "::iworker::know:command $cmd"
    return [expr {[info commands $cmd] != {}}]
}

proc ::iworker::worker:debug {} {
    variable worker
    variable parent:thread
    puts "* worker: $worker"
    puts "* this thread: [thread::id]"
    puts "* parent thread: ${parent:thread}"
}

proc ::iworker::send:back:async {cmd args} {
    variable parent:thread
    if {${parent:thread} == ""} return
    set script [list eval $cmd $args]
    thread::send -async ${parent:thread} $script
}

proc ::iworker::recursive:glob {dir} {
    set files {}

    set globs [list $dir]
    for {set i 0} {$i < [llength $globs]} {incr i} {
        if [cancel:requested] break

        set file [lindex $globs $i]
        if {[array get visited $file] != {}} continue
        set visited($file) 1

        if [file isdirectory $file] {
            eval lappend globs [glob -nocomplain -directory $file *]
        } elseif [file isfile $file] {
            lappend files $file
        }
    }

    return $files
}

