# 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 task 1.0
# Tcl 8.5 for 'info frame' and 'dict'.
package require Tcl 8.5

namespace eval ::task {
    variable tasks
    variable counter 0
    variable task.code.template
}

proc ::task::new {script} {
    variable counter
    incr counter

    set task task#$counter
    lappend mapping %NAME% $task

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

    set namespace [uplevel {namespace current}]
    ${task} init $namespace $script

    variable tasks
    set tasks($task) $script
    return $task
}

proc ::task::delete {task} {
    namespace delete ::$task
    variable tasks
    unset tasks($task)
}

set ::task::task.code.template {

    proc ::%NAME% {cmd args} {
        set targets [info procs ::%NAME%::$cmd]
        if {[llength $targets] == 0} {
            error "no procedure: ::%NAME%::$cmd"
        }
        foreach target $targets {
            return [eval $target $args]
        }
    }

    namespace eval ::%NAME% {
        variable namespace
        variable script
        variable runFrame 0
        variable reportCommand ""
        variable lines 0
        variable line 0
        variable percent 0
    }

    proc ::%NAME%::init {_namespace _script} {
        variable namespace $_namespace
        variable script $_script
        variable lines
        set lines [llength [split $script "\n"]]

        trace add execution ::%NAME%::run \
            enterstep ::%NAME%::enterstep
    }

    proc ::%NAME%::run {{_reportCommand list}} {
        variable runFrame
        set runFrame [info frame]

        variable reportCommand
        set reportCommand $_reportCommand
        variable percent 0
        report start

        set error [catch {
            variable namespace
            variable script
            namespace eval $namespace $script
        } result dict]

        if {$error == 1} {
            puts [dict get $dict -errorinfo]
            report error $result
        } else {
            variable percent 1
            report end $result
        }

        delete
    }

    proc ::%NAME%::report {status {message ""}} {
        variable reportCommand
        variable percent
        $reportCommand %NAME% $percent $status $message
    }

    proc ::%NAME%::delete {} {
        trace remove execution ::%NAME%::run \
            enterstep ::%NAME%::enterstep
        ::task::delete %NAME%
    }

    proc ::%NAME%::enterstep {step op} {
        variable runFrame
        set dict [info frame $runFrame]
        # Maybe not in the run procedure.
        if {[dict get $dict proc] != "::%NAME%::run"} return

        set frame [info frame]
        # Maybe in a different stack frame than the script.
        if {$frame != $runFrame + 4} return

        set dict [info frame -3]
        # Maybe not in 'namespace eval'.
        if {[dict get $dict type] != "proc"} return

        set dict [info frame -2]
        # Maybe not in script 'eval'.
        if {[dict get $dict type] != "eval"} return

        variable line
        set _line [dict get $dict line]
        if {$_line > $line} {
            report:comments $line $_line
            set line $_line
            variable lines
            variable percent [expr $_line / double($lines)]
        }

        report step [dict get $dict cmd]
    }

    proc ::%NAME%::report:comments {line0 line1} {
        variable script
        set split [split $script "\n"]
        for {set i $line0} {$i < $line1} {incr i} {
            set line [string trim [lindex $split $i]]
            if {[string index $line 0] != "#"} continue
            report comment $line
        }
    }

}

