# 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 threads 1.0

# A fake implementation of the Thread package.  At the end of this
# file a test is made to eventually import the real Thread package on
# platforms which were found stable enough.

namespace eval ::thread {
    variable nthreads 0
    variable fakeThread 1
}

proc ::thread::create {args} {
    variable nthreads
    set id $nthreads
    incr nthreads
}

proc ::thread::id {} {
    return 0
}

proc ::thread::exists {id} {
    variable nthreads
    return [expr $id >= 0 && $id < $nthreads]
}

proc ::thread::release {id} {
    return 0
}

proc ::thread::join {id} {
}

proc ::thread::send:init:script {id script} {
    if $::thread::fakeThread return
    ::thread::send $id $script
}

proc ::thread::send {args} {
    set position 0
    set id 0
    set script ""
    set vwaitv ""

    foreach arg $args {
        if {[string index $arg 0] == "-"} continue

        switch $position {
            0 {
                set id $arg
            }
            1 {
                set script $arg
            }
            2 {
                set vwaitv $arg
            }
            default {
            }
        }

        incr position
    }

    if {$script == ""} return

    if {$vwaitv == ""} {
        #puts $script
        after 0 $script
        return
    }

    set script_ { set %VWAITV% [uplevel #0 { %SCRIPT% }] }
    lappend mapping %VWAITV% $vwaitv
    lappend mapping %SCRIPT% $script
    set script_ [string map $mapping $script_]
    #puts $script
    after 0 $script_
}

if {$::tcl_platform(os) != "Darwin"} {
    # Use real implementation.
    set ::thread::fakeThread 0
    package require Thread
}

