#
# 	UNIX-SPECIFIC CSOUND CONTROL
# 	(c) 1997 Jean Piche & Alexandre Burton
# 	v1.80a (10/08/97)
#
#----------------
# version 2.0.4 updates by Stephen Burgess
#
#----------------
#       Updated by Hans-Christoph Steiner
#       added Darwin/MacOS X port
#       $Id $

proc CsoundLaunch {} {
    global  fileselect errno  son newfile lan module path soundOutInfo pauser
    if ![info exist pauser] {set pauser 0}
    if $pauser {CsoundPause;return} {set pauser 0}
    
    set range [$path(edit).panel.$soundOutInfo(userCHN).t tag ranges mis] 
    catch {$path(edit).panel.$soundOutInfo(userCHN).t delete [lindex $range 0] [lindex $range 1]}
    
    if {$module(path) == ""} {
	setstate idle
	errFile2 "$lan(nom88)"
	return
    }	
    if {[preCompile] == "true"} {
	makeCommand $module(path)  
    } else {
	setstate idle
    }
}


proc CsoundPause {} {
    global stuff lip path pID pauser tcl_platform

    switch $tcl_platform(os) {
	IRIX {
	    set pause 23
	    set play  25
	}
	Linux {
	    set pause 19
	    set play  18
	}
	Darwin {
	    set pause 19
	    set play  18
	}
    }
    
    if $pauser {
	exec kill -$play $pID
	set pauser 0
	setstate play
    } else {
	bug exec kill -$pause $pID
	exec kill -$pause $pID
	set pauser 1
	setstate pause
    }
}

proc CsoundStop {} {
    global stuff lip path pID pauser prefs errorCatch
    setstate idle 
    set pauser 0
    catch {exec kill $pID} res
    catch {close $stuff}

    $path(panel).csoundOut.t config -state normal
    $path(panel).csoundOut.t insert end "$lip"
    $path(panel).csoundOut.t config -state disabled
    catch {destroy .message}
     if $errorCatch {
	if {$res == ""} {
	    if {$prefs(globalMode) && $prefs(play)} {$path(winOut).rates.play invoke}
	}
   }
}

