1#!/bin/sh 2# the next line restarts using wish \ 3exec wish8.4 "$0" "$@" 4 5package require -exact snack 2.2 6 7snack::sound s 8 9set last 0 10set server localhost:23654 11 12proc Start {} { 13 global sock server 14 15 s record 16 17 # Open binary socket connection to aserver.tcl 18 19 foreach {host port} [split $server :] break 20 set sock [socket $host $port] 21 fconfigure $sock -translation binary 22 if {$::tcl_version > 8.0} { 23 fconfigure $sock -encoding binary 24 } 25 26 # Notify audio server that a play operation is due 27 28 puts -nonewline $sock play 29 30 # Send an AU file header to open the device correctly 31 32 puts -nonewline $sock [s data -fileformat au] 33 34 # Run SendData procedure in 200ms 35 36 after 200 SendData 37} 38 39proc Stop {} { 40 s stop 41} 42 43proc SendData {} { 44 global last sock 45 46 # There is new sound data to send 47 48 if {[s length] > $last} { 49 50 # Send audio data chunk in AU file format, "bigEndian" 51 52 puts -nonewline $sock [s data -start $last -end -1 -fileformat raw\ 53 -byteorder bigEndian] 54 } 55 set last [s length] 56 .l config -text Length:[s length] 57 58 # User hit stop button, close down 59 60 if ![snack::audio active] { 61 set last 0 62 close $sock 63 return 64 } 65 after 300 SendData 66} 67 68pack [label .l -text "Length: 0"] 69 70pack [frame .f1] 71pack [label .f1.l -text "Server:"] -side left 72pack [entry .f1.e -textvar server] -side left 73 74pack [frame .f2] 75pack [button .f2.a -bitmap snackRecord -command Start -wi 40 -he 20 -fg red] \ 76 -side left 77pack [button .f2.b -bitmap snackStop -command Stop -wi 40 -he 20] -side left 78pack [button .f2.c -bitmap snackPlay -command {s play} -wi 40 -he 20] \ 79 -side left 80pack [button .f2.d -text Exit -command exit] -side left 81