{$V-}

type Str80=string[80];

procedure CtrlStr(var S:Str80);

  var I:integer;

  begin
  I:=1;
  repeat
    case S[I] of
      ^^ : begin
           S[I]:='^';
           I:=I+1;
           end;
      '^': begin
           delete(S,I,1);
           if upcase(S[I]) in ['@'..'_'] then S[I]:=chr(ord(upcase(S[I]))-ord('@'));
           I:=I+1;
           end;
      else I:=I+1;
    end;
  until I>length(S);
  end;

procedure KeyCompile;

  var InFile:text;
      InFileName:string[20];
      InStr:string[255];
      Cmd,Key,Def:string[80];
      Done,Quit:boolean;
      Response:char;
      I,J,TblPtr:integer;
      Table:array[1..1000] of char;


  begin
  repeat
    writeln;
    write('Enter name of file to compile: ');
    readln(InFileName);
    assign(InFile,InFileName);
    {$I-} reset(InFile); {$I+}
    if ioresult <> 0  then
      begin
      write('File not found. Re-enter (Y/N)-> ');
      repeat
        read(kbd,Response);
      until upcase(Response) in ['Y','N'];
      if upcase(Response)='Y' then Quit:=false
      else Quit:=true;
      Done:=false;
      end
    else Done:=true;
  until Done or Quit;
  if Done then
    begin
    fillchar(Table,sizeof(Table),#0);
    TblPtr:=1;
    while not eof(InFile) do
      begin
      readln(InFile,InStr);
      Done:=false;
      while InStr[1]=' ' do delete(InStr,1,1);
      Cmd:=copy(InStr,1,pos('=',InStr)-1);
      Key:=Cmd;
      Def:=copy(InStr,pos('=',InStr)+1,255);
      while Cmd[length(Cmd)]=' ' do delete(Cmd,length(Cmd),1);
      for I:=1 to length(Cmd) do Cmd[I]:=upcase(Cmd[I]);
      while Def[1]=' ' do delete(Def,1,1);
      while Def[length(Def)]=' ' do delete(Def,length(Def),1);
      if pos('FILE',Cmd)<>0 then
        begin
        Done:=true;
        for I:=1 to length(Def) do Def[I]:=upcase(Def[I]);
        if length(Def)<=8 then
          begin
          for I:=1 to 8 do KeyHdr^.Name[I]:=' ';
          for I:=1 to length(Def) do KeyHdr^.Name[I]:=Def[I];
          writeln('File name set to ',Def);
          end
        else writeln('File name more than 8 characters');
        end;
      if  pos('ATTENTION',Cmd)<>0 then
        begin
        Done:=true;
        CtrlStr(Def);
        KeyHdr^.Attn:=Def[1];
        end;
      if pos('LEADIN',Cmd)<>0 then
        begin
        CtrlStr(Def);
        KeyHdr^.Leadin:=Def[1];
        KeyHdr^.LeadDef:=chr(ord(Def[1])+128);
        Done:=true;
        end;
      if pos('DELAY',Cmd)<>0 then
        begin
        Done:=true;
        val(Def,I,J);
        if J=0 then KeyHdr^.Delay:=I
        else writeln('Delay definition in error');
        end;
      if pos('EXPANSION',Cmd)<>0 then
        begin
        Done:=true;
        val(Def,I,J);
        if J=0 then KeyHdr^.ExpRate:=I
        else writeln('Expansion Rate definition in error');
        end;
      if pos('CASE',Cmd)<>0 then
        begin
        Done:=true;
        for I:=1 to length(Def) do Def[I]:=upcase(Def[I]);
        if pos('ON',Def)<>0 then KeyHdr^.CaseFlag:=true;
        if pos('OFF',Def)<>0 then KeyHdr^.CaseFlag:=false;
        end;
      if Cmd[1]=';' then Done:=true; {It's a comment}
      if not Done then
        begin
        if pos('=',InStr)<>0 then
          begin
          Def:=copy(InStr,pos('=',InStr)+1,255);
          if KeyHdr^.CaseFlag then
            for I:=1 to length(Key) do Key[I]:=upcase(Key[I]);
          CtrlStr(Def);CtrlStr(Key);
          if (Key[1]=KeyHdr^.LeadIn) and (KeyHdr^.Delay=0) then
            Key:=copy(Key,1,2); {if delay zero then only one char follows leadin}
          for I:=1 to length(Key) do
            begin
            Table[TblPtr]:=Key[I];
            TblPtr:=TblPtr+1;
            end;
          for I:=1 to length(Def) do
            begin
            Table[TblPtr]:=chr(ord(Def[I])+128);
            TblPtr:=TblPtr+1;
            end;
          TblPtr:=TblPtr+1;
          end;
        end;
      end;
    KeyHdr^.Null1:=0;KeyHdr^.Null2:=0;
    move(Table,KeyHdr^.Table,KeyHdr^.TableSize-1);
    writeln('Done');
    delay(1000);
    end;
  end;