emacspeak-ss 1.12.1-6 / usr / share / emacs / site-lisp / emacspeak / servers / apollo

#!/usr/bin/tclsh
package require Tclx
# all.in - Generic Emacspeak server code    -*-tcl-*-
# Keywords: Emacspeak, TCL, speech, server
#
# Original program by T. V. Raman. 
# Modifications to make generic copyright 1998 by James R. Van Zandt
# <jrv@vanzandt.mv.com>, all rights reserved.
#
# $Id: all.in,v 1.19 2007/03/23 00:14:24 jrv Exp jrv $
#
# 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.

# 
# command abbreviations 

# 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

# }}}

# Fetch the device-specific code
# apollo.in - Apollo specific Emacspeak server code    -*-tcl-*-
#
#   $Id: apollo.in,v 1.10 2006/02/09 00:15:35 jrv Exp jrv $
#
# {{{ Copyright:  
#
#   This software is Copyright 1998 James R. Van Zandt, all rights reserved
#
#   This program 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; version 2 dated
#   June, 1991, or any later version.
#
#   This program 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 this program;  if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston,
#   MA 02111-1307, USA.
#
# }}}

# {{{ beginning of Apollo - specific functions

proc version {} {
    global tts
    q {this is @$  }
    d
}

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

proc tone_command {{frequency 440} {duration 50}} {
    # the Apollo does not have tones, so we use the "buzzer" sound effect
    return "@T5"
    # FIXME should implement different length buzzers
}

# Return silence command
# Argument is desired pause in msec
# @Tx pauses about 100 msec
proc silence_command  {{duration 50}} {
    set silence ""
    loop i 0 [expr (duration+50)/100] {
	append silence "$tts(silencecmd)"
    }
    return silence
}

# Return speech rate command
# Argument is desired rate in words per minute.
# 1 -> 80 wpm, 9 -> 580, default=3.  We assume a linear relationship.
proc rate_command {r} {
    set rmin 80
    set rmax 580
    if {$r<$rmin} {set r $rmin}
    if {$r>$rmax} {set r $rmax}
    set index [int [floor [expr ($r+14)/62 ]]]
    return [format "@W%d" $index]
}

# Return punctuation mode command
proc punctuation_command {} {
    global tts
    set mode  $tts(punctuations) 
    set punctuation(all) 1
    set punctuation(some) 1
    set punctuation(none) 0
    return "@P$punctuation($mode)"
}

# return either when input can be read from parent process, or when
# synthesizer reports no marks in its queue
proc tts_poll {} {
    global tts

    set input $tts(input)
    while {1} {
				# wait up to 50 msec for input from
				# parent process
	set status [select [list $input ] {} {} 0.05]
	if {[lsearch $status $input]   >=0} {
	    set tts(talking?) 0
	    set code ""
	    break
	}
				# poll the synthesizer
	set code [tts_ping "@I?"]
				# The synthesizer responds with four
				# bytes of the form Iabx, where a and
				# b are ASCII characters representing
				# the one byte hex mark counter (least
				# significant nibble first), and x
				# is either T or M depending on
				# whether the synthesizer is talking
				# or muted.  We quit if the counter is
				# zero and the synthesizer is muted.
	if {[regexp {I00M} $code]} {break}
    }
    return $code
}

# write the argument to the synthesizer, and return its response if any
proc tts_ping {query} {
    global tts
    set status [exec /usr/lib/emacs/common/emacspeak/ping-apollo "$query" $tts(port) ]
    return $status
}

