
# Luciole session end code
proc END_OF_PIPE { } {
	return 42
}

global Pipes
set Pipes(dbg) 0
proc DBG args {
	global Pipes
	if { $Pipes(dbg) } { 
		eval $args
	}
}

proc _add_in { pname tclvar typ } {
	global Pipes
	#TODO verif size and type
	#puts "lappend Pipes($pname,invars) $tclvar $typ"
	lappend Pipes($pname,invars) $tclvar
}
proc _add_out { pname tclvar typ } {
	global Pipes
	#TODO verif size and type
	#puts "lappend Pipes($pname,outvars) $tclvar"
	lappend Pipes($pname,outvars) $tclvar
}

proc getline { pname } {
	global Pipes
	set r2h_read $Pipes($pname,r2h_read)
	set zepid $Pipes($pname,pid) 
#set running [file exists /proc/$zepid/exe]
#puts "running = $running"
	if { [catch {exec ps -p $zepid -o state=} zestate ] } {
    	puts stderr "Pipe Process Ended Unexpectedly, see _pipe.err for details"
    	#error "Pipe Process Ended Unexpectedly"
    	exit 1
	}
DBG puts "pipe::getline, zestate=$zestate"
   gets $r2h_read line
	return $line
}

# only basic step available !
proc _do_step { pname } {
	global Pipes
	set h2r_write $Pipes($pname,h2r_write)
DBG puts "_do_step: inputs $Pipes($pname,invars)"
DBG puts "_do_step: outputs $Pipes($pname,outvars)"
	foreach inme $Pipes($pname,invars) {
		upvar 1 $inme ivar
		set value $ivar 
DBG puts "_do_step: write input $inme (value $value)"
DBG puts "here"
		puts $h2r_write $value
DBG puts "there"
		flush $h2r_write
DBG puts "end"
	}
	set r2h_read $Pipes($pname,r2h_read)	
   fconfigure $r2h_read  -blocking 1
	# Capture comments/pragmas
	set line ""
	while { "$line" == "" } {
DBG puts "getline 3"
   	set line [getline $pname]
		if {[string index $line 0] eq "#"} {
			# comment or pragma
			if [string match "#reset*" $line] {
DBG puts "DO RESET"
			} elseif [string match "#quit*" $line] {
				#TODO close pipes ?
				exit 0
			}
DBG puts "IGNORE"
			set line ""
		} else {
DBG puts "OK, goon"
		}
	}
	# Outputs must be in $line
	set nb_outs $Pipes($pname,nb_outs)
	set ocpt 0
	set goon [expr $ocpt < $nb_outs]
	while { $goon } {
		foreach value $line {
			set onme [lindex $Pipes($pname,outvars) $ocpt]
			upvar 1 $onme ovar
DBG puts "read output $ovar (value $value)"
			set ovar $value
			incr ocpt
		}
		set goon [expr $ocpt < $nb_outs]
	}
}
proc _do_reset { pname } {
	global Pipes
	set h2r_write $Pipes($pname,h2r_write)
	puts $h2r_write "#reset"
	flush $h2r_write
}

proc _do_pipe_cmd { pname cmd  args } {
	global Pipes
	global Pipes $pname
	switch -glob $cmd {
		"name" { return $Pipes($pname,name) }
		"nb_ins" { return $Pipes($pname,nb_ins) }
		"nb_outs" { return $Pipes($pname,nb_outs) }
		"in_name" { return [lindex $Pipes($pname,in_names) $args] }
		"out_name" { return [lindex $Pipes($pname,out_names) $args] }
		"in_type" { return [lindex $Pipes($pname,in_types) $args] }
		"out_type" { return [lindex $Pipes($pname,out_types) $args] }
		"add_in" { _add_in $pname [lindex {*}$args 0] [lindex {*}$args 1] }
		"add_out" { _add_out $pname [lindex {*}$args 0] [lindex {*}$args 1] }
		"step" { _do_step $pname }
		"reset" { _do_reset $pname }
	}
}

