#!/usr/bin/tclsh
# Keywords: Emacspeak, eSpeak , TCL
#{{{ LCD Entry: 

# LCD Archive Entry:
# emacspeak| T. V. Raman |raman@cs.cornell.edu
# A speech interface to Emacs |
# $Date: 2006-08-11 21:11:17 +0200 (ven, 11 aoû 2006) $ |
#  $Revision: 4047 $ | 
# Location https://github.com/tvraman/emacspeak
#

#}}}
#{{{ Copyright:  
#Copyright (C) 1995 -- 2024, T. V. Raman 
#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, 51 Franklin Street, Fifth Floor, Boston,MA 02110-1301, USA.

#}}}
#{{{source common code 

package require Tclx
set wd [file dirname $argv0]
source $wd/tts-lib.tcl

#}}}

#{{{ procedures  

# Language switching
#
# langsynth: current and max index into table of synth languages.

# langsynth(current): current synthesis language, 
# Gives the code of the current synth language.
# This variable is set by the application
# For example: langsynth(current)=3
# means finnish is the current language

# langsynth(top): max available index.
# For example, if there are three available languages: 
# langsynth(top)=2

# voicename: currently selected voice for a synth language
# voicename(current) is the currently selected voice

# langcode: language identifier
# e.g. langcode(0)="fi"
# This variable is set by tclespeak

# langalias converts a code language ("en", "en_GB",...) to its index in the language table.
# e.g. langalias(fi)=3 could mean "fi_FI" will be used if "fi" is required. 

set langsynth(current) 0
set langsynth(top) 0
set langcode(0) "en-us"
set langcode(current) "en-us"
set voicename(0) "en-us"
set voicename(current) "en-us"

set mswindows [expr { $tcl_platform(platform) == "windows" } ]

# select the next synth language
proc set_next_lang {say_it} {
    global langsynth
    global langalias
    global voicename
    global langcode

    set index 0
    while { $index <= $langsynth(top) } {
        if { $index == $langsynth(current) } {
            break
        }
        incr index
    }

    if { $index >= $langsynth(top) } {
        set index 0
    } else {
        incr index
    }

    set langsynth(current) $index
    set langcode(current) $langcode($index)
    set voicename(current) $voicename($index)

    setLanguage $langsynth(current) $voicename(current)
    puts stderr "Language: $langsynth(current) Voice: $voicename(current)"
    if {[info exists say_it]} {
        tts_say "$voicename(current) "
    }
}

# select the previous synth language
proc set_previous_lang {say_it} {
    global langsynth
    global langalias
    global voicename
    global langcode

    set index 0
    while { $index <= $langsynth(top) } {
        if { $index == $langsynth(current) } {
            break
        }
        incr index
    }

    if { $index <= 0 } {
        set index $langsynth(top)
    } else {
        incr index -1
    }

    set langsynth(current) $index
    set langcode(current) $langcode($index)
    set voicename(current) $voicename($index)
    setLanguage $langsynth(current) $voicename(current)
    puts stderr "Language: $langsynth(current) Voice: $voicename(current)"
    if {[info exists say_it]} {
        tts_say "$voicename(current) "
    }
}

