# dtk-dt - Interfacing Emacspeak to a DoubleTalk via TCL.    -*-tcl-*-
# Keywords: Emacspeak, DoubleTalk, TCL
#
# Original program by T. V. Raman. 
# Modifications for the DoubleTalk by Jim Van Zandt <jrv@vanzandt.mv.com>
#
# $Id: dtk-dt,v 1.2 1998/06/02 01:11:21 jrv Exp jrv $
#

# }}}
# {{{ Copyright:  

# Copyright (c) 1995, 1996, 1997 T. V. Raman, Adobe Systems
# Incorporated.
#All Rights Reserved
# Copyright (c) 1994, 1995 by Digital Equipment Corporation.
# All Rights Reserved. 
#
# This file is not part of GNU Emacs, but the same permissions apply.
#
# GNU Emacs is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# GNU Emacs is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Emacs; see the file COPYING.  If not, write to
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

# }}}
# {{{commandabbreviations 

#This version uses shortened dtk command strings to improve performance 
#when running remote sessions.
#These short-cuts are documented here to preserve ones sanity.
#:sa == :say
# c == clause 
# w == word
# le == letter 
#:to == :tone 
# :ra == :rate 
# :index == :i
# reply == r
# :punct == :pu
# a == all
# s == some

# }}}
# {{{ procedures  

proc dectalk_set_punctuations {mode} {
    tts_set_punctuations $mode
    return ""
}

proc tts_set_punctuations {mode} {
    global dectalk_globals
    set dectalk_globals(punctuations) $mode
    return ""
}

proc dectalk_set_speech_rate {rate} {
    tts_set_speech_rate $rate
    return ""
}

proc tts_set_speech_rate {rate} {
    global dectalk_globals
    set factor $dectalk_globals(char_factor) 
    set dectalk_globals(say_rate) [round \
                                       [expr $rate  * $factor ]]
    set dectalk_globals(speech_rate) $rate
    return ""
}

proc dectalk_set_character_scale {factor} {
    tts_set_character_scale $factor
    return ""
}

proc tts_set_character_scale {factor} {
    global dectalk_globals
    set dectalk_globals(say_rate) [round \
                                       [expr $dectalk_globals(speech_rate) * $factor ]]
    set dectalk_globals(char_factor) $factor
    return ""
}

proc dectalk_say {text} {
    tts_say $text
    return ""
}

proc tts_say {text} {
    global dectalk_globals
    regsub -all {\[:version speak\]} $text $dectalk_globals(version)  text
    set dectalk_globals(not_stopped) 1
    set fl $dectalk_globals(flush)
    puts -nonewline  $dectalk_globals(write)\
	    "$text$fl"
#        "\[_]\[:sa w]$text "
        tts_gobble_acknowledgements
return ""
}

#formerly called dectalk_letter

proc l {text} {
    global dectalk_globals
    set dectalk_globals(not_stopped) 1
#    set r $dectalk_globals(speech_rate)
#    set f  $dectalk_globals(say_rate)
    set ra [rate_command $dectalk_globals(say_rate)]
    puts -nonewline  $dectalk_globals(write)\
	    "$dectalk_globals(charmode)$text\r"
#    "\[_]\[:ra $f :sa le]$text"
        return ""
}

#formerly called dectalk_speak
proc d {} {
    speech_task
}

proc dectalk_speak {text} {
    tts_speak $text
    return ""
}

proc tts_speak {text} {
    q $text
    speech_task
}

proc dectalk_resume  {} {
    tts_resume
    return ""
}

proc tts_resume  {} {
    global dectalk_globals
    queue_restore
    if {[queue_empty?]} {
        puts -nonewline  $dectalk_globals(write) "No speech to resume\013"
        set dectalk_globals(not_stopped) 1
    } else {
        speech_task
    }
    return ""
}

proc dectalk_pause {} {
    tts_pause
    return ""
}

proc tts_pause {} {
    global dectalk_globals 
    queue_backup
    s
    return ""
}

#formerly called dectalk_stop 