# while here, all code is pure tcl:
# - creates a 'command' whose name is the 'reactive program' (pname)
#   this commands serves to get the informations (in, outs etc.)
# - the global infos are created and stored in a global array
#   with a double key: Pipes($pname,key) 
#
proc names_and_types {vl} {
	set vl [regexp -all -inline {\S+} $vl]
	set vl [lmap x $vl {split $x ":"}]
	set nl [lmap x $vl {string trim [lindex $x 0] " \""} ]
	set tl [lmap x $vl {lindex $x 1}]
	list $nl $tl
}

proc pipecreate { pname cmd } {
	# $pname is the name of the 'command' to retrieve information
	# = title where non alphas are set to _ 
	#catch {regsub -all {[^a-zA-Z0-9]+} $title "_" pname}
	# Pipes is the global array where are stored all the infos
	global Pipes
	set Pipes(dbg) 0
	# Init info with just the name
	#set Pipes($pname,tclcmd) $pname 
	set Pipes($pname,name) $pname
	set Pipes($pname,in_names) {}
	set Pipes($pname,in_types) {}
	set Pipes($pname,nb_ins) 0 
	set Pipes($pname,out_names) {} 
	set Pipes($pname,out_types) {}
	set Pipes($pname,nb_outs) 0
	# creates the associated pipes
   lassign [chan pipe] r2h_read r2h_write
   lassign [chan pipe] h2r_read h2r_write
	set Pipes($pname,r2h_read) $r2h_read
	set Pipes($pname,r2h_write) $r2h_write
	set Pipes($pname,h2r_read) $h2r_read
	set Pipes($pname,h2r_write) $h2r_write
	# launch external reactive program

DBG puts "pipecreate"
	if { [catch {exec {*}$cmd <@ $h2r_read >@ $r2h_write 2> _pipe.err &} zepid] } {
    	puts stderr "Command '$cmd' failed"
    	exit 1
	}
	set Pipes($pname,pid) $zepid
DBG puts "zepid=$zepid"

	# first read in blocking mode, to wait for exec 
	# TODO bad idea -> replace with non-blocking + deadline
   fconfigure $r2h_read  -blocking 0
DBG puts "getline 1"
	for {set cpt 0} {$cpt<50} {incr cpt} {
		after 100
   	set line [getline $pname]
DBG puts "try $cpt, line=$line"
		if { "$line" != "" } {
			break
		}
	}
	# then read all lines until blocked 
   fconfigure $r2h_read  -blocking 0 
   while {[fblocked $r2h_read] == 0} {
      #puts stderr $line ; flush stderr
		switch -regexp -matchvar ml -- $line {
			"#inputs (.*)" {
				set ins [lindex $ml 1] 
				#puts stderr "inputs=$ins"
				lassign [names_and_types $ins] in_names in_types
				#puts stderr "in_names=$in_names"
				#puts stderr "in_types=$in_types"
				set Pipes($pname,in_names) $in_names
				set Pipes($pname,in_types) $in_types
				set Pipes($pname,nb_ins) [llength $in_names]
			}
			"#outputs (.*)" {
				set outs [lindex $ml 1] 
				#puts stderr "outputs=$outs"
				lassign [names_and_types $outs] out_names out_types
				#puts stderr "out_names=$out_names"
				#puts stderr "out_types=$out_types"
				set Pipes($pname,out_names) $out_names
				set Pipes($pname,out_types) $out_types
				set Pipes($pname,nb_outs) [llength $out_names]
			}
			"#name (.*)" {
				set nm [lindex $ml 1]
				set nm [string trim $nm " \""]
				set Pipes($pname,name) $nm
			}
			default {
				#puts "skip"
			}
		}
DBG puts "getline 2"
   	set line [getline $pname]
DBG puts "line=$line"
   }
	# lists of tcl vars for reading/writing in/out
	# created at luc level with add_in add_out 
	set Pipes($pname,invars) ""	
	set Pipes($pname,outvars) ""	
	# $pname becomes a global command for retriving infos
	global $pname
	proc $pname { cmd  args } {
		global Pipes
		# get the proc name = pname 
		set pname [lindex [info level 0] 0] 
		#puts "call _do_pipe_cmd $pname $cmd $args"
		return [_do_pipe_cmd $pname $cmd $args]
	}
}