# select a new synth language
# set_lang "en"
# Or select a voice with
# set_lang "en:whisper"
# Or keep the current language and just change the voice with
# set_lang ":whisper"
proc set_lang {{nameAndVoice "en"} {say_it "nil"}} {
    global langsynth
    global langalias
    global langcode
    global voicename
    global voiceVariants

    set voiceStart [string first : $nameAndVoice]
    if { $voiceStart == -1 } {
        set name $nameAndVoice
        if { ![info exists langalias($name)] } {
            return
        }
        set voice $voicename($langalias($name))
    } elseif { $voiceStart == 0 } {
        set name $langcode($langsynth(current))
        set voice [string range $nameAndVoice 1 end]
    } else {
        set name [string range $nameAndVoice 0 [expr {$voiceStart - 1}]]
        set voice [string range $nameAndVoice [expr {$voiceStart + 1}] end]
    }

     if { ![info exists langalias($name)]} {
         return
     }

    if { [info exists voiceVariants($voice)] } {
        set voice $name+$voice
    }

    if { [string first mb- $voice] != -1} {
        tts_say "Not enabling MBROLA voice since they cause server hangs"
        set $voice $voicename($langalias($name))
    }

    if { $langalias($name) == $langsynth(current) && $voice == $voicename(current)} {
        return
     }

    set langsynth(current) $langalias($name)
    set langcode(current) $langcode($langalias($name))
    set voicename($langalias($name)) $voice
    set voicename(current) $voicename($langalias($name))
    setLanguage $langsynth(current) $voicename(current)

    if { $say_it == "t"} {
        tts_say "$voicename(current)"
    }
}

# set_preferred_lang "en" "en_GB"
proc set_preferred_lang {alias lang} {
    global langsynth
    global langalias

    if { ![info exists langalias($lang)]} {
        return
    }
    set langalias($alias) $langalias($lang)
}

#debug
proc list_lang {} {
    global langcode
    echo [ array get langcode ]
}

proc list_langalias {} {
    global langalias
    echo [ array get langalias ]
}

proc list_voicename {} {
    global voicename
    echo [ array get voicename ]
}

proc version {} {
    q " eSpeak [ttsVersion]"
    d
}

proc tts_set_punctuations {mode} {
    global tts

    set tts(punctuations) $mode
    punct $mode
    service
    return ""
}

proc tts_set_speech_rate {rate} {
    global tts

    set factor $tts(char_factor)
    set tts(speech_rate) $rate
    setRate 0 $rate
    service
    return ""
}

proc tts_set_character_scale {factor} {
    global tts

    set tts(say_rate) [round \
                           [expr $tts(speech_rate) * $factor ]]
    set tts(char_factor) $factor
    service
    return ""
}

proc tts_say {text} {
    global    tts
    global langcode

    service 
    set la $langcode(current)

    set prefix ""
    regsub -all {\[\*\]} $text { } text
    synth "${prefix}${text}"
    service
    return ""
}

proc l {text} {
    global tts
    global langcode

    set la $langcode(current)
    set prefix "<voice xml:lang=\"$la\">"
    if {[regexp  {[A-Z]} $text]} {
        # Use a relative pitch adjustment.  +70% seems goodafter some testing.
        set prefix "$prefix <prosody pitch=\"+70%\">"
    }
    # TBD: say-as, format attribute: instead of characters/glyphs, define "word"
    synth "$prefix <say-as interpret-as=\"characters\" format=\"characters\">$text"
    service
    return ""
}

proc d {} {
    service
    speech_task
}
proc s {} {
    global tts
    if {$tts(not_stopped) == 1} {
        set tts(not_stopped) 0
        stop
        queue_clear
        set tts(not_stopped) 1
    } else {
        puts stderr StopNoOp
    }
}



proc t  {{pitch 440} {duration 50}} {
    global tts queue
    if {$tts(beep)} {
        b $pitch $duration
        return ""
    }
    service
}

proc sh  {{duration 50}} {
    global tts queue


    set silence "<break time=\"$duration ms\"/>"
    set queue($tts(q_tail)) [list t $silence]
    incr tts(q_tail)
    service
    return ""
}

# Caps: this driver currently offers either
# - announcing each capitals (tts_split_caps)
# - or raising pitch (tts_capitalize)
# - or beeping (tts_allcaps_beep)
#
proc tts_split_caps {flag} {
    global tts
    set tts(split_caps) $flag
    service
    return ""
}
proc tts_reset {} {
    global tts
    #synth  -reset

    queue_clear
    synth "Resetting engine to factory defaults."
}

