Direct_Url /	do/

set LastSecs 0
set Millis 0 ;# not actual milliseconds, but incrementing
set GridPW primhog
set History 0
set Obj(0,0) {0 0}
set Ts(0) 0,0

proc timestamp {} {
	global LastSecs Millis
	set now [clock seconds]
	if { $now eq $LastSecs } { incr Millis } else { set Millis 0 }
	set LastSecs $now
	format "T%011d%03d" [clock seconds] $Millis
}

proc bgerror {s} {
	puts stderr "#### BGERROR: $s"
	puts stderr "####"
}

proc do/slmatter {args} {
	global Obj Ts GridPW History
	array set a $args
	puts stderr "@@@@@ SLMATTER: $args"

	if {[regexp {^([^;]*)[;]} $a(raw) - cmd]} {
		# the objid still has the mc added to it, so subtract mc now
	puts stderr "----- SLMATTER: cmd: $cmd"

		if { $cmd == "spoke" } {
	puts stderr "----- SLMATTER: spoke:"
			if {[regexp {^([^;]*)[;]([^;]*)[;]([^;]*)[;]([^;]*)[;]([^;]*)} $a(raw) - cmd objid who key what]} {
	puts stderr "----- SLMATTER: chatting: $who :: $what"
				Chat "$who"  $what $a(mc)
			}
		} elseif { $cmd == "moved" } {

			if {[regexp {^([^;]*)[;]([^;]*)[;]([^;]*)[;]([^;]*)[;]([^;]*)} $a(raw) - cmd objid gap to from]} {
	puts stderr "----- SLMATTER: moving: id $objid to $to"
				set objid [expr {$objid - $a(mc)}]
				
				regsub -all {[<>,]} $to " " to
				set x [lindex $to 0]
				set y [lindex $to 1]
				set z [lindex $to 2]
	puts stderr "----- SLMATTER: moving: id $objid to $to x $x y $y z $z"
				Replace $objid l "$x,$y,$z,0,0,0" $a(mc)
			}
		}
	}
	return
}

set PuppetSerial 10  ;# danger, dont start at 1, cauz C+1 is the die signal
proc register-puppet {name mc} {
	global Puppet PuppetSerial
	if { ! [info exists Puppet($name)]} {
		set Puppet($name) $PuppetSerial
		incr PuppetSerial
	}
	expr { $mc + $Puppet($name) }
}

proc av-tick {num name mc} {
	global Av
	if {[info exists Av($num)]} {
		set now [clock seconds]
		set then $Av($num)
		if { $now - $then > 30 } {
			Replace $num _del_puppet "$name" $mc
			unset Av($num)
		}
	}
}


proc do/slsensor {args} {
	global Obj Ts GridPW History Av
	array set a $args
	puts stderr "@@@@@ SLSENSOR: $args"

  if {[catch {

	# get an id number for the puppet
	regsub {[^A-Za-z0-9]} $a(name) _ name
	set name "${name}_$a(mc)"
	set num [register-puppet $name $a(mc)]

	Replace $num _puppet "$name;$a(pos);$a(rot)" $a(mc)

	set Av($num) [clock seconds]  ;# update the Av time
	after 60000 [list av-tick $num $name $a(mc)]

  } what]} {
	puts stderr "ERROR IN do/slsensor: $::errorInfo"
	error Rethrow--$what
  }
  return
}

#urlencode
proc urlencode {text} {
    set url ""
    foreach byte [split [encoding convertto utf-8 $text] ""] {
        scan $byte %c i
        if {[string match {[%<>""]} $byte] || $i <= 32 || $i > 127} {
            append url [format %%%02X $i]
        } else {
            append url $byte
        }
    }
    return $url
}


proc Chat {who what mc} {
	global Obj Ts GridPW History

	#set who [urlencode $who]
	#set what [urlencode $what]
	set value [urlencode "$who >> $what"]

	set t [timestamp]
	set id $who
	set key _chat
	set Obj($id,$key) [list $t $value $mc]
	set Ts($t) $id,$key
	lappend History $t
	puts stderr "Chat $t --> $id $key $value $mc"

	# they should be consumed quickly, so waiting just 30 secs is reasonable
	after 30000 [list DropChat $t $id,$key]
}
proc DropChat {t x} {
	global Obj Ts GridPW History

	unset Ts($t)
	unset Obj($x)
	set History [lsort [array names Ts]]
}