proc makeCommand {what} {
    global prefs lan new module  path soundOutInfo realtim
    global commande midifile  soundName selectedMIDIfile 
    global   midiIn ceclib tcl_platform midiinfo value

    if {$prefs(globalMode) == "0"} {
		set soundName devaudio
		set bufs "-b$prefs(realb) -B$prefs(realB)"
    } else {
		set bufs "-b$prefs(diskb) -B$prefs(diskB)"
		set soundName \"[autoIncrement]\"
		if {$soundName == ""} {errFile2 "$lan(nom80)";return}
		$path(winOut).rates.play config -state normal -command {playSound \"$soundName\" $path(winOut).p.h.d.b}
		if {$prefs(type) == "$lan(nom3)"} {
			$path(winOut).rates.edit config -state disabled
			set soundName "$soundName.raw"
		} else {	
			$path(winOut).rates.edit config -state normal
		}
    }	    
    if {$prefs(heart) == 1} {set heart "-H"} else {set heart ""}  
    switch $prefs(type) {
		"aiff"	{set s "-A -R"} 
		"raw" 	{set s "-h"}
		"wav"	{set s "-W -R"}
    }  
    if [info exists midiinfo] {set F "-F \"$value($midiinfo)\""} {set F ""}
    if {$prefs(time) == 1} {set time "/usr/bin/time"} else {set time ""}    
    if {$prefs(sigin) == 1} {set i "-i devaudio"} else {set i ""}
    if {$prefs(graph) == 0} {set g "-d"} else {set g ""}
    if {$prefs(ascii) == 0} {set as ""} else {set as "-g"}
    if {$prefs(midi) == 1 | $midiIn == 1} {set m "-M /dev/$prefs(midiport)"} else {set m ""} 
    if {$midifile == 0} {set mi ""} else {set mi "-T -F $selectedMIDIfile"}
    set sc ""
    if {$prefs(wind) == 1} {
		set me 0
		if {$prefs(amp)}   {set me [expr $me+1]}
		if {$prefs(range)} {set me [expr $me+2]}
		if {$prefs(warn)}  {set me [expr $me+4]}
		set mess "-m $me"		
		if {$prefs(heart) == 1} {set heart "-H"} else {set heart ""}
    } else {
		set mess "-m 0"
		set heart ""
    }
    if {$prefs(tempo) == "off"} {set tem ""} else {set tem "-t $prefs(tempo)"}  
    if {$tcl_platform(platform) == "unix" && $realtim == 1} {set rl "-L stdin"} else {set rl ""}
    set compile $module(tempfile)
#######################
    set commande "$time $prefs(help:CSND) $tem $as $F $heart $mess $s $sc -o $soundName $rl $bufs $g $i $m $mi $compile.orc $compile.sco"
#######################
    $path(panel).csoundOut.t config -state normal
    $path(panel).csoundOut.t delete 0.0 end
    $path(panel).csoundOut.t insert end "% $commande \n"
    $path(panel).csoundOut.t config -state disabled
    set iconer 0
    bind . <Control-m> "Run Csound"    
    Run Csound perf
}	

proc Run {what why} {
	
    global commande lip killButt midirec fillButt stuff prefs  okline pID errorCatch
    global newline tcl_platform soundName

    if $prefs(prev_line) {
    	previewcsound $commande	
	if { $okline == 0 } { return }
	set commande $newline
    }
    
    bug here

    if {$prefs(wind) == 1} {
	switch $tcl_platform(os) {
	    IRIX {
		set comm "xwsh   -name ${what} -hold -bg gray20  -geometry 84x24+250+250  -e $commande" 
	    }
	    Linux {
# This wrapper adds a sleep after csound runs to keep the window open
# run csound in an xterm, exit if it all runs smoothly, sleep on error to display it
		bug linux...
		set csoundWrapper "/tmp/.cecilia-wrap-csound"
		if ![file exists $csoundWrapper] {
		    bug creating new linux wrapper
		    set csoundWrapperFileHandle [open $csoundWrapper w+]
		    puts $csoundWrapperFileHandle "\#!/bin/sh\n$@\necho Cecilia/Csound done...\nsleep 1000000\n\n"
		    close $csoundWrapperFileHandle
		    exec chmod 755 $csoundWrapper
		}
		set comm "xterm -title ${what} -e $csoundWrapper $commande" 
	    }
	    Darwin {
# This wrapper adds a sleep after csound runs to keep the window open
# run csound in an xterm, exit if it all runs smoothly, sleep on error to display it
		bug darwin...
		set csoundWrapper "/tmp/.cecilia-wrap-csound.command"
		if [file exists $csoundWrapper] {
		    bug deleting Darwin wrapper
		    # this should delete the file in case its an older version
		    file delete -force $csoundWrapper
		} 
		bug creating new Darwin wrapper
		set csoundWrapperFileHandle [open $csoundWrapper w+]
		puts $csoundWrapperFileHandle \
		    "\#!/bin/sh\n\
                    echo Csound command: $commande\n\ 
                    $commande || echo ERROR: read message above\n\
                    echo Cecilia/Csound done.\n\n"
		close $csoundWrapperFileHandle
		exec chmod 755 $csoundWrapper
		
		set comm "/usr/bin/open $csoundWrapper" 
	    }
	}
    } else {
	set comm "$commande"
    }

    set errorCatch 1
    set midirec 1
    set lip ""
    set stuff ""
    setstate play

    switch -- $why {
	"perf" {
	    set stuff [open |[subst $comm]  RDWR ]
	    set pID [pid $stuff]
	    fconfigure $stuff -blocking 0
	    fileevent $stuff readable Logg
	    if {$prefs(globalMode) == "1" && $prefs(spee) == "1"} {errFile1 "WRITING:\n$soundName\nto disk..."}
	}
	"anal" {
	    set stuff [open |[subst $comm] RDWR]
	    set pID [pid $stuff]
	    fconfigure $stuff -blocking 0
	    fileevent $stuff readable anaLogg
	    if {$prefs(globalMode) == "1" && $prefs(spee) == "1"} {errFile1 "WRITING:\n$soundName\nto disk..."}
	}
    }
}

proc putIt {chan val} {
    global stuff realArr
    catch {puts $stuff "i${chan} 0 0.001 $val"}
    catch {flush $stuff}
}
proc anaLogg {} {
    global stuff
    if [eof $stuff] {CsoundStop}
}

proc Logg {} {
    global stuff path soundOutInfo nchnls module lip prefs errorCatch
    if [eof $stuff] {
	CsoundStop
    } else {
	gets $stuff line
	$path(panel).csoundOut.t config -state normal
	$path(panel).csoundOut.t insert end "$line \n"
	$path(panel).csoundOut.t config -state disabled
	set ender ""; set li ""
        set ft $path(edit).panel.orcOut.t
	set f $path(edit).panel.$soundOutInfo(nchnls).t

	if [regexp -- "error:" $line] {
		bell;bell
		gets $stuff lined
		set errorCatch 0
		CsoundStop
		set end2 [$ft index end]
		set dif [expr round([$ft index end] - [$ft search $lined 1.0 ]) -1]
		set ender [expr [$f index end]-$dif]
		set end3 [$f index "$ender lineend"]
		$f insert "$end3 lineend" "  ;<---[lrange $line 1 [expr [lsearch  $line line] - 1]]"
		$f tag add mis $end3 "$end3 lineend"
		$f tag configure mis -foreground darkorange
		if {[string first ' $line] != "-1" } {
		    set  lo [$f search [string trim [string range $line [string first  ' $line] [string last  ' $line]] '] 1.0 ]
		    $f tag add sel "$lo wordstart" "$lo wordend"		
		    $f mark set insert $lo
		}
		errFile2 "There is an error in your orchestra.\n Orange colored arrow points to it!"
catch {tkwait visibility .speedo}
		catch {destroy .speedo}
		wm deiconify .edit
		raise .edit
		$f yview [expr [$f index end]-$dif.0]
		
		
	}
	    
	if [regexp -- "INIT ERROR" $line] {
		bell;bell
		set errorCatch 0
		CsoundStop		
		set ender [$path(edit).panel.$soundOutInfo(nchnls).t index end]
		$path(edit).panel.$soundOutInfo(nchnls).t insert $ender  "\n;INIT ERROR: [lrange $line 5 end]"
		$path(edit).panel.$soundOutInfo(nchnls).t tag add mis $ender end
		$path(edit).panel.$soundOutInfo(nchnls).t tag configure mis -foreground darkorange
		$path(edit).panel.$soundOutInfo(nchnls).t yview $ender
		catch {destroy .speedo}
		errFile2 "There is an error in your use of functions.\n Orange colored message describes it!"
		wm deiconify .edit
		raise .edit
	}

	if [regexp -- "opds" $line] {
		bell;bell
		set errorCatch 0
		CsoundStop
		set ender [$path(edit).panel.$soundOutInfo(nchnls).t index end]
		$path(edit).panel.$soundOutInfo(nchnls).t insert "$ender + 1l"  "\n;SOMETHING WRONG WITH CHANNELS AND/OR\n;INSTRUMENT STRUCTURE"
		bug [$path(edit).panel.$soundOutInfo(nchnls).t index end]
		$path(edit).panel.$soundOutInfo(nchnls).t tag add mis $ender end
		$path(edit).panel.$soundOutInfo(nchnls).t tag configure mis -foreground darkorange
		$path(edit).panel.$soundOutInfo(nchnls).t yview $ender
		errFile2 "SOMETHING WRONG WITH CHANNELS\n AND/OR INSTRUMENT STRUCTURE?"
	}
	    
	if [regexp -- "overall amps" $line] {
	    for {set c 0} {$c<$nchnls($soundOutInfo(nchnls))} {incr c} {
		$path(winOutAmp).ok$c config -text [lindex $line [expr $c + 5]]
	    }
	}
	if [regexp -- "samples out of range" $line] {
	    for {set c 0} {$c<$nchnls($soundOutInfo(nchnls))} {incr c} {
	    	if {[set amp [lindex $line [expr $c + 5]]] > 0} {
		    $path(winOutAmp).ov$c config -text $amp -fg red
		} else {
		    $path(winOutAmp).ov$c config -text ok
		}
	    }
	}
    }	
}