# $Id: dtk-mv,v 6.0 1997/05/01 18:06:27 raman Exp $
# $Author: raman $ 
# Description:  Interfacing to a Dectalk via TCL. 
# Keywords: Emacspeak, Dectalk, TCL
# {{{ LCD Entry: 

# LCD Archive Entry:
# emacspeak| T. V. Raman |raman@crl.dec.com 
# A speech interface to Emacs |
# $date: $ |
#  $Revision: 6.0 $ | 
# Location undetermined
#

# }}}
# {{{ Copyright:  

# 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.

# }}}
# {{{ procedures  

proc dectalk_set_punctuations {mode} {
    global dectalk_globals
    puts $dectalk_globals(write) " "
    set dectalk_globals(punctuations) $mode 
    if {[string match $mode all]} {
    set dectalk_globals(space_special_chars) 1
    } else {
    set dectalk_globals(space_special_chars) 0
    }
}

proc dectalk_set_speech_rate {rate} {
    global dectalk_globals
    puts $dectalk_globals(write) "\[:ra$rate]\013"
    set dectalk_globals(speech_rate) $rate
    set factor $dectalk_globals(char_factor) 
        set dectalk_globals(say_rate) [round \
                                   [expr $rate  * $factor ]]
}

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

proc dectalk_say {text} {
    global dectalk_globals
    if {$dectalk_globals(talking?) } {
set dectalk_globals(talking?) 0 
        }
set mode $dectalk_globals(punctuations) 
    #set r $dectalk_globals(speech_rate)
    #set f  $dectalk_globals(say_rate) 
    puts $dectalk_globals(write)\
"$text\013"
}

proc l {text} {
    global dectalk_globals
    if {$dectalk_globals(talking?) } {
set dectalk_globals(talking?) 0 
        }
    set r $dectalk_globals(speech_rate)
    set f  $dectalk_globals(say_rate)
if {[regexp {[A-Z]} $text]} {
set text [concat  "cap " $text]
}
    puts $dectalk_globals(write)\
"\[:ra $f ]$text\[:ra $r ]\013"
}


proc dectalk_speak {text} {
    global dectalk_globals
    if {$dectalk_globals(talking?) } {
        q $text
         } else {
        q $text
            speech_task
        }
}

proc dectalk_resume  {} {
    global dectalk_globals 
    puts     $dectalk_globals(write) "\[:resume \]\013"
    speech_task
}


proc dectalk_pause {} {
    global dectalk_globals 
    puts     $dectalk_globals(write) "\[:pause \]\013"
    set dectalk_globals(talking?) 0 
}

proc s {} {
    global dectalk_globals
    queue_clear
    puts $dectalk_globals(write)  "\033P0;10;z\033\\\013"
    set dectalk_globals(talking?) 0
}

proc t  {{pitch 440} {duration 50}} {
    global dectalk_globals 
#not implemented 
}

proc dectalk_synchronize {} {
    global dectalk_globals 
    q   " " 
}

proc dectalk_split_caps {flag} {
    global dectalk_globals 
    set dectalk_globals(split_caps) $flag
}

proc dectalk_capitalize {flag} {
    global dectalk_globals 
    set dectalk_globals(capitalize) $flag
}

proc dectalk_space_special_chars  {flag} {
    global dectalk_globals 
    set dectalk_globals(space_special_chars) $flag
}

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

proc dectalk_get_acknowledgement {} {
    global dectalk_globals 
    set retval " "
    set status [select [list   $dectalk_globals(read) stdin ] {} {} {}]
    if {[lsearch $status stdin]   >=0} {
        set dectalk_globals(talking?) 0
    } else {
    while {[read_pending_p  $dectalk_globals(read) ] } {
        append retval [read $dectalk_globals(read)  1]
            select [list   $dectalk_globals(read)] {} {} 0.001
    }
}
    return $retval
}

#Gobble up any garbage the Dectalk has returned.

proc dectalk_gobble_acknowledgements {} {
    global dectalk_globals
    while {[read_pending_p  $dectalk_globals(read) ] } {read $dectalk_globals(read)  1}
}

#is a no-op
proc dectalk_reset {} {
global  dectalk_globals
puts $dectalk_globals(write) {]][_.] [:np]Restored sanity to the MultiVoice. }
}

# }}}
# {{{ speech task 

proc speech_task {} {
    global queue dectalk_globals
    set index 1
    set dectalk_globals(talking?) 1
dectalk_gobble_acknowledgements
    while {$dectalk_globals(talking?) } { 
        if {![queue_empty?]} {
            puts $dectalk_globals(write) \
                "[queue_remove]\033P0;21;1z\033\\\013"
            dectalk_get_acknowledgement 
            incr index
            set status [select [list  file0]  {} {} 0]
            if {[lsearch $status file0]   >=0} {
                set dectalk_globals(talking?) 0 
                break;
            }
    }  else {
        set dectalk_globals(talking?) 0
}
}
}

# }}}
# {{{ queue:

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

proc queue_clear {} {
    global dectalk_globals queue
    unset queue
    set queue(-1) " " 
    set dectalk_globals(q_head) 0
    set dectalk_globals(q_tail) 0 
}

proc q {element} {
    global queue dectalk_globals
    if {$dectalk_globals(split_caps) } {
        regsub -all {([^ -_A-Z])([A-Z][a-zA-Z]* )} $element\
            {\1[_<1>]\2[,] } element
    regsub -all {([^ -_A-Z])([A-Z])} $element\
        {\1[_<1>]\2} element
    }
            if {$dectalk_globals(space_special_chars) } {
                regsub -all --  {--} $element { [_,]} element 
                regsub -all  {([-@\#%^&*<>/$!.,_()|;"`~'+=])}  \
                    $element { \1  }  element
    }
    if { [string match some  $dectalk_globals(punctuations)] } {
regsub -all --  {--} $element { [_,]} element
}
    set queue($dectalk_globals(q_tail)) $element
    incr dectalk_globals(q_tail)
if {[expr $dectalk_globals(q_tail) - $dectalk_globals(q_head)] >= 5} {
    speech_task
}
}

proc queue_remove {} {
    global dectalk_globals queue 
    if {![queue_empty? ]} {
        set element  $queue($dectalk_globals(q_head))
        unset queue($dectalk_globals(q_head))
        incr dectalk_globals(q_head)
        return $element
    }
}

# }}}
# {{{ globals

set machine Linux 
 catch {set machine [exec uname ]}
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 
    }
^SunOS.*5\.[0-9].*   {
        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]
        set machine solaris
        #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 sunos
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 > $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:
 exec stty sane 9600 raw  -echo < $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) linebuf 1


#split caps flag: 
set dectalk_globals(split_caps) 1
# Capitalize flag
set dectalk_globals(capitalize)  0
#space around special chars:
set dectalk_globals(space_special_chars) 1 
set dectalk_globals(talking?) 0
set dectalk_globals(speech_rate) 325 
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(punctuations) some
set queue(-1) " " 

# }}}
# {{{ Initialize and set state.
#Ignore sigint
signal ignore {sigint}
# gobble up garbage that is returned on powerup 
dectalk_gobble_acknowledgements

puts    $dectalk_globals(write)  {
    
    [:np :ra 180]
Using a Multivoice or older Dectalk. 
[zhax<15> p'arl],
    [/dh`ow<100,140> ],  [:np] [  zhax<13>  suw<45>\iy<140,100>]. 
}


#Start the main command loop:
commandloop

# }}}
# {{{ Emacs local variables  

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

# }}}