proc Replace {id key value mc} {
	global Obj Ts GridPW History
	if {[info exists Obj($id,$key)]} {
		set oldt [lindex $Obj($id,$key) 0]
		puts stderr "Delete $oldt --> $id $key OLD $Obj($id,$key) OLD"
		unset Ts($oldt)
		unset Obj($id,$key)

		# remove entry from History
		set i [lsearch History $oldt]  ;# search for it
		if {$i>0} { ;# if found, replace it with nothing
			set History [lreplace $History $i $i]
		}
	}

	set t [timestamp]
	set Obj($id,$key) [list $t $value $mc]
	set Ts($t) $id,$key
	lappend History $t
	puts stderr "Replace $t --> $id $key $value $mc"
}

proc do/put {args} {
	global Obj Ts GridPW History
	puts stderr "@@@@@ PUT: $args"
	#puts <$args>
	#foreach {x y} $args { puts "<$x#$y>" }
	array set a $args
	set mc 0
	catch { set mc $a(mc) }

	Replace $a(id) $a(key) $a(value) $mc
	return
}

proc do/sync {args} {
	puts stderr "@@@@@ SYNC: $args"
	global Obj Ts GridPW History
	array set a $args
	Sync $a(after) $a(max) $a(sync) $a(mc)
}

proc Sync {after max sync mc} {
	global Obj Ts GridPW History

	# stupid slow algo
	set n [llength $History]
	set i 0
	set z {}
	foreach x $History {
		if { $x <= $after } continue

		set ts $x
		if { ! [info exists Ts($ts)] } {
			puts stderr "SKIPPING MISSING TS: $ts"
			#puts stderr "    H:$History"
			#puts stderr "    T:[lsort [array names Ts]]"
			continue
		}
		set pair [split $Ts($ts) ","]
		set id [lindex $pair 0]
		set key [lindex $pair 1]
		set value [lindex $Obj($id,$key) 1]
		set sender [lindex $Obj($id,$key) 2]

		puts stderr "...... sender <$sender> mc <$mc> ............"
		if { $sender == $mc } {
			# dont send updates back to sender
			puts stderr "OMIT TO SENDER: $mc: $ts -> $id $key $value OMIT"
			continue
		}
		

		append z "$ts $id $key $value\n"
		incr i
		#if ($i==$max) break
		if { [string length $z] > 900 } break;
	}
	puts stderr "===== Sync Returns: ``$z''"
	return $z
}

proc init {id k v} {
	Replace $id $k $v 000
}


set id 11111
foreach x {-12 -10 -8} {
  foreach y {-12 -10 -8} {
    	incr id
	init $id k cube
	init $id s "0.3;0.3;4.0;1;0;0"   ;# size & color
	init $id l "$x;$y;2;0;0;0"	;# loc & rot
  }
}
foreach x {-11 11} g {0.3 1.0} {
  foreach y {-11 11} b {0.3 1.0} {
	incr id
	init $id k cube
	init $id s "5.0;5.0;0.02;0;$g;$b"   ;# size & color
	init $id l "$x;$y;0;0;0;0"	;# loc & rot
  }
}
foreach x { 14  12  10  8  6} {
  foreach y { 14  12  10  8  6} {
	incr id
	init $id k cube
	init $id s "0.8;0.8;0.4;1;0;1"   ;# size & color
	init $id l "$x;$y;0;0;0;0"	;# loc & rot
  }
}

init 10000 k cube
init 10000 s "1;1;1;0.3;0.3;0.3"
init 10000 l "3;3;1;0;0;0"

proc circular "" {
	#set f 10.0 ;# time factor
	set f 10.0 ;# time factor
	set t [clock seconds]
	set x [expr {14*cos($t/$f)} ]
	set y [expr {14*sin($t/$f)} ]
	Replace 10000 l "$x;$y;0.6;0;0;0" 00
	after 1000 "circular"
}
after 1000 circular

puts stderr "<<<<<<<<<<<<<<< BEGIN TEST"
foreach x $History {
  puts "$x -> [join [split [do/sync after $x max 3 sync 1 mc 0] \n] | ]"
}
puts stderr ">>>>>>>>>>>>>>> END TEST"
puts stderr "=========================================="
puts stderr "=========================================="
puts stderr "=========================================="
puts stderr "=========================================="
puts stderr "=========================================="