proc tts_initialize {} {
    global tts
# Apollo commands
# @Th
# This command can be inserted in your text to produce sound effects.   The
# sound effects available are:
# 
# h     duration          type of effect
# 0     very short        whoosh
# 1     short               "
# 2     medium              "
# 3     long                "
# 4     very short        buzzer
# 5     short               "
# 6     medium              "
# 7     long                "
# 8     very short        warble 1
# 9     short               "
# A     medium              "
# B     long                "
# C     very short        warble 2
# D     short               "
# E     medium              "
# F     long                "
# @Ec   echos character c
# Sending a @c? command to the synthesiser will produce a reply
# consisting of three characters.  The first of these is the setting
# identifier, such as B for breathiness, followed by two characters
# (bytes) representing the hexadecimal value of that setting.  For
# example, to ask the synthesiser for its current volume setting, send
# @A?.  The synthesiser will reply with the message A60, where 6 is the
# current volume level.
# @A? volume
# @B? breathiness
# @C? battery level (Juno or Juno-SP)
# @D? end of phrase pause setting
# @F? pitch centre point setting
# @H? Hypermode setting
# @K? speaker table setting
# @M? mark-space ratio setting
# @P? punctuation setting
# @Q? inter-word pause setting
# @R? prosody setting
# @S? spell mode setting
# @V? voice setting
# @W? speed setting
# @X? phonetic mode setting
# @=? slot number of the currently selected ROM
# @$? voice source and filter setting
    tts_gobble_acknowledgements
    tts_ping "@E."
#    tts_ping "does this text delay the response?@E."
    tts_ping "@A?"
    tts_ping "@B?"
    tts_ping "@C?"
    tts_ping "@D?"
    tts_ping "@F?"
    tts_ping "@H?"
    tts_ping "@K?"
    tts_ping "@M?"
    tts_ping "@P?"
    tts_ping "@Q?"
    tts_ping "@R?"
    tts_ping "@S?"
    tts_ping "@V?"
    tts_ping "@W?"
    tts_ping "@X?"
    tts_ping "@=?"
    tts_ping "@$?"
    set tts(charmode) "@S1"
    set tts(stop) "\030"
    set tts(textmode) "@S0"
# 100 msec pause
    set tts(silencecmd) "@Tx"
    set tts(resetcmd) ""
    set tts(somepunct) "@P1"
    # set tts(mark) "@E."
    # The apollo counts index marks in the queue, but does not signal
    # passing them unless explicitly queried with @I?
    set tts(mark) "@I+"
    set tts(requires_poll) "1"
    set tts(flush) "\r"
    set tts(tone_440_10) [tone_command 440 10]
    set tts(tone_660_10) [tone_command 660 10]
    set tts(paul) "@V1"
    set tts(henry) "@V2"
    set tts(dennis) "@V3"
    set tts(frank) "@V4"
    set tts(betty) "@V5"
    set tts(ursula) "@V6"
    set tts(rita) "@V4"
    set tts(wendy) "@V5"
    set tts(kit) "@V6"
# @? speaks the ROM version number
    set tts(version) "Apollo with ROM version @?, Apollo server from emacspeak-ss version 1.12.1"
# default: speed, voice pitch, excitability, spell mode, punctuation,
# interword pause, breathiness, pause, voice
    set tts(initstring) "@W3@F8@R3@S0@P0\
@Q0@B8@Db@V1\
This is the Apollo speech server for Emacspeak.\
speakers report\r\
@V1 Paul \r\
@V2 Henry\r\
@V3 Dennis\r\
@V4 Betty\r\
@V5 Ursula\r\
@V6 Rita\r\
@V1 \r\n"
}

# }}} end of Apollo - specific functions


# {{{ Emacs local variables  

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

# }}}

# {{{ These are wrappers which accommodate versions of emacspeak before 8.0

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

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

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

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

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

proc dectalk_resume  {} {
    tts_resume
    return ""
}

proc dectalk_pause {} {
    tts_pause
    return ""
}

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

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

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

proc dectalk_reset {} {
    tts_reset
}

# this was replaced by d in version 12.0
proc tts_speak {text} {
    q $text
    speech_task
}

# }}}

# {{{ These are the current functions

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

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

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

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

# formerly called tts_letter

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

# formerly called tts_speak
proc d {} {
    speech_task
}

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

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

# formerly called tts_stop 

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

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

    set command [tone_command $frequency $duration]

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

proc sh {{duration 50}} {
    global tts queue
    set silence [silence_command duration]
    set queue($tts(q_tail)) [list t $silence]
    incr tts(q_tail)
    return ""
}

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

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

