chiark / gitweb /
invokes yppsc-ocr-resolver for unrecognised pixmap
[ypp-sc-tools.web-live.git] / pctb / yppsc-ocr-resolver
index 016a95e58bfc90557e370ca7c36728dca32a0531..ec4473d2205ed19f7c114ad81775701490266916 100755 (executable)
@@ -1,12 +1,38 @@
 #!/usr/bin/wish
 
-# usage:
-#  run show-thing without args
+# helper program for OCR in PCTB upload client
+
+# This is part of ypp-sc-tools, a set of third-party tools for assisting
+# players of Yohoho Puzzle Pirates.
+#
+# Copyright (C) 2009 Ian Jackson <ijackson@chiark.greenend.org.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#
+# Yohoho and Puzzle Pirates are probably trademarks of Three Rings and
+# are used without permission.  This program is not endorsed or
+# sponsored by Three Rings.
+
+
+# invocation:
+# OUT OF DATE
+#  run this without args
 #  then on stdin write
-#     one line which is a Tcl list for unk_{l,r} unk_contexts glyphsdone
+#     one line which is a Tcl list for unk_{l,r} unk_contexts glyphsdone etc.
 #     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
+#  then expect child to exit 0, or write a single 0 byte to fd 4
+#  if it wrote a byte to fd 4, it can take another question
 
 
 proc manyset {list args} {
@@ -100,6 +126,11 @@ proc resize_widgets {} {
 
 #---------- xpm input processor ----------
 
+proc must_gets {f lvar} {
+    upvar 1 $lvar l
+    if {[gets $f l] < 0} { error "huh?" }
+}
+
 proc read_xpm {f} {
     global glyphsdone mul inter rhsmost_max unk_l unk_r mulcols mulrows
     global cols rows wordmap
@@ -107,7 +138,7 @@ proc read_xpm {f} {
     set o {}
     set y -3
     while 1 {
-       if {[gets $f l] < 0} { error "huh? "}
+       must_gets $f l
        if {![regexp {^"(.*)",$} $l dummy l]} {
            append o "$l\n"
            if {[regexp {^\}\;$} $l]} break
@@ -374,6 +405,7 @@ proc recursor {} {
 
 #---------- database read and write ----------
 
+# OUT OF DATE
 # database format:
 # series of glyphs:
 #   <context> <ncharacters> <hex>...
@@ -490,7 +522,10 @@ proc RETURN_RESULT {how what} {
 
 #---------- main progrm ----------
 
-proc main/test {} {
+proc main/default {} {
+    puts stderr "Do not run this program directly."
+    exit 12
+    
     global glyphsdone unk_l unk_r unk_contexts
 
     set glyphsdone {
@@ -511,7 +546,7 @@ proc main/test {} {
     draw_glyphsdone
     startup_cursor
 }
-proc done/test {} {
+proc done/default {} {
 }
 
 proc required {} {
@@ -522,6 +557,19 @@ proc required {} {
        return
     }
     init_widgets
+
+    required/$l
+}
+
+proc required/pixmap {} {
+    global unk_what
+    must_gets stdin unk_what
+    error nyi
+}
+
+proc required/char {} {
+    must_gets stdin l
+
     manyset [lrange $l 0 3] unk_l unk_r unk_contexts
     set glyphsdone [lrange $l 3 end]
     debug "GOT $l"
@@ -547,7 +595,7 @@ proc done/automatic {} {
 
 proc debug {m} { }
 
-set mainkind test
+set mainkind default
 foreach arg $argv {
     switch -exact -- $arg {
        {--debug}        { proc debug {m} { puts stderr "SHOW-THING $m" } }