Category : Files from Magazines
Archive   : ISSUE-51.ZIP
Filename : OCR.PAS

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 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.