proc s {} {
    global dectalk_globals
    if {$dectalk_globals(not_stopped)} {
	set st $dectalk_globals(stop)
	set tm $dectalk_globals(textmode)
	set ra [rate_command $dectalk_globals(speech_rate)]
        puts -nonewline  $dectalk_globals(write)  "$st$ra$tm"
        set dectalk_globals(not_stopped) 0
#        select [list $dectalk_globals(read)] {} {} {}
#        read  $dectalk_globals(read) 1
        set dectalk_globals(talking?) 0
        queue_clear
        #tts_gobble_acknowledgements
    }
}

#   Return a DoubleTalk command string to generate a tone with the
#   specified frequency (in Hz) and duration (in msec).

proc tone_command {{frequency 440} {duration 50}} {
    global dectalk_globals queue

    ## early versions did not implement tones 
#    if {$has_sine_tones = 0} return ""

    # express duration in sec 
    set duration [expr $duration*.001]

#   The DoubleTalk tone generator is controlled by the three
# parameters n, Kd, and K1.  The frequency of the tone in Hz is
# K1*603/(155-n), and the duration in seconds is Kd*(155-n)*.256/617.
# The three parameters are subject to these constraints: 1 <= n <= 99,
# 1 <= K1 <= 255, and 1 <= Kd <= 255.  These permit frequencies up to
# 2746 Hz and durations from 23 msec to 16.29 sec.  Here, we use 'tau'
# to stand for (155-n).

    # first priority: hardware limits
    set taumin 56
    set taumax 154

    # second priority: reach specified frequency
    # (provided the above limits are respected)
    set taumin [max $taumin [min [expr 603./$frequency] $taumax]]
    set taumax [min $taumax [max [expr 255*603./$frequency] $taumin]]

    # third priority: reach specified duration
    # (provided the above limits are respected)
    set taumin [max $taumin [min [expr 617.*$duration/.256/255] $taumax]]
    set taumax [min $taumax [max [expr 617.*$duration/.256] $taumin]]

    if {$taumin == $taumax} {
	set tau $taumin
	set K1 [min 255 [max 1 [int [expr $tau*$frequency/603.+.5]]]]
    } else {

##   Find good values of tau and K1.  K1/tau should approximate
## frequency/603.  We express the latter as a continued fraction, and (if
## possible) use one of its approximates.  In other words, we express
## frequency/603 in the form t0 + 1/(t1 + 1/(t2 + 1/(t3 + ...))) where ti
## is an integer.  To form an approximate of this continued fraction, we
## ignore everything after one of the '+' signs, and reduce to a regular
## fraction.  The more terms we include, the more accurate the
## approximate is.  For example, pi = 3 + 1/(7 + 1/(15 + 1/(1 + 1/(293 +
## ...)))).  The first four approximates are: 3, 22/7, 333/106, and
## 355/113.
## 
##    An approximate is accurate to about the same number of digits as it
## has.  The last approximate shown above for pi is accurate to 7 decimal
## places.  Our numerator and denominator can have 8 bits, so we can hope
## for about 16 bits of accuracy, or almost 5 decimal digits.  We can't
## really do this well, since tau is always restricted to the interval
## 56...154, and sometimes a much smaller interval.
## 
##    Here, we use a recurrence relation which lets us calculate
## successive approximates in the forward direction. 

	set ratio [expr $frequency/603.]

	if {$ratio > 1.} {
	    set num0 1
	    set den0 0
	    # num1/den1 is the first approximate
	    set num1 [floor $ratio]
	    set den1 1
	    set ratio [expr $ratio-$num1]
	} else {
	    set num0 0
	    set den0 1
	    set ratio [expr 1./$ratio]
	    # num1/den1 is the first approximate
	    set num1 1
	    set den1 [floor $ratio]
	    set ratio [expr $ratio-$den1]
	}
	while {$ratio > 0} {
	    set ratio [expr 1./$ratio]
	    if {$ratio > 1000.} break
	    set term [floor $ratio]
	    set ratio [expr $ratio-$term]
	    set num2 [expr $num0+$num1*$term]
	    set den2 [expr $den0 + $den1*$term]
	    if {$num2 > 255} break
	    if {$den2 > $taumax} break;
	    set num0 $num1
	    set num1 $num2
	    set den0 $den1
	    set den1 $den2
	}
	if {$den1 < $taumin} {
	    set scale [ceil [expr $taumin*1./$den1]]
	    set num1 [expr $num1*$scale]
	    set den1 [expr $den1*$scale]
	}
	if {$den1 > $taumax} {
				# There was no approximate whose
				# denominator, nor an integer
				# multiple of one, is in the allowed
				# range.  We fall back on a simpler
				# approximation.
	    set tau [expr ($taumin+$taumax)/2.]
	    set K1 [int [expr $frequency*$tau/603.+.5]]
	} else {
	    set K1 [max 1 [min 255 [int [expr $num1+.5]]]]
	    set tau [max $taumin [min $taumax $den1]]
	}
    }
    set n [int [expr 155.5-$tau]]
    set Kd [max 1 [min 255 [int [expr 617*$duration/$tau/.256 + .5]]]]

    # The DoubleTalk can generate a second simultaneous sine wave with
    # frequency determined by K2.  K2=0 would disable the second
    # source.  However, we cannot set K2=0 since the null byte would
    # terminate the string.  Instead, we make both the same.
    set K2 $K1
#
# The first is easier to read, but the second is the correct command string
#    return [format "\\1 %dJ %o %o %o" $n $Kd $K1 $K2]
    return [format "\1%dJ%c%c%c\r" $n $Kd $K1 $K2]
}