proc tts_allcaps_beep {flag} {
    global tts 
    set tts(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 tts

    if {$tts(requires_poll)} {
	return [tts_poll]
    }

# 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 $tts(input)
# wait until either emacs or synthesizer write something
    set status [select [list   $tts(read) $input ] {} {} {}]
# echo "   status=$status"
    set code ""
    if {[lsearch $status $input]   >=0} {
        set tts(talking?) 0
    } else {
        set r $tts(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.01}} {
    global tts
    set r $tts(read)
    while {[lsearch [select [list  $r] {} {} 0.001] $r] >= 0  } {
        read $r  1
    }
}
    
proc tts_reset {} {
    global tts
    s
    tts_gobble_acknowledgements
    set tts(not_stopped) 1
    puts -nonewline     $tts(write) \
    "$tts(resetcmd) Restoring sanity to the speech device.\r"
}

# queue a rate command
proc r {rate} {
    global queue  tts
    set rate [rate_command $tts(speech_rate)]
    set queue($tts(q_tail)) [list s  $rate]
    incr tts(q_tail)
    return ""
}

# }}}
# {{{ speech task 

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

    puts -nonewline $tts(write) \
	    "$tts(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  $tts(write) \
			"$tts(mark)$text$tts(flush)"
# "\[:i r 1]$text\[_.]\013"
                set retval [tts_get_acknowledgement ]
            }
            t {
                set text [fixtone [lindex $event 1]]
                puts -nonewline  $tts(write) "$tts(mark)$text"
# "\[_.]$text\[_.] "
                set retval [tts_get_acknowledgement ]
            }
            a {
                set sound [lindex $event 1]
                catch "exec $tts(play) $sound >& /dev/null &" errCode
            }
            default {
            }
        }
        if {$tts(talking?) == 0} {break;} 
    }
    set tts(talking?) 0
    return ""
}

# }}}
# {{{ queue:

# preprocess element before sending it out:

proc clean {element} {
    global queue tts

    if {[string match all $tts(punctuations)] } {
	regsub -all {@} $element \
		{ at } element
        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 {
	if {[string match some $tts(punctuations)] } {
	    regsub -all {@} $element \
		    { at } element
	} else {
	    regsub -all {@} $element \
		    { } element
	}
        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 {$tts(capitalize) } {
     regsub -all {[A-Z]} $element "$tts(tone_440_10)&" element
# {[_ :to 440 10]&} element
    }
    if {$tts(split_caps) } {
        if  {$tts(allcaps_beep)} {
            set tone "$tts(tone_660_10)"
            set abbrev_tone "$tts(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
    }

# substitute for voice commands
# the first substitution is a special case for indentation in tcl-mode
    regsub -all {\[:np :dv  sm  40  ri  40   hr  7   sr  10  \]} $element \
	    $tts(henry)  element
#                                        $tts(betty)  element
    regsub -all {\[:np[^]]*\]} $element $tts(paul) element
    regsub -all {\[:nh[^]]*\]} $element $tts(henry)  element
    regsub -all {\[:nd[^]]*\]} $element $tts(dennis)  element
    regsub -all {\[:nf[^]]*\]} $element $tts(frank)  element
    regsub -all {\[:nb[^]]*\]} $element $tts(betty)  element
    regsub -all {\[:nu[^]]*\]} $element $tts(ursula)  element
    regsub -all {\[:nr[^]]*\]} $element $tts(rita)  element
    regsub -all {\[:nw[^]]*\]} $element $tts(wendy)  element
    regsub -all {\[:nk[^]]*\]} $element $tts(kit)  element
    regsub -all {\[:n[^]]*\]}  $element $tts(paul) element
# map any unrecognized voice to Dennis
    regsub -all {\[ :dv[^]]*\]}  $element $tts(dennis) element

    return $element
}

# rewrite DECtalk tone commands for the speech device
proc fixtone {element} {
    global queue tts
    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
}

proc tts_sync_state {punct capitalize allcaps splitcaps rate} {
    tts_set_punctuations  $punct
    tts_capitalize  $capitalize
    tts_allcaps_beep  $allcaps
    tts_split_caps   $splitcaps
    tts_set_speech_rate  $rate
}

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

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

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

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

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

# formerly called queue_speech --queue speech event

