# Code by Zarutian here is hereby free to everyone to use if they satisfy the following conditions:
#   1. Dont blame me if this doesn't work for any purpose you intented.
#   2. Attribute your use of this code.
#   3. Any and all modifications of this code must be shared under these conditions.
#   4. Any patent infrightment (anywhere and anywhen) is the sole responsibility of the patent holder.
#      I am sorry if your patent was too obvious or too broad to be infrighted upon but it is no concern of mine.

package require Tcl 8.5
package provide thingy 1.2

proc thingy name {
        if {[namespace exists ::things::[set name]]} {
                namespace eval ::things::[set name] destroy
                if {[namespace exists ::things::[set name]]} error
        }
        namespace eval ::things::[set name] {
                proc dispatch args {
                        return [uplevel 1 $args]
                }
                proc destroy {} {
                        namespace delete [namespace current]
                }
        }
        proc $name args [string map [list @name@ [list $name]] {
                namespace eval ::things::@name@ dispatch $args
        }]
        $name variable this $name
        $name variable creator thingy
        return $name
}
proc get varname {
        return [uplevel 1 [list set $varname]]
}

set temp {
        if {[uplevel 1 [list namespace current]] ne {::}} {
                if {[lsearch -exact [uplevel 1 [list info procs]] unknown] != -1 } {
                        return [namespace eval [uplevel 1 [list namespace current]] unknown $args]
                }
        }
}
proc unknown args "[set temp]\n[info body unknown]"
unset temp

namespace eval :: { namespace unknown unknown }

thingy name
name set counter 0
name proc next {} {
        variable counter
        return thing[incr counter]
}

thingy null
null proc dispatch args {
        set caller [uplevel 1 [list set this]]
        error "$caller tried to invoke: $args on null"
}

proc makeSerializable item {
        $item proc serialize_variables {} {
                set this_ns [namespace current]
                set vars [info vars [set this_ns]::*]
                set result "# [llength $vars] variables\n"
                foreach var $vars {
                        set varname [string range $var [string length [set this_ns]::] end]
                        if {[array exists $var]} {
                                append result "array put [list $varname] [list [array get $var]]"
                                append result \n
                        } else {
                                append result "set [list $varname] [list [set $var]]"
                                append result \n
                        }
                }
                return $result
        }
        $item proc serialize_procedures {} {
                set this_ns [namespace current]
                set procs [info procs [set this_ns]::*]
                set result "# [llength $procs] procedures\n"
                foreach proc $procs {
                        set procname [string range $proc [string length [set this_ns]::] end]
                        append result "proc [list $procname] [list [info args $proc]] [list [info body $proc]]\n"
                }
                return $result
        }
        $item proc serialize {} {
                # NOTICE: this method/procedure doesn't serialize children namespaces
                # I recommend that the memento pattern to be used instead of serializing in most cases
                variable this
                set result {}
                append result [$this serialize_variables]
                append result [$this serialize_proocedures]
                return $result
        }
}

proc makeCloneable item {
        makeSerializable $item
        $item proc spawnClone name {
                variable this
                thingy $name
                $name eval [$this serialize]
                $name variable this $name
                $name variable creator [list $this spawnClone]
                # is this, below, duck-typing?
                if {[lsearch -exact [$name info proc] cloned] != -1} { $name cloned $this }
                return $name
        }
}

proc makeThingsRemotable {} {
        # Pass-By-Copy
        # Pass-By-Reference
        # Pass-By-Replica

        # A hard but possible strategy if the object system was initialized before and used.
        # 1. store names of all object instanced into a list
        # 2. iterate that list
        # 2.1 for each item make a new name unique to host ("[hostname]_[set oldname]")
        # 2.2 find and replace the old name for the new name everywhere

        # an easier way would be just replace current instance bound to handle [name] with
        # the one below before any objects are instanced
        catch { name destroy }
        thingy name
        name variable counter 0
        name variable unique "[clock seconds]-[hostname]"
        name proc next {} {
                variable counter
                variable unique
                return "[set unique]-[incr counter]"
        }

        set temp {

        }
        proc unknown args "[set temp]\n[info body unknown]"
        unset temp
}
proc urlEncode input {
        set result {}
        foreach char [split $input {}] {
                if {[regexp -- {[a-zA-Z0-9]} $char]} {
                        append result $char
                } else {
                        if {$char eq { }} {
                                append result +
                        } else {
                                scan $char %c value
                                if {$value < 256} {
                                        append result [format %%%02x $value]
                                } else {
                                        # var ekki einhverstaðar RFC sem skilgreindi Internationalized Resource Identifiers/Locators?
                                        append result [urlEncode [format "\\u%04x" $value]]
                                }
                        }
                }
        }
        return $result
}
proc makeLocalReplicaOfRemoteV1 {name uri} {
        thingy $name
        $name variable uri $uri
        $name proc dispatch args {
                variable uri
                package require http 2.5.0
                set token [http::geturl $uri -query "[urlEncode $args]"]
                set data  [http::data $token]
                http::cleanup $token
                if {[lindex $args 0] == "destroy"} { destroy }
        }
        return $name
}