#formerly called dectalk_tone

proc t {{frequency 440} {duration 50}} {
    global dectalk_globals queue

    set command [tone_command $frequency $duration]

    set queue($dectalk_globals(q_tail)) [list t $command]
    incr dectalk_globals(q_tail)
    return ""
}

proc sh  {{duration 50}} {
    global dectalk_globals queue
    set silence ""
    loop i 0 [expr duration/10] {
	append silence "$dectalk_globals(silencecmd)"
    }
    set queue($dectalk_globals(q_tail)) [list t $silence]
    incr dectalk_globals(q_tail)
    return ""
}


proc dectalk_split_caps {flag} {
    tts_split_caps $flag
    return ""
}

proc tts_split_caps {flag} {
    global dectalk_globals 
    set dectalk_globals(split_caps) $flag
    return ""
}

proc dectalk_capitalize {flag} {
    tts_capitalize $flag
    return ""
}

proc tts_capitalize {flag} {
    global dectalk_globals 
    set dectalk_globals(capitalize) $flag
    return ""
}

proc dectalk_allcaps_beep {flag} {
    tts_allcaps_beep $flag
    return ""
}

proc tts_allcaps_beep {flag} {
    global dectalk_globals 
    set dectalk_globals(allcaps_beep) $flag
    return ""
}

proc  read_pending_p  {file_handle} {
    set status   [lsearch [select [list  $file_handle]  {} {} 0] $file_handle]
    expr $status >= 0
}

proc tts_get_acknowledgement {} {
    global dectalk_globals
#echo "   entering tts_get_acknowledgement"
# note that we cannot use stdin here due to a tcl bug.
# in tcl 7.4 we could always say file0
# in 7.5 and above  (only tested in 7.5 and 8.0)
# we need to say sock0 when we are a server
    set input $dectalk_globals(input)
    set status [select [list   $dectalk_globals(read) $input ] {} {} {}]
#echo "   status=$status"
    set code ""
    if {[lsearch $status $input]   >=0} {
        set dectalk_globals(talking?) 0
    } else {
        set r $dectalk_globals(read)
        while {[lsearch [select [list  $r] {} {} 0.1] $r] >= 0  } {
            append code [read $r  1]
        }
    }
#echo "   leaving tts_get_acknowledgement"
    return $code
}

#Gobble up any garbage the Dectalk has returned.

proc tts_gobble_acknowledgements {{delay 0.1}} {
    global dectalk_globals
    set r $dectalk_globals(read)
    while {[lsearch [select [list  $r] {} {} 0.001] $r] >= 0  } {
        read $r  1
    }
}

