--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/reference/ocr-simple/tcl_interface.cc	Thu May 18 23:12:51 2006 +0200
@@ -0,0 +1,301 @@
+#include <tcl.h>
+#include <tk.h>
+#include <string.h>
+#include "link.h"
+#include "tcl_interface.h"
+#include "stdio.h"
+#include "Page.h"
+
+extern Page* global_page;
+extern Tcl_Interp* TCL_ip;
+extern Tk_Window main_window;
+extern double SCALE_FACTOR;
+extern int DISPLAY_SPELLING_MISTAKES;
+
+static int page_currently_open = 0;
+
+void scale(int& coordinate)
+{
+  coordinate = (int)(coordinate * SCALE_FACTOR);
+}
+
+int error(char* s)
+{
+/* would like to make this take var num args */
+  printf("Error: %s", s);
+}
+
+int quit_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  printf("Thank you for using OCRchie.\n");
+  exit(0);
+}
+
+int get_skew_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  get_skew(global_page->rmap());
+  return TCL_OK;
+}
+
+int deskew_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  if(DESKEW_METHOD != -1)
+    {
+      if(global_page->deskew(DESKEW_METHOD))
+	global_page->rmap()->display_intervals("black");
+      return TCL_OK;
+    }
+  else
+    return TCL_OK;
+}
+
+int display_intervals_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  global_page->rmap()->display_intervals("black");
+  return TCL_OK;
+}
+
+int page_open_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  if(ac != 2)
+    return TCL_ERROR;
+  printf("Opening %s\n", argv[1]);
+  if(page_currently_open == 1)
+    {
+      /* should print some message about closing the current one first */
+      return TCL_OK;
+    }
+  global_page = new Page;
+  if(global_page->readMap(argv[1]) != VALID)
+    interp->result = "0";
+  else
+    interp->result = "1";
+  page_currently_open = 1;
+  return TCL_OK;
+}
+
+int get_page_height_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  sprintf(interp->result, "%d", global_page->get_height());
+  /*  printf("Interpereter height = %s\n", interp->result); */
+  return TCL_OK;
+}
+
+int get_page_width_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  sprintf(interp->result, "%d",  global_page->get_width());
+  /* printf("Interpereter width = %s\n", interp->result); */
+  return TCL_OK;
+}
+
+int zoom_in_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  SCALE_FACTOR = SCALE_FACTOR * 2;
+  global_page->rmap()->display_intervals("black");
+  return TCL_OK;
+}
+
+int zoom_out_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  SCALE_FACTOR = SCALE_FACTOR * 0.5;
+  global_page->rmap()->display_intervals("black");
+  return TCL_OK;
+}
+
+int deallocate_page_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  if(page_currently_open == 0)
+    return TCL_OK;  /* don't do anything if their isn't anything open */
+  delete global_page;
+  page_currently_open = 0;
+  return TCL_OK;
+}
+
+int learn_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  printf("Learning from %s and %s\n", argv[1], argv[2]);
+  learn(argv[1], argv[2]);
+  return TCL_OK;
+}
+
+int learn_data_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  printf("Learning data from %s\n", argv[1]);
+  readLearnedGroups(argv[1]);
+  return TCL_OK;
+}
+
+int write_word_pos_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  global_page->writeWordPos(argv[1]);
+  return TCL_OK;
+}
+
+int write_learned_chars_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+{
+  writeLearnedGroups(argv[1]);
+  return TCL_OK;
+}
+  
+int recognize_cmd(ClientData clientData, Tcl_Interp *interp, int ac, char** argv)
+
+{
+  /* just in case someone has left something sitting around */
+  docommand(".main_window.edit_window.text_part delete 1.0 end");
+  docommand("set COLORED_WORDS {}");
+  /* printf("Calling deskew\n"); */
+  deskew_cmd(clientData, interp, ac, argv);
+  /*  printf("Calling setlines\n"); */
+  global_page->setLines();
+  /* printf("Calling extractComponents\n"); */
+  global_page->extractComponents();
+  /* printf("Calling recognize\n"); */
+  global_page->recognize();
+  /* printf("Calling extractwords\n"); */
+  global_page->extractWords();
+  if(SPELLCHECK)
+    {
+      /* printf("Spellchecking\n"); */
+      global_page->spellcheck();
+    }	     
+  /* printf("Calling sendwordstotcl\n"); */
+  global_page->send_words_to_tcl();
+  return TCL_OK;
+}
+
+static int
+vdocommand1(char* s)
+{
+/* final function called to do a tcl docommand */
+  int code;
+
+  code = Tcl_Eval(TCL_ip, s);      
+  if (code == TCL_ERROR)
+    error(TCL_ip->result);
+  return code;
+}
+
+void update()
+{
+  Tcl_DoOneEvent(TCL_DONT_WAIT);   
+}
+
+static int
+vdocommand(int record, char* fmt, va_list args)
+{
+/* helper for docommand */
+  char buf[4097];
+  int code;
+
+  vsprintf(buf, fmt, args);
+  if (strchr(buf, '\?'))
+    error("Huh?");
+  code = vdocommand1(buf);
+  return code;
+}
+
+
+int
+docommand(char* fmt, ...)
+{
+/* do a tcl command, var number of args */
+  va_list args;
+
+  va_start(args, fmt);
+  vdocommand(0, fmt, args);
+  va_end(args);
+}
+
+static int
+vset_status1(char* s)
+{
+/* final function called to do a tcl docommand */
+  int code;
+
+	code = Tcl_Eval(TCL_ip, s);      
+	if (code == TCL_ERROR)
+	  error(TCL_ip->result);
+	return code;
+}
+
+static int
+vset_status(int record, char* fmt, va_list args)
+{
+/* helper for docommand */
+  char buf[4097];
+  char newbuf[4097];
+  int code;
+
+  vsprintf(buf, fmt, args);
+  sprintf(newbuf, ".main_window.button_bar.msg configure -text \"%s\"", buf); 
+  if (strchr(buf, '\?'))
+    error("Huh?");
+  code = vset_status1(newbuf);
+  return code;
+}
+
+int set_status(char* fmt, ...)
+{
+  va_list args;
+
+  va_start(args, fmt);
+  vset_status(0, fmt, args);
+  va_end(args);
+  docommand("update");
+}
+     
+int mispelled(char* word)
+{
+  int result = docommand("spellcheck %s", word);
+  /*  printf("call to spellcheck %s returned %s\n", word, TCL_ip->result); */
+  if(!(strcmp("MISPELLED", TCL_ip->result)))    
+    return 1;
+  else 
+    return 0;
+}
+
+
+int initialize_interpreter()
+{
+  TCL_ip = Tcl_CreateInterp();
+  Tcl_Init(TCL_ip);
+
+}
+
+int load_user_interface()
+{
+  // main_window = Tk_CreateMainWindow(TCL_ip, NULL, "OCRchie", "OCRchie");
+ 
+ 
+  Tk_Init(TCL_ip);
+  main_window = Tk_CreateWindow(TCL_ip, NULL, "OCRchie", "OCRchie");
+  //  Tk_MapWindow(main_window);   /6/21/00
+  docommand("source new_ui.tcl");
+}
+
+int initialize_command_procs()
+{
+  Tcl_CreateCommand(TCL_ip, "page_open", page_open_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "get_page_height", get_page_height_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "get_page_width", get_page_width_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "LEARN", learn_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "LEARN_DATA", learn_data_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "WRITE_WORD_POS", write_word_pos_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "WRITE_LEARNED_CHARS", write_learned_chars_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "FIND_LINES_AND_RECOGNIZE", recognize_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "GET_SKEW", get_skew_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "DESKEW", deskew_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "DISPLAY_INTERVALS", display_intervals_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "QUIT", quit_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "ZOOM_IN", zoom_in_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "ZOOM_OUT", zoom_out_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  Tcl_CreateCommand(TCL_ip, "DEALLOCATE_PAGE", deallocate_page_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc*) NULL);
+  printf("Done initializing new tcl commands\n");
+}
+
+int initialize_link_vars()
+{
+  init_link_vars();  /* what a nice name */
+  docommand("source link_vars.tcl");
+  printf("Done initializing link variables\n");
+}