Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/microcrn/issue_51.arc/OCR.PAS

Pascal/Delphi Source File | 1989-11-29 | 8.0 KB | 304 lines

program OCR;

(* (c) Acquired Intelligence; po box 2091; davis,CA 95617
       for Tidbits #51, Micro Cornucopia
       Questions -- call 916-753-0360

Program --
(1) reads PCX file into a viewport (full screen in this example);
(2) converts viewport to a 2 dimensional picture (Xs and .s);
(3) execs to BrainMaker (a neural network);
(4) BrainMaker evaluates the pictures;
(4) converts BrainMaker output evaluations to text;

requires BrainMaker neural net (from California Scientific Software)
and PCX Tools (from Genus Programming).

*)

uses
  Crt, Dos, Graph, pcx_tp;

var
  F, F2 : text;

const
  { BGI fonts }
  Fonts : array[0..4] of string[13] =
  ('DefaultFont', 'TriplexFont', 'SmallFont',
   'SansSerifFont', 'GothicFont');

  { BGI text directions }
  TextDirect : array[0..1] of string[8] =
  ('HorizDir', 'VertDir');

  Num_of_patterns            = 10;
  Num_of_characters          = 2000;  { for 80 x 25 Viewport }
  Input_file_from_neural_net = 'C:\TP\EXE\BrainRTS.Out';
  Output_file_for_neural_net = 'C:\TP\EXE\BrainRTS.In';
  OCR_Output_file            = 'C:\TP\EXE\OCR.Out';
  PCX_file                   = 'C:\TP\EXE\a.PCX';
  Line_length                = 79;
  Threshold                  = 0.60;
  PCX_type                   = pcxCGA_6;

type

  Weights = array[1..Num_of_characters] of string[4];
  Patterns = array[1..Num_of_characters] of string[1];

{ objects }

NNIptr = ^neural_net_interpreter;
neural_net_interpreter = object
  Array_index    : integer;
  First_char, S  : string;
  Weight         : Weights;
  Output_pattern : Patterns;
  constructor Init;
  destructor Done; virtual;
  procedure Get_weights;
  procedure Output_characters;
end;

Screenptr = ^screen;
screen = object
  GraphDriver : integer;  { Graphics device driver }
  GraphMode   : integer;  { Graphics mode value }
  MaxX, MaxY  : word;     { Maximum screen resolution }
  ErrorCode   : integer;  { Reports any graphics errors }
  MaxColor    : word;     { Maximum color value available }
  pcxReturn   : integer;
  PixelStatus : integer;
  ViewInfo    : ViewPortType;
  constructor init;
  destructor done; virtual;
  procedure Initialize;
end;

var

  OldExitProc : Pointer;  { Saves exit procedure address }

{$F+}
procedure MyExitProc;
begin
  ExitProc := OldExitProc; { Restore exit procedure address }
  CloseGraph;              { Shut down the graphics system }
end; { MyExitProc }
{$F-}

procedure screen.Initialize;
{ Initialize graphics and report errors}
var
  InGraphicsMode: boolean; { Flags graphics initialization}
  PathToDriver  : string;  { Stores DOS path to *.BGI & *.CHR }
