old/PAS/!SPbSTU/10.PAS

USES Graph;
Type
  PBTree = ^TBTree;
  TBTree = record
    info : string[30];
    Left : PBTree;
    Right: PBTree;
  end;

    ps  = ^el;
    el  = record
        data : integer;
        prev : ps;
    end;
Var
  inp : string;
  p   : byte;
  mh  : byte;

{---------------------------------}
Procedure DelBranch(br:PBTree);
begin
  if br^.left  <> nil then DelBranch(br^.left);
  if br^.right <> nil then DelBranch(br^.right);
  Dispose(br);
end;{DelBranch}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-}
Function GetToken:string;
var
 ret : string[30];
begin
 ret :='';
 while inp[p] = ' ' do inc(p);
 while (not (inp[p] in [' ','(',')'])) and (p <= ord(inp[0])) do
  begin
   ret := ret+inp[p];
   inc(p);
  end;
 While (inp[p] = ' ') and (p <= ord(inp[0])) do inc(p);
 GetToken := ret;
end;
{--------------------}
Procedure Create(TR:PBTree);
var
 aT : string[20];
begin
 tr^.left:=nil;
 tr^.right:=nil;
 while inp[p] = ' ' do inc(p);
 
 if (copy(inp,p,3)<>'NOT') or 
    (copy(inp,p,3)<>'not') then
 begin
  New(Tr^.left);
  Tr^.left^.right:=nil;
  Tr^.left^.left:=nil;
  if inp[p] = '(' then 
   begin 
    inc(p);
    Create(tr^.left);
   end
  else 
   begin
    aT:=GetToken;
    if (aT<>'NOT') and (aT<>'AND') and (aT <> 'OR') and 
       (aT<>'not') and (aT<>'and') and (aT <> 'or') then
     tr^.left^.info := aT
    else
     begin
      WriteLn('Get operation, when expected operand: ', aT);
      Halt(255);
     end;
   end;
 end;

 tr^.info := GetToken;
 if  (tr^.info <> 'AND') and (tr^.info <> 'and') and
     (tr^.info <> 'NOT') and (tr^.info <> 'not') and
     (tr^.info <> 'OR')  and (tr^.info <> 'or')  then
    begin
      WriteLn('Error at pos ',p - Length(tr^.info));
      Halt(255);
    end;
    
 new(tr^.right);
 Tr^.right^.right:=nil;
 Tr^.right^.left:=nil;
 if (inp[p]='(') then 
  begin 
   inc(p);
   Create(tr^.right) 
  end
 else 
   begin
    aT:=GetToken;
    if aT = '' then
     begin
      WriteLn('No operand, when expected, pos ',p);
      Halt(255);
     end;
    if ((aT<>'NOT') and (aT<>'AND') and (aT <> 'OR') and
        (aT<>'not') and (aT<>'and') and (aT <> 'or')) then
     tr^.right^.info := aT
    else
     begin
      WriteLn('Get operation, when expected operand: ', aT);
      Halt(255);
     end;
   end;

 if (inp[p]=')') then inc(p);
end;
{---=--=--=-=-=-=-=-=---=-=-=-=-=--}
Procedure DrawTree(aT:PBTree;x,y,h,dy:word);
begin
 if aT = nil then exit;
 SetTextJustify(CenterText,BottomText);
 OutTextXY(x,y,aT^.info);
 if aT^.left <> nil then
  begin
    Line(x,y+1,x-(GetMaxX shr h),y+dy-1-TextHeight(at^.left^.info));
    DrawTree(at^.left, x-(GetMaxX shr h),y+dy,h+1,dy);
  end;
 if aT^.right <> nil then
  begin
    Line(x,y+1,x+(GetMaxX shr h),y+dy-1-TextHeight(at^.right^.info));
    DrawTree(at^.right,x+(GetMaxX shr h),y+dy,h+1,dy);
  end;
end;
{=======================}
Function Height(aT:PBTree;ch:byte):byte;
begin
if aT = nil then exit;
 Height :=  Height(at^.left,ch+1);
 Height :=  height(at^.right,ch+1);
 if ch > mh then mh := ch;
 Height := mh;
end;
{--------------}
var
  tree: PBTree;
  grD,grM : integer;
Begin
  New(Tree);
  Tree^.left:=nil;
  Tree^.right:=nil;
  p:=1;
  mh:=0;
 Assign(input,'10.txt');
 {$I-}
 Reset(input);
 {$I+}
 if IOResult <> 0 then
 begin
  WriteLN('File 10.txt not found!');
  Halt(255);
 end;
  readln(inp);
 Close(Input);
 Assign(input,'CON');
 Reset(input);
  Create(tree);
  grD:=Detect;
InitGraph(grD,grM,'');
  DrawTree(Tree,GetMaxX div 2,TextHeight(tree^.info)+20,2,(GetMaxY-20) div Height(Tree,1));
  ReadLn;
CloseGraph;           
  DelBranch(tree);
End.