New show-thing IPC

[ypp-sc-tools.db-test.git] / pctb / show-thing.tcl

diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl
index 0b0b8f553616109d21da2d96a99f70bf33809a1f..be07d2d50fa3f0b5c063430a26826df94238ca87 100755 (executable)
--- a/pctb/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@ -26,7 +26,10 @@ set gotsh 20
 set csrh 20
 
 proc init_widgets {} {
+    # idempotent
     global csrh gotsh
+
+    if {[winfo exists .d]} return
     
     frame .d
 
@@ -176,6 +179,8 @@ proc startup_cursor {} {
     set cur_0 $unk_l
     set cur_1 [expr {$unk_r+1}]
     set last_ht {}
+
+    recursor
 }
 
 
@@ -240,7 +245,7 @@ proc recursor/text {} {
     pack .d.csr.csr.e -side left
     focus .d.csr.csr.e
     bind_key Return {
-       binary scan [.d.csr.csr.e get] h* hex
+       binary scan [.d.csr.csr.e get] H* hex
        if {[string length $hex]} {
            RETURN_RESULT DEFINE "$cur_0 $cur_1 $hex"
        }
@@ -343,7 +348,7 @@ proc write_database {} {
     set ol {}
     foreach bm [array names database] {
        set strh $database($bm)
-       set strs [binary format h* $strh]
+       set strs [binary format H* $strh]
        set strdo [format "%d %s" [expr {[string length $strh]/2}] $strh]
        set o "[lindex $bm 0] $strdo\n"
        append o [format "%d\n" [expr {[llength $bm]-1}]]
@@ -396,18 +401,20 @@ proc update_database/DELETE {l r ctx} {
     
 
 proc RETURN_RESULT {how what} {
+    global mainkind
     place forget .d.csr.csr
     pack forget .d.csr.csr.e
     helptext {{{ Processing }}}
     unbind_all_keys
     update idletasks
-    puts "$how $what"
+    puts stderr "$how $what"
     eval update_database/$how $what
+    done/$mainkind
 }
 
-#    bind . <Key-space> {}
+#---------- main progrm ----------
 
-proc test_main {} {
+proc main/test {} {
     global glyphsdone unk_l unk_r unk_context
 
     set glyphsdone {
@@ -426,8 +433,42 @@ proc test_main {} {
     draw_glyphsdone
     startup_cursor
 }
+proc done/test {} {
+}
+
+proc required {} {
+    global glyphsdone unk_l unk_r unk_context
+    
+    if {[gets stdin l]<0} {
+       if {[eof stdin]} { fconfigure stdin -blocking yes; exit 0 }
+       return
+    }
+    init_widgets
+    manyset [lrange $l 0 3] unk_l unk_r unk_context
+    set glyphsdone [lrange $l 3 end]
+    puts stderr "SHOW-THING GOT $l"
+
+    fileevent stdin readable {}
+
+    read_xpm stdin
+    draw_glyphsdone
+    startup_cursor
+}
+
+proc main/automatic {} {
+    fconfigure stdin -blocking no
+    fileevent stdin readable required
+}
+proc done/automatic {} {
+    exec sh -c {printf \\0 >&4}
+    fileevent stdin readable required
+}
+
+switch -exact -- $argv {
+    {}           { set mainkind test }
+    --automatic  { set mainkind automatic }
+    default      { error "huh $argv ?" }
+}
 
 read_database
-init_widgets
-test_main
-recursor
+main/$mainkind