begin
                           { When using Crt & graphics, turn }
                           { off Crt's memory-mapped writes }
  DirectVideo := False;
  OldExitProc := ExitProc; { Save previous exit proc }
  ExitProc := @MyExitProc; { Insert our exit proc in chain }
  PathToDriver := '';
  repeat
    GraphDriver := Detect;       { Autodetect graphics adapter }
    InitGraph(GraphDriver, GraphMode, PathToDriver);
    ErrorCode := GraphResult;    { Preserve error return }
    if ErrorCode <> grOK then    { Error? }
    begin
      Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
      if ErrorCode = grFileNotFound then
      begin
        Writeln('Enter full path to BGI driver');
        Writeln('or type <Ctrl-Break> to quit.');
        Readln(PathToDriver);
        Writeln;
      end
      else
        Halt(1);             { Some other error: terminate }
    end;
  until ErrorCode = grOK;
end; { Initialize }

{ object constructors & destructors }

constructor screen.init;
begin
end;

destructor screen.done;
begin
end;

constructor neural_net_interpreter.init;
begin
end;

destructor neural_net_interpreter.done;
begin
end;

{ object methods }

procedure neural_net_interpreter.Get_weights;

var
   This_weight  : string[4];
   This_pattern : string[1];
   Count        : integer;
   W            : word;
   Char_Ptr     : integer;
begin
  FOR Count := 1 TO Num_of_characters DO  { Initialize arrays }
    begin
      Weight[Count]         := ' ';
      Output_pattern[Count] := ' ';
    end;

  Assign(F,Input_file_from_neural_net);
  Reset(F);
  Array_index := 1;
  WHILE Array_index <= Num_of_characters DO
    begin
      Readln(F,S);
      First_char := Copy(S,1,1);
         IF First_char = ' ' THEN
           begin
             Char_Ptr  := 2;
             FOR Count := 1 TO Num_of_patterns DO
               begin
                 This_weight := Copy(S,Char_Ptr,4);
                 Weight[Array_index] := This_weight;
                 Char_Ptr := Char_Ptr + 5;
                 This_pattern := Copy(S,Char_Ptr,1);
                 Output_pattern[Array_index] := This_pattern;
                 Char_Ptr := Char_Ptr + 2;
                 Inc(Array_index);
               end;
           end;
    end;
  Close(F);
end;

procedure neural_net_interpreter.output_characters;

var
  Output_char : string;
  Pattern_count, Char_count, ReturnCode : integer;
  Wt, New_weight : real;

begin
  Assign(F2,OCR_Output_file);
  Rewrite(F2);
  Array_index := 1;
  Char_count  := 1;

  WHILE Array_index <= Num_of_characters DO
  begin
   Pattern_count := 1;
   Wt := 0;
   Output_char   := ' ';
   WHILE Pattern_count <= Num_of_patterns DO
    begin
      Val(Weight[Array_index],New_weight,ReturnCode);
      IF New_weight > Wt THEN
        begin
          Wt := New_weight;
          Output_char := Output_pattern[Array_index];
        end;
      Inc(Pattern_count);
      Inc(Array_index);
    end;
   IF Wt >= Threshold THEN
     Write(F2,Output_char)
   ELSE
     Write(F2,' ');
   IF Char_count > Line_length THEN
   begin
     Writeln(F2);
     Char_count := 0;
   end;
   Inc(Char_count);
  end;
  Close(F2);
end;

var
  NNI : NNIptr;

procedure pcx_to_neural_net;

{ get a.PCX; display it; & convert it to txt for neural net. }

var
  SPort           : Screenptr;
  X, Y            : integer;
  XPt, YPt, RowPt : integer;
  S               : string;

begin
  New(SPort,init);
  WITH SPort^ DO
   begin
    Initialize;
    Maxx := GetMaxx;
    Maxy := GetMaxy;
    SetViewPort(0,0,Maxx,Maxy,ClipOn);
    SetTextStyle(DefaultFont, HorizDir, 1);
    pcxReturn := pcxSetDisplay(PCX_type);
    pcxReturn := pcxFileDisplay(PCX_file,0,0,0);
    IF (pcxReturn = pcxSuccess) THEN
    begin
      Assign(F,Output_file_for_neural_net);
      Rewrite(F);
      GetViewSettings(ViewInfo); { coordinates of Viewport }
      XPt   := 0;
      YPt   := 0;
      RowPt := 0;
      WHILE RowPt <= ViewInfo.y2 DO
      begin
       WHILE XPt <= ViewInfo.x2 DO
        begin
          FOR Y := YPt to (YPt + 7) DO
            begin
              FOR X := XPt to (XPt + 7) DO
                begin
                  PixelStatus := GetPixel(X,Y);
                  IF PixelStatus = 0 THEN
                    write(F,'.')
                  ELSE
                    write(F,'X');
                end;
               writeln(F);
            end;
          YPt := RowPt;
          XPt := XPt + 8;
        end;
       XPt   := 0;
       RowPt := RowPt + 8;
       YPt   := RowPt;
      end;
    end;
    Close(F);
   end;
  Dispose(SPort,done);
end;  { pcx_to_neural_net}


begin { program body }
  pcx_to_neural_net;
  New(NNI, init);
  WITH NNI^ DO
  begin
    SwapVectors;
    exec('C:\COMMAND.COM','/C C:\BATCH\net');
    SwapVectors;
    IF DosError <> 0 THEN
     Writeln('Dos error # ',DosError)
    ELSE
     Get_weights;
     Output_characters;
     Dispose(NNI, done);
   end;
end.