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

namespace eval ::map {
    variable code.template
}

set ::map::code:template {
    variable %VAR%

    proc %VAR%:get {key} {
        variable %VAR%
        set result {}
        foreach {idx elt} [array get %VAR% $key] {
            return $elt
        }
        return ""
    }

    proc %VAR%:get:pairs {} {
        variable %VAR%
        return [array get %VAR%]
    }

    proc %VAR%:set {key value} {
        variable %VAR%
        array set %VAR% [list $key $value]
        #puts "%VAR%($key) <- $value"
    }

    proc %VAR%:set:foreach:key {keys value} {
        foreach key $keys {
            %VAR%:set $key $value
        }
    }

    proc %VAR%:unset {args} {
        variable %VAR%
        foreach key $args {
            foreach {idx elt} [array get %VAR% $key] {
                unset %VAR%($idx)
            }
        }
    }

    proc %VAR%:keys {} {
        variable %VAR%
        array names %VAR%
    }

    proc %VAR%:clear {} {
        variable %VAR%
        array unset %VAR%
    }
}

# Creates an array variable of the given name $var as well as
# procedures ${var}:get, ${var}:set and ${var}:unset in the calling
# namespace.
proc ::map::array:variable {var} {
    set ns [uplevel {namespace current}]
    lappend mapping %VAR% ${ns}::$var
    variable code:template
    eval [string map $mapping ${code:template}]
}

