#!/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} {
#---------- 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
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
#---------- database read and write ----------
+# OUT OF DATE
# database format:
# series of glyphs:
# <context> <ncharacters> <hex>...
#---------- 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 {
draw_glyphsdone
startup_cursor
}
-proc done/test {} {
+proc done/default {} {
}
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"
proc debug {m} { }
-set mainkind test
+set mainkind default
foreach arg $argv {
switch -exact -- $arg {
{--debug} { proc debug {m} { puts stderr "SHOW-THING $m" } }