WIP now has most of the ocr parts but does not work yet

[ypp-sc-tools.web-live.git] / pctb / show-thing.tcl

diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl
index 4537e6af63b8242cd7afca15aebd1cad341f4e69..9a5b1d253c91a0d43093551ad4889df95b30f02c 100755 (executable)
--- a/pctb/show-thing.tcl
+++ b/pctb/show-thing.tcl
@@ -1,4 +1,12 @@
-#!/usr/bin/tk
+#!/usr/bin/wish
+
+# usage:
+#  run show-thing without args
+#  then on stdin write
+#     one line which is a Tcl list for foolist
+#     the xpm in the format expected
+#  then expect child to raise SIGSTOP or exit 0 or exit nonzero
+#  if child raised SIGSTOP, check database was updated
 
 proc manyset {list args} {
     foreach val $list var $args {
@@ -25,9 +33,11 @@ set rhsmost_max -1
 set f [open text.xpm]
 set o {}
 set y -3
-while {[gets $f l] >= 0} {
+while 1 {
+    if {[gets $f l] < 0} { error "huh? "}
     if {![regexp {^"(.*)",$} $l dummy l]} {
        append o "$l\n"
+       if {[regexp {^\}\;$} $l]} break
        continue
     }
     if {$y==-3} {
@@ -287,11 +297,10 @@ proc read_database {} {
     global database
     set f [open database r]
     while {[gets $f l] >= 0} {
-       if {![regexp {^(\w+) (\d+) ([0-9a-f]{2}+)$} $l \
+       if {![regexp {^(\w+) (\d+) ((?:[0-9a-f]{2})+)$} $l \
                  dummy context strl strh]} {
            error "bad syntax"
        }
-        binary scan $strw h* strh
        if {[string length $strh] != $strl*2} { error "$strh $strl" }
        gets $f l; set width [format %d $l]
        set bm $context
@@ -300,6 +309,7 @@ proc read_database {} {
        }
        set database($bm) $strh
     }
+    close $f
 }
 
 proc write_database {} {
@@ -314,9 +324,12 @@ proc write_database {} {
        foreach x [lrange $bm 1 end] { append o "$x\n" }
        lappend ol $o
     }
+    set f [open database.new w]
     foreach o [lsort $ol] {
-       puts -nonewline $o
+       puts -nonewline $f $o
     }
+    close $f
+    file rename -force database.new database
 }
 
 proc update_database/DEFINE {c0 c1 strh} {