Direct_Url /	do/

foreach hx {0 1 2 3 4} {foreach hy {0 1 2 3 4} {lappend AllHectares ${hx}_${hy}}}

set LastSecs 0
set Millis 0 ;# not actual milliseconds, but incrementing
set GridPW primhog

proc hect h {
  set ::Hectare $h
  uplevel 1 [list upvar #0 History.$h History Obj.$h Obj Ts.$h Ts]
}

proc hect_args {arglist} {
  array set a $arglist
  set h [expr { [info exists a(h)] ? $a(h) : "0_0" }]
puts "HECT_ARGS <<< $h"
  regexp {[0-9]+[_][0-9]+$} $h h ;# keep tail hectare name 
puts "HECT_ARGS >>> $h"
  uplevel 1 hect $h
}

foreach h $AllHectares {
  hect $h
  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%06d" [clock seconds] $Millis
}

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

proc do/slmatter {args} { hect_args $args
	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} { hect_args $args
	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} {
	upvar 1 Obj Obj Ts Ts History 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} {
	upvar 1 Obj Obj Ts Ts History History

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


proc Replace {id key value mc} {
	upvar #0 Obj.$::Hectare Obj Ts.$::Hectare Ts History.$::Hectare 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} { hect_args $args
	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} { hect_args $args
	puts stderr "@@@@@ SYNC: $args"
	array set a $args
	Sync $a(after) $a(max) $a(sync) $a(mc)
}

proc Sync {after max sync mc} {
	upvar 1 Obj Obj Ts Ts History 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} {
	upvar 1 Obj Obj Ts Ts History History
	Replace $id $k $v 000
}
proc init50 {id key val} {
	upvar 1 Obj Obj Ts Ts History History
  # for future, we want 50,50 at center
  # but now it is 0,0
  # so subtract off 50,50 from x,y
  if [regexp {(.*);(.*);(.*);(.*);(.*);(.*)} $val - x y z i j k] {
    puts stderr "SPLIT $val => $x $y $z $i $j $k"
  } else {
    error "did not split $v"
  }
  set x [expr {$x-50}]
  set y [expr {$y-50}]
  init $id $key "$x;$y;$z;$i;$j;$k"
}
  
proc color_unless_0 {color i} {
  expr { $i==0 ? "0.1;0.1;0.1" : $color }
}

set id 11111
foreach h $AllHectares {
	hect $h
	regexp {^([0-9]+)_([0-9]+)$} $h - hx hy
puts stderr "@hxhy $h $hx $hy"

	for {set i 0} {$i <= $hx} {incr i} {
		incr id
		init $id k cube
		init $id s "0.3;0.3;0.3;[color_unless_0 "1;0;0" $i]"   ;# size & color
		init50 $id l "51;51;[expr {($i+1)*0.5}];0;0;0"	;# loc & rot
	}
	for {set i 0} {$i <= $hy} {incr i} {
		incr id
		init $id k cube
		init $id s "0.3;0.3;0.3;[color_unless_0 "0;1;0" $i]"   ;# size & color
		init50 $id l "52;52;[expr {($i+1)*0.5}];0;0;0"	;# loc & rot
	}
continue
	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
	  }
	}
}
hect 0_0

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"

set SLOWNESS 10
set DELAY [expr {1000*$SLOWNESS}]
proc circular {h} {
	hect $h
	set f 100.0 ;# time factor
	set t [clock seconds]
	set x [expr {14*cos(1.0*$t/$::SLOWNESS)} ]
	set y [expr {14*sin(1.0*$t/$::SLOWNESS)} ]
	Replace 10000 l "$x;$y;0.6;0;0;0" 00
	after $::DELAY "circular $h"
	#pop_hect
}
#after $::DELAY "circular 0_0"
#after $::DELAY "circular 1_1"

proc source_space {f h} {
  puts stderr "SPACE $h <= FILE $f"
  hect $h
  source $f
}

puts stderr "<<<<<<<<<<<<<<< BEGIN SOURCE SPACES"
foreach f [lsort [
        glob {/opt/croquet/intermetagrid/custom/[0-9]_[0-9].t}]] {

  regexp {[0-9]+_[0-9]+} $f h ;# get just the hectare spec from the filename

  source_space $f $h
}
puts stderr ">>>>>>>>>>>>>>> END SOURCE SPACES"

uplevel #0 {
  foreach arr [lsort [info global Obj*]] {
    puts stderr "--- $arr ---> [lsort [array names $arr]]"
  }
}
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 "========================================== [info global]"