Modified DoubleTalk server for Emacspeak
Matthew Campbell
mattcampbell at pobox.com
Sun Mar 11 21:21:57 EST 2001
OK, I'm sorry I've waited so long to tell everyone how to use
Emacspeak and Speakup together. Yes, the speech server needs to be
modified, and I've done this for a couple of synthesizers (the
DoubleTalk and the BNS). I still need to make the modification
generic so it can be used for all the synthesizers, and I need to make
it so that you can use the same speech server with or without
Speakup. But for now, here is the modified doubletalk server that
will let you run Emacspeak and Speakup together. Of course, you'll
need to disable Speakup before you can start Emacspeak. Another quirk
to note is that if you turn on punctuation in Emacspeak, you may hear
some punctuation marks twice when using Speakup if you have the
Speakup punctuation level set high enough. Other than that, the two
work well together.
Matt
-------------- next part --------------
# 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 at vanzandt.mv.com>, all rights reserved.
#
# $Id: all.in,v 1.11 1999/11/04 00:33:08 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
# doubletalk.in - DoubleTalk specific Emacspeak server code -*-tcl-*-
#
# $Id: doubletalk.in,v 1.8 2000/05/07 23:27:39 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 DoubleTalk - specific functions
#
# 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 tts queue
# early versions did not implement tones
if [expr $tts(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]
}
# Return silence command
# Argument is desired pause in msec
proc silence_command {{duration 50}} {
set silence ""
loop i 0 [expr duration/10] {
append silence "$tts(silencecmd)"
}
return silence
}
# Return speech rate command
# Argument is desired rate in words per minute.
# measured speaking rates are as follows:
# DoubleTalk PC, max rate (code=9): 480 words/78 sec = 370 wpm
# DoubleTalk LT, max rate (code=9): 490 words/80 sec = 367 wpm
#
# measurements are with punctuation=none.
#
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 tts
set mode $tts(punctuations)
set punctuation(all) 5
set punctuation(some) 5
set punctuation(none) 7
return "\001$punctuation($mode)B"
}
proc tts_initialize {} {
global tts env
# interrogate the DoubleTalk
if {[info exists env(DTK_PORT)] } {
set port $env(DTK_PORT)
} else {
set port ""
}
if {[regexp {dev/synth} $port]} {
set version "5.20"
# echo "internal doubletalk at $port is assumed to be version $version"
} else {
set r $tts(read)
while {[lsearch [select [list $r] {} {} 0.1] $r] >= 0 } {
read $r 1
}
puts -nonewline $tts(write) "\001?"
set status ""
while {[lsearch [select [list $r] {} {} 0.1] $r] >= 0 } {
append status [read $r 1]
}
set version $status
echo "doubletalk status report is $version"
regsub {^..} $version "" version
regsub {([0-9\.]*).*$} $version {\1} version
}
set tts(device_version) $version
echo "the DoubleTalk is version $version"
set tts(has_sine_tones) [expr $version+0 >= 4.20]
# echo "has_sine_tones=$tts(has_sine_tones)"
# DoubleTalk commands
set tts(charmode) "\0015C"
set tts(stop) "\030"
# FIXME what standard interword pause?
set tts(textmode) "\0015T"
set tts(textmode) "\0010T"
set tts(silencecmd) "\00116*"
set tts(resetcmd) "\001@"
set tts(somepunct) "\0015B"
set tts(mark) "\00176I"
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) "\0010O"
set tts(henry) "\0011O"
set tts(dennis) "\0012O"
set tts(frank) "\0013O"
set tts(betty) "\0014O"
set tts(ursula) "\0010O\00175P"
set tts(rita) "\0011O\00175P"
set tts(wendy) "\0012O\00175P"
set tts(kit) "\0013O\00175P"
set tts(version) [format "doubletalk with ROM version %s, doubletalk server from emacspeak-ss version 1.7" $tts(device_version) ]
set tts(initstring) "\001@\
\0010T\
\0010Y\
\0015B\
\0015S\
This is the DoubleTalk speech server for Emacspeak.\
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"
}
# }}} end of DoubleTalk - 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
}
# }}}
# {{{ 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_speak {text} {
q $text
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}} {
}
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 ""
}
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
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
}
# 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(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/synth.* $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(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) file0
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) 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 $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:
# }}}
More information about the Speakup
mailing list