proc r {rate} {
    global queue  tts

    set queue($tts(q_tail)) [list r  $rate]
    incr tts(q_tail)
    return ""
}

proc useStereoOutput {} {
    global tts


    setOutput buffer
}

#}}}
#{{{ speech task 

proc trackIndex {index} {
    global tts

    set tts(last_index) $index
}

proc stdin_readable_handler {} {
  global stdin_is_readable
  global timer_or_stdin_breaks
  set stdin_is_readable 1
  set timer_or_stdin_breaks 1
}
if $mswindows { fileevent stdin readable stdin_readable_handler }

proc timer_handler {} {
  global timer_ticks
  global timer_or_stdin_breaks
  after 200 timer_handler
  set timer_ticks 1
  incr timer_or_stdin_breaks
}
if $mswindows { after 0 timer_handler }

proc service {} {
    global tts
    global stdin_is_readable # used only by mswindows

    set talking [speakingP]
    set stdin_is_readable 0
    while {$talking == 1} {
        if $::mswindows {
            # need to workaround lack of "select stdin" on windows
            # set status to 1 if input is available at stdin
            # if input is not available, timer will cause an exit from vwait
            set status -1
            vwait timer_or_stdin_breaks
            if { $stdin_is_readable > 0 } {
                set status 1
            }
        } else {
            set status   [lsearch [select [list  stdin]  {} {} 0.02] stdin]
        }

        if { $status >= 0} {
            set tts(talking?) 0
            set talking 0
            break
        } else {
            set talking [speakingP]
        }
    }
    return $talking
}

proc speech_task {} {
    global queue tts

    set tts(talking?) 1
    set length [queue_length]

    set prefix ""
    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]]
                synth "$prefix $text"
                set retval [service]
                set prefix ""
            }
            c {
                set text  [lindex $event 1]
                set prefix "$text"
                synth "$text"
                set retval ""
            }
            a {

                set sound [lindex $event 1]
                exec $tts(play) $sound >/dev/null   &
            }
            b {

                if {$tts(beep)} {
                    lvarpop event
                    eval beep $event
                }
            }
            r {
                # The first argument to setRate is ignored.
                setRate 0 [lindex  $event 1]
            }
        }
        if {$tts(talking?) == 0} {break;} 
    }


    set tts(talking?) 0
    service
    return ""
}

#}}}
#{{{clean 

#preprocess element before sending it out:
proc clean {element} {
    global queue tts 


# The text conversion is expected to be done by eSpeak.
# For example, the * symbol will be said according to the selected language.
#
# If relying on eSpeak is too optimitisc for text conversion, you may 
# perhaps propose to the eSpeak author a new feature.
#
    return $element
}

#}}}
#{{{ Initialize and set state.

#do not die if you see a control-c
signal ignore {sigint}

# Set input encoding to utf-8
fconfigure stdin -encoding utf-8

#initialize eSpeak
tts_initialize
set tts(speech_rate)  225
beep_initialize
set tts(input) stdin
if {[info exists server_p]} {
    set tts(input) sock0
}
set servers [file normalize [file dirname $argv0]]
set tclTTS $servers/native-espeak
load $tclTTS/tclespeak[info sharedlibextension]

# Get the list of voice variants available so you can call for en-us:whisper
# and not en-us:en-us+whisper
foreach variant [glob -nocomplain -tails -directory [ttsDataPath]/voices/!v *] {
    set voiceVariants($variant) {}
}
if {![info exists voiceVariants]} {
    array set voiceVariants {}
    puts stderr "Warning: no voice variants found under [ttsDataPath]"
}

synth "<voice>eSpeak  [ttsVersion]"
service

#Start the main command loop:

if $mswindows {
  # there is a bug on windows, interactive -on does not work
  # https://sourceforge.net/p/tclx/bugs/81/
  commandloop -interactive off
} else {
  commandloop
}

#}}}
#{{{ Emacs local variables

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

#}}}
