Converted keyer-control to the Tcl version, started the keyer_decode …

…replacement in Tcl.

bin/keyer-control

@@ -4,20 +4,23 @@
 lappend auto_path [file join [file dirname [info script]] .. lib]
 
 package require Tk
+package require keyer
+package require sdrkit
 
 ##
 ## parameters and operating data
 ##
 array set data {
     ascii 1
     iambic 1
-
 
+    #ascii_tone-verbose 5
     ascii_tone-freq 700
     ascii_tone-gain -30
     ascii_tone-rise 5
     ascii_tone-fall 5
 
+    #ascii-verbose 5
     ascii-wpm 15
     ascii-word 50
     ascii-dah 3
@@ -28,11 +31,13 @@ array set data {
     ascii-chan 1
     ascii-note 0
 
+    #iambic_tone-verbose 5
     iambic_tone-freq 750
     iambic_tone-gain -30
     iambic_tone-rise 5
     iambic_tone-fall 5
 
+    iambic-verbose 5
     iambic-wpm 15
     iambic-word 50
     iambic-dah 3
@@ -53,44 +58,32 @@ array set data {
 ##
 proc plug-exists {client} {
     global plug
-    return [info exists plug($client-fp)]
+    return [info exists plug($client)]
 }
 
-proc plug-open {program client {server default}} {
+proc plug-open {command client {server default}} {
     global plug
     global data
-    set bindir [file dirname [info script]]
-    set plug($client-binary) [file join $bindir $program]
-    # test for file exists
-    set plug($client-out-file) "/tmp/keyer-control-[pid]-$client.out"
-    set args [list |$plug($client-binary) --server $server --client $client]
+    set args {}
     foreach name [array names data $client-*] {
 	set val $data($name)
 	set name [string range $name [expr {1+[string length $client]}] end]
-	lappend args "--$name" $val
+	lappend args "-$name" $val
     }
-    lappend args {>&} $plug($client-out-file)
-    set command [join $args]
-    set plug($client-fp) [open $command w]
-    fconfigure $plug($client-fp) -buffering line
-    set plug($client-out-fp) [open "$plug($client-out-file)" r]
-    fconfigure $plug($client-out-fp) -blocking 0 -buffering line
-    # fileevent $plug($client-out-fp) readable "plug-readable $client"
+    eval [concat [list $command $client -server $server] $args]
+    set plug($client) $client
     lappend plug(clients) $client
 }
 
 proc plug-close {client} {
     global plug
     if {[plug-exists $client]} {
-	#puts stderr "plug-close $client"
-	close $plug($client-fp)
-	close $plug($client-out-fp)
-	file delete $plug($client-out-file)
 	foreach name [array names plug $client-*] {
 	    unset plug($name)
 	}
 	set i [lsearch -exact $plug(clients) $client]
 	set plug(clients) [lreplace $plug(clients) $i $i]
+	rename $plug(client) {}
     } else {
 	puts stderr "non-existent client $client in plug-close"
     }
@@ -106,7 +99,9 @@ proc plug-close-all {} {
 proc plug-puts {client opt value} {
     global plug
     if {[plug-exists $client]} {
-	puts $plug($client-fp) "<$opt$value>"
+	#puts "$plug($client) config -$opt $value"
+	$plug($client) config -$opt $value
+	#puts "$plug($client) cget -$opt -> [$plug($client) cget -$opt]"
     } else {
 	puts stderr "non-existent client $client in plug-puts"
     }
@@ -115,28 +110,15 @@ proc plug-puts {client opt value} {
 proc plug-puts-text {client text} {
     global plug
     if {[plug-exists $client]} {
-	puts $plug($client-fp) $text
+	$plug($client) puts $text
     } else {
 	puts stderr "non-existent client $client in plug-puts-text"
     }
 }
 
-proc plug-readable {client} {
-    global plug
-    # puts "plug-readable $client"
-    if {[gets $plug($client-out-fp) line] < 0} {
-	if {[eof $plug($client-out-fp)]} {
-	    # don't close, they're files that will grow
-	    # plug-close $client
-	}
-	return;
-    }
-    lappend plug($client-input) $line
-}
-
 proc plug-read {client} {
     global plug
-    return [read $plug($client-out-fp)]
+    return [$plug($client) gets]
 }
 
 #
@@ -146,45 +128,56 @@ proc plug-init {} {
     global data
     # start jack
     # look for zombie helpers?
-    foreach line [split [string trim [exec jack_lsp]] \n] {
-	switch -glob $line {
-	    ascii:* -
-	    iambic:* -
-	    ascii_tone:* -
-	    iambic_tone:* {
-		error "the [lindex [split $line :] 0] client is still running"
+    set ports [sdrkit::jack list-ports]
+    foreach port [dict keys $ports] {
+	foreach conn [dict get $ports $port connections] {
+	    switch -glob $line {
+		ascii:* -
+		iambic:* -
+		ascii_tone:* -
+		iambic_tone:* {
+		    error "the [lindex [split $line :] 0] client is still running"
+		}
+	    }
+	}
+	switch -glob $port {
+	    system:midi_capture_* {
+		set midi_capture $port
 	    }
 	}
     }
     # make helpers
     set connects {}
     if {$data(ascii)} {
-	plug-open keyer_ascii ascii
-	plug-open keyer_tone ascii_tone
-	lappend connects {jack_connect ascii:midi_out ascii_tone:midi_in}
-	lappend connects {jack_connect ascii_tone:out_i system:playback_1}
-	lappend connects {jack_connect ascii_tone:out_q system:playback_2}
+	plug-open keyer::ascii ascii
+	plug-open keyer::tone ascii_tone
+	lappend connects {sdrkit::jack connect ascii:midi_out ascii_tone:midi_in}
+	lappend connects {sdrkit::jack connect ascii_tone:out_i system:playback_1}
+	lappend connects {sdrkit::jack connect ascii_tone:out_q system:playback_2}
     }
     if {$data(iambic)} {
-	plug-open keyer_iambic iambic
-	# plug-open keyer_iambic2 iambic
-	plug-open keyer_tone iambic_tone
-	lappend connects {jack_connect system:midi_capture_1 iambic:midi_in}
-	lappend connects {jack_connect iambic:midi_out iambic_tone:midi_in}
-	lappend connects {jack_connect iambic_tone:out_i system:playback_1}
-	lappend connects {jack_connect iambic_tone:out_q system:playback_2}
+	if { ! [info exists midi_capture]} {
+	    error "no midi_capture port for keyer connection"
+	}
+	# plug-open keyer::iambic iambic
+	plug-open keyer::iambic iambic
+	plug-open keyer::tone iambic_tone
+	lappend connects [list sdrkit::jack connect $midi_capture iambic:midi_in]
+	lappend connects {sdrkit::jack connect iambic:midi_out iambic_tone:midi_in}
+	lappend connects {sdrkit::jack connect iambic_tone:out_i system:playback_1}
+	lappend connects {sdrkit::jack connect iambic_tone:out_q system:playback_2}
     }
     # these names may need to change around
     after 500
     set retry {}
     foreach cmd $connects {
-	if {[catch "exec $cmd" error]} {
+	if {[catch "eval $cmd" error]} {
 	    puts "$cmd: yielded $error"
 	    lappend retry $cmd
 	}
     }
     foreach cmd $retry {
-	if {[catch "exec $cmd" error]} {
+	if {[catch "eval $cmd" error]} {
 	    puts "$cmd: failed again, yielded $error"
 	}
     }
@@ -388,6 +381,7 @@ proc main {argv} {
 	    --ascii-freq { set data(ascii_tone-freq) $value }
 	    --ascii-gain { set data(ascii_tone-gain) $value }
 	    --iambic { set data(iambic) $value }
+	    --iambicpp { set data(iambicpp) $value }
 	    --iambic-wpm { set data(iambic-wpm) $value }
 	    --iambic-freq { set data(iambic_tone-freq) $value }
 	    --iambic-gain { set data(iambic_tone-gain) $value }

bin/keyer_decode2

@@ -0,0 +1,37 @@
+#!/usr/bin/tclsh
+# -*- mode: Tcl; tab-width: 8; -*-
+
+lappend auto_path [file join [file dirname [info script]] .. lib]
+
+package require keyer
+
+array set data {
+    -server default
+    -client decode
+    -chan 1
+    -note 0
+}
+
+foreach {option value} $argv {
+    switch -- $option {
+	--server -
+	--client -
+	--chan -
+	--note {
+	    set data([string range $option 1 end]) $value
+	}
+	default {
+	    error "unrecognized option: $option"
+	}
+    }
+}
+
+keyer::decode decode {*}[array get data]
+
+fconfigure stdout -buffering none
+while {1} {
+    set line [decode gets]
+    if {[string length $line]} {
+	puts -nonewline $line
+    }
+}

keyers/Makefile

@@ -11,8 +11,8 @@ LIBUSB_LIBS=$(shell pkg-config --libs libusb-1.0)
 
 LIBDIR=../lib/keyers
 
-ALL=../bin/keyer_tone ../bin/keyer_ascii ../bin/keyer_iambic ../bin/keyer_decode ../bin/keyer_iambicpp
-ALL2=$(LIBDIR)/keyer_tone.so $(LIBDIR)/keyer_ascii.so $(LIBDIR)/keyer_iambic.so $(LIBDIR)/keyer_decode.so $(LIBDIR)/keyer_iambicpp.so
+ALL=../bin/keyer_tone ../bin/keyer_ascii ../bin/keyer_iambic ../bin/keyer_decode
+ALL2=$(LIBDIR)/keyer_tone.so $(LIBDIR)/keyer_ascii.so $(LIBDIR)/keyer_iambic.so $(LIBDIR)/keyer_decode.so
 
 all:: $(ALL) $(ALL2)
 	cd $(LIBDIR) && make all
@@ -35,31 +35,23 @@ clean::
 	mkdir -p ../bin
 	cc -o ../bin/keyer_ascii $(CFLAGS) -DAS_BIN keyer_ascii.c $(JACK_LIBS) -lm
 
-../bin/keyer_iambic: keyer_iambic.c framework.h options.h timing.h midi.h
+../bin/keyer_iambic: keyer_iambic.cc framework.h options.h timing.h midi.h
 	mkdir -p ../bin
-	cc -o ../bin/keyer_iambic $(CFLAGS) -DAS_BIN keyer_iambic.c $(JACK_LIBS) -lm
-
-../bin/keyer_iambicpp: keyer_iambicpp.cc Iambic.hh framework.h options.h timing.h midi.h
-	mkdir -p ../bin
-	g++ -o ../bin/keyer_iambicpp $(CPPFLAGS) -DAS_BIN keyer_iambicpp.cc $(JACK_LIBS) -lm
+	g++ -o ../bin/keyer_iambic $(CPPFLAGS) -DAS_BIN keyer_iambic.cc $(JACK_LIBS) -lm
 
 $(LIBDIR)/keyer_tone.so: keyer_tone.c framework.h options.h timing.h
 	mkdir -p $(LIBDIR)
 	cc -o $(LIBDIR)/keyer_tone.so -shared -fPIC -DAS_TCL $(CFLAGS) keyer_tone.c $(JACK_LIBS) $(LIBS) -lm
 
-$(LIBDIR)/keyer_decode.so: keyer_decode.c framework.h options.h
+$(LIBDIR)/keyer_decode.so: keyer_decode.c framework.h options.h ring_buffer.h
 	mkdir -p $(LIBDIR)
 	cc -o $(LIBDIR)/keyer_decode.so $(CFLAGS) -shared -fPIC -DAS_TCL keyer_decode.c  $(JACK_LIBS) $(LIBS) -lm
 
 $(LIBDIR)/keyer_ascii.so: keyer_ascii.c framework.h options.h timing.h midi.h
 	mkdir -p $(LIBDIR)
 	cc -o $(LIBDIR)/keyer_ascii.so $(CFLAGS) -shared -fPIC -DAS_TCL keyer_ascii.c $(JACK_LIBS) $(LIBS) -lm
 
-$(LIBDIR)/keyer_iambic.so: keyer_iambic.c framework.h options.h timing.h midi.h
-	mkdir -p $(LIBDIR)
-	cc -o $(LIBDIR)/keyer_iambic.so $(CFLAGS) -shared -fPIC -DAS_TCL keyer_iambic.c $(JACK_LIBS) $(LIBS) -lm
-
-$(LIBDIR)/keyer_iambicpp.so: keyer_iambicpp.cc Iambic.hh framework.h options.h timing.h midi.h
+$(LIBDIR)/keyer_iambic.so: keyer_iambic.cc framework.h options.h timing.h midi.h
 	mkdir -p $(LIBDIR)
-	g++ -o $(LIBDIR)/keyer_iambicpp.so $(CPPFLAGS) -shared -fPIC -DAS_TCL keyer_iambicpp.cc $(JACK_LIBS) $(LIBS) -lm
+	g++ -o $(LIBDIR)/keyer_iambic.so $(CPPFLAGS) -shared -fPIC -DAS_TCL keyer_iambic.cc $(JACK_LIBS) $(LIBS) -lm
 

keyers/keyer_decode.c

@@ -23,6 +23,7 @@
 #include "framework.h"
 #include "options.h"
 #include "midi.h"
+#include "ring_buffer.h"
 
 typedef struct {
   unsigned last_frame;	/* frame of last event */
@@ -38,7 +39,10 @@ typedef struct {
   framework_t fw;
   decode_t decode;
   unsigned frame;
-  /* Tcl needs a ring buffer to store decoded elements */
+  #define _SIZE 512
+  unsigned rptr;
+  unsigned wptr;
+  char buff[_SIZE];
 } _t;
 
 /*
@@ -128,7 +132,12 @@ static void _decode(_t *dp, unsigned count, unsigned char *p) {
       fprintf(stdout, "%s", out); fflush(stdout);
 #endif
 #if AS_TCL
-
+      if (buffer_writeable(dp->wptr, dp->rptr, _SIZE)) {
+	if (*out != 0)
+	  dp->buff[buffer_index(dp->wptr++, _SIZE)] = *out;
+      } else {
+	fprintf(stderr, "keyer_decode: buffer overflow writing \"%s\"\n", out);
+      }
 #endif
     } else if (dp->fw.opts.verbose > 3)
       fprintf(stderr, "discarded midi chan=0x%x note=0x%x != mychan=0x%x mynote=0x%x\n", channel, note, dp->fw.opts.chan, dp->fw.opts.note);
@@ -193,6 +202,14 @@ int main(int narg, char **args) {
 static int _command(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
   if (argc == 2 && strcmp(Tcl_GetString(objv[1]), "gets") == 0) {
     // return the current decoded string
+    _t *dp = (_t *)clientData;
+    unsigned n = buffer_items_available_to_read(dp->wptr, dp->rptr, _SIZE);
+    char buff[512];
+    if (n > 512)
+      n = 512;
+    for (int i = 0; i < n; i += 1)
+      buff[i] = dp->buff[buffer_index(dp->rptr++, _SIZE)];
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(buff, n));
     return TCL_OK;
   }
   if (framework_command(clientData, interp, argc, objv) != TCL_OK)