home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #4 / Amiga Plus CD - 2000 - No. 4.iso / Tools / WWW / SpeakFreely / CONTRIB / tkshell < prev    next >
Encoding:
Internet Message Format  |  2000-05-27  |  4.2 KB
  1. From mark%mailhost@leav-156-100.army.mil Fri Nov 17 15:25:54 1995
  2. Return-Path: <mark%mailhost@leav-156-100.army.mil>
  3. Date: Fri, 17 Nov 1995 08:24:35 -0600
  4. From: mark%mailhost@leav-156-100.army.mil (Mark B. Hamby)
  5. Subject: Speak Freely Tcl/Tk Interface
  6.  
  7. John,
  8.  
  9. I have tried several other Internet voice packages for Unix 
  10. and yours is by great.  I have written a quick Tcl/Tk GUI 
  11. interace for it, though I know you are probably working
  12. on a full interface yourself.  This one is kind of kludgy,
  13. but it works.  It requires Tcl, Tk, and Tix extensions.
  14. The Tix extensions could be removed in about 20 minutes.
  15. Of course the entire script only took a couple of hours.
  16. And that long because I am new to Tcl/Tk. :)
  17.  
  18. Later,
  19.  
  20. Mark Hamby
  21. RDA Logicon
  22. mhamby@logicon.com
  23.  
  24. -----------------------------------------------------------
  25. #! /bin/sh 
  26. # \
  27.         tixwish "$0" "$*"   # \
  28.         exit
  29.  
  30. proc Quit {} {
  31.         global Speaker
  32.  
  33.         catch {set proc [pid $Speaker]}
  34.         catch {exec kill $proc}
  35.         catch {close $Speaker}
  36.         Hangup
  37.         exit
  38. }
  39.  
  40. proc Dial {} {
  41.         global Host Switchhook Talkbtn Mike
  42.  
  43.         if {[string length $Host] == 0 } {
  44.                 ShowStatus "ERROR: Please enter a hostname."
  45.                 return
  46.         }
  47.         $Switchhook config -text "Hangup" -command Hangup \
  48.                 -background red2 -activebackground red1
  49.         Mute
  50.         $Talkbtn config -state normal
  51.  
  52.         set Mike [open "| sfmike -b -t -n -s60 $Host" "r+"]
  53.         fileevent $Mike readable ShowMike
  54. }
  55.  
  56. proc Hangup {} {
  57.         global Switchhook Talkbtn Mike
  58.  
  59.         catch {puts -nonewline $Mike "q"}
  60.         catch {flush $Mike}
  61.         catch {close $Mike}
  62.  
  63.         $Switchhook config -text "Dial" -command Dial \
  64.                 -background grey85 -activebackground grey90
  65.         $Talkbtn config -text "Disconnected" -state disabled \
  66.                 -background grey85 -activebackground grey90
  67. }
  68.  
  69.  
  70. proc Talk {} {
  71.         global Talkbtn Mike
  72.  
  73.         $Talkbtn config -text "Press To Mute" -command Mute \
  74.                 -background SpringGreen3 -activebackground SpringGreen2
  75.         ShowStatus "Microphone is ON."
  76.         puts -nonewline $Mike " "
  77.         flush $Mike
  78. }
  79.  
  80. proc Mute {} {
  81.         global Talkbtn Mike
  82.  
  83.         $Talkbtn config -text "Press To Talk" -command Talk \
  84.                 -background gold2 -activebackground gold1
  85.         ShowStatus "Microphone is OFF."
  86.         catch {puts -nonewline $Mike " "}
  87.         catch {flush $Mike}
  88. }
  89.  
  90. proc ShowSpeaker {} {
  91.         global Speaker
  92.  
  93.         if [eof $Speaker] {
  94.                 catch {close $Speaker}
  95.                 set line "ERROR: Speaker process has crashed."
  96.         } else {
  97.            gets $Speaker line
  98.         }
  99.         ShowStatus $line
  100. }
  101.  
  102. proc ShowMike {} {
  103.         global Mike
  104.  
  105.         if [eof $Mike] {
  106.                 set line "ERROR: Invalid hostname."
  107.                 Hangup
  108.         } else {
  109.            gets $Mike line
  110.         }
  111.         ShowStatus $line
  112. }
  113.  
  114.  
  115. proc ShowStatus { args } {
  116.         global Status
  117.  
  118.         $Status subwidget listbox insert end [join $args]\n
  119.         $Status subwidget listbox see end
  120. }
  121.  
  122. # Set window title.
  123. wm title . "Speak Freely"
  124.  
  125. # Create a frame for buttons and entry.
  126. tixButtonBox .bar -padx 10 -pady 10
  127. pack .bar -side top -fill x
  128.  
  129. set Switchhook [button .bar.switchhook -text Dial -command Dial -width 8]
  130. pack $Switchhook -side left
  131.  
  132. tixLabelEntry .bar.host -label "Host:"
  133. .bar.host subwidget entry config -width 10 -textvariable Host
  134. pack .bar.host -side left -fill x -expand true
  135.  
  136. # Create command buttons.
  137. button .bar.quit -text Quit -command Quit
  138. pack .bar.quit -side right
  139.  
  140. button .bar.controls -text "Controls" -command {exec audiocontrol &}
  141. pack .bar.controls -side right
  142.  
  143. set Status .status
  144. tixScrolledListBox $Status -height 100 -width 300
  145. $Status subwidget listbox config -setgrid true -takefocus false
  146. pack $Status -side top -fill both -expand true
  147.  
  148. tixButtonBox .bottom
  149. pack .bottom -side bottom -fill x
  150.  
  151. set Talkbtn .bottom.talk
  152. button $Talkbtn -text "Disconnected" -state disabled
  153. pack $Talkbtn -side bottom -fill x -expand true
  154.  
  155. ShowStatus "Enabling speaker..." 
  156. set Speaker [open "| sfspeaker -v |& cat" "r+"]
  157. fileevent $Speaker readable ShowSpeaker
  158.  
  159. ---------------------------------------------------------------
  160.