proc q {element} {
    global queue tts env
    set queue($tts(q_tail)) [list s $element]
    incr tts(q_tail)
    set mod [expr ($tts(q_tail) - $tts(q_head)) % 50]
    if {[info exists env(EMACSPEAK_DIR)] } {
       set sound "$env(EMACSPEAK_DIR)/sounds/drip.au"
    } else {
       set sound "drip.au"
    }
    if {$mod == 0} {
	set tone [tone_command 500 20]
        puts -nonewline     $tts(write)    "$tone$tty(flush)"
        catch "exec $tts(play) $sound >& /dev/null &" errCode
    }
    return ""
}

# queue a sound event

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


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

proc queue_backup {} {
    global tts  backup queue
    if {[queue_empty?]} {
	set tts(backup_head) 0
	set tts(backup_tail) 0
        return
    }
    unset backup
    set backup(-1) ""
    set head [expr  max($tts(q_head) - 2, 0)]
    set tail $tts(q_tail)
    loop i $head $tail 1 {
        set backup($i) $queue($i)
    }
    set tts(backup_head) $head
    set tts(backup_tail) $tail
}

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

# }}}
# {{{ sounds: 

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

    # }}}

# {{{self test 

proc tts_selftest {} {
     loop i 1 10 {
	 q "This is test $i. "
     }
     d
}

# }}}
# {{{guessing os   and port 

proc which_os {} {
    global env
    #if env variable DTK_OS is set, use it;
    if {[info exists env(DTK_OS)] } {
	return  $env(DTK_OS)
    } 
    set machine [exec uname -a]
    #os hostname version 
    set fields [split $machine ]
    set os [lindex $fields 0]
    set host [lindex $fields 1]
    set version [lindex $fields 2]    
    switch -exact  -- $os {
	ULTRIX  -
	OSF1  {return DEC}
	SunOS {
	    #are we  solaris
	    if {[string match 5.* $version] }  {
		return Solaris
	    } else    {
		#we are sunos 4
		return SunOS
	    }
	}
	Linux -
	default    {
	    return Linux
	}
    }
}

proc which_port {{os Linux}} {
    global env
    if {[info exists env(DTK_PORT)] } {
	set port $env(DTK_PORT)
	puts stdout "Set port to $port"
    } else {
	switch -exact  -- $os {
	    DEC {
		set port /dev/tty00
	    }
	    SunOS -
	    Solaris -
	    solaris {
		set port /dev/ttya
	    } 
	    Linux -
	    default {
		set port /dev/ttyS0
	    }
	}
    }
    return $port
}

# }}}

# {{{ globals

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

# flag to avoid multiple consecutive stops
set tts(not_stopped) 1

# set the machine and I/O port
set machine [which_os]
set port [which_port $machine]
set tts(port) $port

set tts(read)  [open $port  r]
set tts(write)  [open $port  w]

#set up stty settings 
switch -exact  -- $machine {
    DEC { #osf and ultrix
        exec stty sane 9600 raw  -echo < $port 
        exec stty ixon ixoff  <  $port 
    }
    solaris -
    Solaris {
        exec /usr/bin/stty sane 9600 raw  < $port 
        exec /usr/bin/stty -echo <  $port 
        exec /usr/bin/stty ignpar <  $port 
        exec   /usr/bin/stty ixon ixoff < $port 
    }
    SunOS   {
        exec stty sane 9600 raw  -echo -echoe -echoke echoctl  > $port 
        exec stty ixon ixoff  >  $port 
    }
    Linux -
    default   {
	if {[expr ![regexp /dev/dtlk.* $port]]} {
          exec stty sane 9600 raw  -echo crtscts <  $port 
          exec stty -echo <  $port 
          exec stty ixon ixoff  < $port 
	}
    }
}

if {$tts(debug)} {
    set tts(dfile) [open "log.debug" w]
    fcntl $tts(dfile) nobuf 1
}

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


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

# }}}

set tts(requires_poll) "0"

tts_initialize

# {{{ Initialize and set state.

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

# 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     $tts(write) $tts(initstring)

# Start the main command loop:
commandloop

# }}}
# {{{ Emacs local variables  

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

# }}}