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