proc dectalk_reset {} {
    tts_reset
}
    
proc tts_reset {} {
    global dectalk_globals
    s
    tts_gobble_acknowledgements
    set dectalk_globals(not_stopped) 1
    puts -nonewline     $dectalk_globals(write) \
	    "$dectalk_globals(resetcmd) Restoring sanity to the DoubleTalk.\r"
}

# }}}
# {{{ speech task 

proc speech_task {} {
    global queue dectalk_globals
    set dectalk_globals(talking?) 1
    set dectalk_globals(not_stopped) 1
    set np $dectalk_globals(paul)
    set ra [rate_command $dectalk_globals(speech_rate)]
    set length [queue_length]
    tts_gobble_acknowledgements
    set pu [punctuation_command]

    puts -nonewline $dectalk_globals(write) \
	    "$dectalk_globals(textmode)$np$ra$pu"
# "\[_]\[:sa c]\[:np]\[:ra $r]\[:pu $mode]" 
    loop index 0 $length {
        set event   [queue_remove]
        set event_type [lindex $event 0]
        switch  -exact -- $event_type {
            s {
                set text [clean [lindex $event 1]]
                puts -nonewline  $dectalk_globals(write) \
			"$dectalk_globals(mark)$text\r"
#"\[:i r 1]$text\[_.]\013"
                set retval [tts_get_acknowledgement ]
            }
            t {
                set text [fixtone [lindex $event 1]]
                puts -nonewline  $dectalk_globals(write) $text
# "\[_.]$text\[_.] "
            }
            a {
                set sound [lindex $event 1]
                catch "exec $dectalk_globals(play) $sound >& /dev/null &" errCode
            }
            default {
            }
        }
        if {$dectalk_globals(talking?) == 0} {break;} 
    }
    set dectalk_globals(talking?) 0
    return ""
}

# }}}
# {{{ queue:

#preprocess element before sending it out:

proc clean {element} {
    global queue dectalk_globals
# substitute for voice commands
    regsub -all {\[:np[^]]*\]} $element $dectalk_globals(paul) element
    regsub -all {\[:nh[^]]*\]} $element $dectalk_globals(henry)  element
    regsub -all {\[:nd[^]]*\]} $element $dectalk_globals(dennis)  element
    regsub -all {\[:nf[^]]*\]} $element $dectalk_globals(frank)  element
    regsub -all {\[:nb[^]]*\]} $element $dectalk_globals(betty)  element
    regsub -all {\[:nu[^]]*\]} $element $dectalk_globals(ursula)  element
    regsub -all {\[:nr[^]]*\]} $element $dectalk_globals(rita)  element
    regsub -all {\[:nw[^]]*\]} $element $dectalk_globals(wendy)  element
    regsub -all {\[:nk[^]]*\]} $element $dectalk_globals(kit)  element
    regsub -all {\[:n[^]]*\]}  $element $dectalk_globals(paul) element

    if {[string match all $dectalk_globals(punctuations)] } {
        regsub -all {\#} $element \
            { pound } element
        regsub -all {\*} $element \
            { star } element
        regsub -all  {[%&;()$+=/]} $element  { \0 }   element
        regsub -all {\.,} $element \
            { dot comma } element
        regsub -all {\.\.\.} $element \
            { dot dot dot } element
        regsub -all {\.\.} $element \
            { dot dot } element
        regsub -all {([a-zA-Z])\.([a-zA-Z])} $element \
            {\1 dot \2} element
        regsub -all {[0-9]+} $element { & } element
    } else {
        regsub -all {\.,} $element \
            {} element
        regsub -all {([0-9a-zA-Z])(["!;/:()=])+([0-9a-zA-z])} $element \
            {\1 \2 \3} element
regsub -all {([a-zA-Z])(,)+([a-zA-z])} $element \
            {\1 \2 \3} element
        regsub -all {([a-zA-Z])(\.)([a-zA-z])} $element \
            {\1 dot \3} element
#	 regsub -all {``} $element {[_<1>/]} element
#	 regsub -all {''} $element {[_<1>\\]} element
#	 regsub -all { '}  $element {[_']} element
#	 regsub -all {' }  $element {[_']} element
#	 regsub -all --  {--} $element { [_,]} element
        regsub -all -- {-}  $element { } element 
    }
 if {$dectalk_globals(capitalize) } {
     regsub -all {[A-Z]} $element "$dectalk_globals(tone_440_10)&" element
#{[_ :to 440 10]&} element
    }
    if {$dectalk_globals(split_caps) } {
        if  {$dectalk_globals(allcaps_beep)} {
            set tone "$dectalk_globals(tone_660_10)"
            set abbrev_tone "$dectalk_globals(tone_660_10)"
        } else {
            set tone ""
            set abbrev_tone ""
        }
        set allcaps [regexp {[^a-zA-Z0-9]?([A-Z][A-Z0-9]+)[^a-zA-Z0-9]} $element full  match ]
        while {$allcaps } {
#	     if {[string length $match] <=3} {
#		 set abbrev "$abbrev_tone$match"
##                regsub -all {[A-Z]} $abbrev {&[*]} abbrev
##                regsub -all A $abbrev {[ey]} abbrev 
#		 regsub $match $element  $abbrev element
#	     } else {
                regsub $match $element "$tone[string tolower $match]"  element
#            }
            set allcaps [regexp {[^a-zA-Z0-9]([A-Z][A-Z0-9]+)[^a-zA-Z0-9]} $element full  match ]
        }
#        regsub -all {[A-Z]} $element {[_<5>]&} element
#	 regsub -all {([^ -_A-Z])([A-Z][a-zA-Z]* )} $element\
#	     {\1[_<1>]\2[,] } element
#	 regsub -all {([^ -_A-Z])([A-Z])} $element\
#	     {\1[:pause 1]\2} element
    }
    return $element
}

# rewrite DECtalk tone commands for DoubleTalk
proc fixtone {element} {
    global queue dectalk_globals
    while {[regexp {\[:to ([0-9]+) ([0-9]+)]} $element match freq duration]} {
	set cmd [tone_command $freq $duration]
	regsub {\[:to ([0-9]+) ([0-9]+)]} $element $cmd element
    }
    return $element
}

#currently we use an inlined version of this test in speech_task

proc queue_empty? {} {
    global dectalk_globals
    expr $dectalk_globals(q_head) == $dectalk_globals(q_tail)
}

proc queue_nonempty? {} {
    global dectalk_globals
    expr $dectalk_globals(q_head) != $dectalk_globals(q_tail)
}

proc queue_length {} {
    global dectalk_globals
    expr $dectalk_globals(q_tail) - $dectalk_globals(q_head)
}

proc queue_clear {} {
    global dectalk_globals queue
    if {$dectalk_globals(debug)} {
    puts -nonewline  $dectalk_globals(write) "$dectalk_globals(q_head) e\013"
    }
    unset queue
    set queue(-1) "" 
    set dectalk_globals(q_head) 0
    set dectalk_globals(q_tail) 0 
    return ""
}

#formerly called queue_speech --queue speech event

proc q {element} {
    global queue dectalk_globals
    set queue($dectalk_globals(q_tail)) [list s $element]
    incr dectalk_globals(q_tail)
    set mod [expr ($dectalk_globals(q_tail) - $dectalk_globals(q_head)) % 50]
    set sound "progress.au"
    if {$mod == 0} {
        catch "exec $dectalk_globals(play) $sound >& /dev/null &" errCode
    }
    return ""
}

#queue a sound event

proc a {sound} {
    global queue dectalk_globals
    set queue($dectalk_globals(q_tail)) [list a $sound]
    incr dectalk_globals(q_tail)
    return ""
}


proc queue_remove {} {
    global dectalk_globals queue 
    set element  $queue($dectalk_globals(q_head))
    incr dectalk_globals(q_head)
    return $element
}

proc queue_backup {} {
    global dectalk_globals  backup queue
    unset backup
    set backup(-1) ""
    set head [expr  $dectalk_globals(q_head) - 2]
    set tail $dectalk_globals(q_tail)
    loop i $head $tail 1 {
        set backup($i) $queue($i)
    }
    set dectalk_globals(backup_head) $head
    set dectalk_globals(backup_tail) $tail
}

proc queue_restore {} {
    global dectalk_globals  backup queue
    unset queue
    set queue(-1) ""
    set head $dectalk_globals(backup_head)
    set tail $dectalk_globals(backup_tail)
    loop i $head $tail 1 {
        set queue($i) $backup($i)
    }
    set dectalk_globals(q_head) $head
    set dectalk_globals(q_tail) $tail
}

# }}}
# {{{sounds: 

#play a sound over the server
proc p {sound} {
    global dectalk_globals
    catch "exec $dectalk_globals(play) $sound >& /dev/null &" errCode
    speech_task
}

# DoubleTalk - specific functions

# Return speech rate command
# Argument is desired rate in words per minute.
proc rate_command {r} {
    set rmin 100
    set rmax 236
    if {$r<$rmin} {set r $rmin}
    if {$r>$rmax} {set r $rmax}
    set index [int [floor [expr .5+($r-$rmin)*9/($rmax-$rmin)]]]
    return [format "\1%dS" $index]
}

# Return punctuation mode command
proc punctuation_command {} {
    global dectalk_globals
    set mode  $dectalk_globals(punctuations) 
    set punctuation(all) 5
    set punctuation(some) 5
    set punctuation(none) 7
    return "\001$punctuation($mode)B"
}

    # }}}

# {{{ globals

#optional debugging output
if {[info exists env(DTK_DEBUG)] } {
set dectalk_globals(debug) 1
} else {
set dectalk_globals(debug) 0
}

#flag to avoid multiple consecutive stops
set dectalk_globals(not_stopped) 1
#regexp for identifying solaris --should get smarter over time
set solaris_regexp {^SunOS[ a-zA-Z]+5\.[0-9].*  }
#first lets pick a default.
set machine Linux
#if env variable DTK_OS is set, use it;
if {[info exists env(DTK_OS)] } {
    set machine $env(DTK_OS)
} else {
    #Otherwise we'll try guessing.
    catch {set machine [exec uname ]}
    #regexp match to try recognizing solaris
    if {[regexp -nocase $solaris_regexp $machine]} {
        set machine solaris
    }
}
switch -exact  -- $machine {
    ULTRIX  -
    OSF1  {
        if {[info exists env(DTK_PORT)] } {
            set port $env(DTK_PORT)
        } else {
            set port /dev/tty00
        }
        set dectalk_globals(read)  [open $port  r]
        set dectalk_globals(write)  [open $port  w]
        #stty setting:
        exec stty sane 9600 raw  -echo < $port 
        exec stty ixon ixoff  <  $port 
    }
    solaris {
        if {[info exists env(DTK_PORT)] } {
            set port $env(DTK_PORT)
        } else {
            set port /dev/ttya
        }
        set dectalk_globals(read)  [open $port  r]
        set dectalk_globals(write)  [open $port  w]
        #stty setting:
        exec /usr/bin/stty sane 9600 raw  -echo < $port 
        exec /usr/bin/stty -echo <  $port 
        exec /usr/bin/stty ignpar <  $port 
        exec   /usr/bin/stty ixon ixoff <$port 
    }
    SunOS   {
        set machine sunos4
        if {[info exists env(DTK_PORT)] } {
            set port $env(DTK_PORT)
        } else {
            set port /dev/ttya
        }
        set dectalk_globals(read)  [open $port  r]
        set dectalk_globals(write)  [open $port  w]
        #stty setting:
        exec stty sane 9600 raw  -echo -echoe -echoke echoctl  > $port 
        exec stty ixon ixoff  >  $port 
    }
    Linux -
    default   {
        if {[info exists env(DTK_PORT)] } {
            set port $env(DTK_PORT)
        } else {
            set port /dev/ttyS0
        }
        set dectalk_globals(read)  [open $port  r]
        set dectalk_globals(write)  [open $port  w]
        #stty setting:
	if {[expr ![regexp /dev/dtlk.* $port]]} {
	    exec stty sane 9600 raw  -echo crtscts <  $port 
	    #linux wants the -echo done separately
	    exec stty -echo <  $port 
#        exec stty ixon ixoff  < $port 
	}
    }
}

#set up the right kind of buffering:
fcntl $dectalk_globals(read) nobuf 1
fcntl $dectalk_globals(write) nobuf 1


#split caps flag: 
set dectalk_globals(split_caps) 1
# Capitalize flag
set dectalk_globals(capitalize)  0
#allcaps beep flag
set dectalk_globals(allcaps_beep)  0
set dectalk_globals(talking?) 0
set dectalk_globals(speech_rate) 425 
set dectalk_globals(char_factor)  1.2
set dectalk_globals(say_rate) [round \
                                   [expr $dectalk_globals(speech_rate) * $dectalk_globals(char_factor)]]
set dectalk_globals(q_head)  0
set dectalk_globals(q_tail) 0
set dectalk_globals(backup_head)  0
set dectalk_globals(backup_tail) 0
set dectalk_globals(punctuations) some
set queue(-1) ""
set backup(-1) ""
#play program
if {[info exists env(EMACSPEAK_PLAY_PROGRAM)] } {
set dectalk_globals(play)  $env(EMACSPEAK_PLAY_PROGRAM)
} else {
    set dectalk_globals(play) "play"
}

# }}}
# DoubleTalk commands
set dectalk_globals(charmode) "\0015C"
set dectalk_globals(stop) "\030"
				# FIXME what standard interword pause?
set dectalk_globals(textmode) "\0015T"
set dectalk_globals(textmode) "\0010T"
set dectalk_globals(silencecmd) "\00116*"
set dectalk_globals(resetcmd) "\001@"
set dectalk_globals(somepunct) "\0015B"
set dectalk_globals(mark) "\00176I"
set dectalk_globals(flush) "\r"
set dectalk_globals(tone_440_10) [tone_command 440 10]
set dectalk_globals(tone_660_10) [tone_command 660 10]
set dectalk_globals(paul) "\0010O"
set dectalk_globals(henry) "\0011O"
set dectalk_globals(dennis) "\0012O"
set dectalk_globals(frank) "\0013O"
set dectalk_globals(betty) "\0014O"
set dectalk_globals(ursula) "\0010O\00175P"
set dectalk_globals(rita) "\0011O\00175P"
set dectalk_globals(wendy) "\0012O\00175P"
set dectalk_globals(kit) "\0013O\00175P"
set version_string "\$Rev:1.0$"
regsub {\$Rev:} $version_string "" version_string
regsub {\$} $version_string "" version_string
set dectalk_globals(version) [format "dtk-dt version %s" $version_string]

# {{{ Initialize and set state.

#working around tcl 7.5
set dectalk_globals(input) file0
if {[string match [info tclversion] 7.5]
|| [string match 8.0 [info tclversion]] } {
    if {[info exists server_p]} {
        set dectalk_globals(input) sock0
    } else {
        set dectalk_globals(input) file0
    }
}

#do not die if you see a control-c
signal ignore {sigint}
# gobble up garbage that is returned on powerup 
tts_gobble_acknowledgements

puts -nonewline     $dectalk_globals(write)\
"\001@\
\0010T\
\0010Y\
\0015B\
\0015S\
This is the DoubleTalk driver emacspeak-dt.\
speakers report\r\
\00116*\0010T\r\
\0010O Paul \r\
\00116*\
\0011O Vader\r\
\00116*\0010T\r\
\0012O Bob\r\
\00116*\0010T\r\
\0013O Pete\r\
\00116*\0010T\r\
\0014O Larry\r\
\00116*\0010T\r\
\0010O \r\n"

#Start the main command loop:
commandloop

# }}}
# {{{ Emacs local variables  

### Local variables:
### major-mode: tcl-mode 
### voice-lock-mode: t
### folded-file: t
### End:

# }}}

