{ * Input.Dem ram                    }
{ * by Don Ramsey                    }
{ * March-April 1984 *               }

program Input;

type
  Astring   =   string[255];
  ShortString = string[5];

var
  R,C,L,Counter   : integer;
  Ch              : Char;
  Answer,Template : Astring;
  Continue,Exit,
   Inserton       : Boolean;


procedure Msg(S: Astring; R1,C1: integer);
  begin
     gotoXY(C1,R1);  write(S);
  end;

procedure InvVideo( S: Astring);
  begin
    textBackground(15);textcolor(0); write(S);
    textBackground( 0);textcolor(7);
  end;

procedure KeySet(S1,S2,S3 : Char);
 var J : integer;
 begin
  if S3='I' then J:=128 else J:=0;
  Case S1 of
    'C': begin if S2='N' then  MemW[0000:1047]:= 96+J
               else            MemW[0000:1047]:= 64+J;
         end;
    ' ': begin if S2='N' then  MemW[0000:1047]:= 32+J
               else            MemW[0000:1047]:=  0+J;
         end;
  end; { Case }
 end;

procedure Say_Cap_Num;
 var  Value  : integer;
 begin
     Value := Mem[0000:1047];      { test for caps, numbers, & cursor cntrl }
     gotoXY(65,25);
     Case Value of
       0   : begin write('               '); end;
       32  : begin write('     '); InvVideo('NUM');
                   write('       '); InsertOn:= false; end;
       64  : begin InvVideo('CAPS'); write('           ');
                   InsertOn:= false; end;
       96  : begin InvVideo('CAPS'); write(' '); InvVideo('NUM');
                   write('       '); InsertOn:=false; end;
       128 : begin write('         ');InvVideo('Insert');InsertOn:=true; end;
       160 : begin write('     '); InvVideo('NUM');write(' ');
                   InvVideo('Insert'); InsertOn:=true; end;
       192 : begin InvVideo('CAPS'); write('     ');
                   InvVideo('Insert'); InsertOn:=true; end;
       224 : begin InvVideo('CAPS'); write(' ');InvVideo('NUM'); write(' ');
                   InvVideo('Insert'); InsertOn:= true; end;
     end; { Case }
  end;

procedure KeyIn(var Ch: Char);
begin
  read(kbd,Ch);
  begin {see if IBM specific key pressed}
    case Ch of
      'H': Ch:=^E    ;  { up-arrow  }
      'P': Ch:=^X    ;  { dn-arrow  }
      'M': Ch:=^D    ;  { rt-arrow  }
      'K': Ch:=^S    ;  { left-arr  }
      'S': Ch:=#127  ;  { Del       }
      'R': Ch:=^V    ;  { insert    }
      'G': Ch:=^G    ;  { Home      }
      'O': Ch:=^O    ;  { End       }
      'I': Ch:=^R    ;  { Pg-Up     }
      'Q': Ch:=#00   ;  { Pg-Dn     }
    end;   {Case Ch}
  end;   {IBM check}
end;  {KeyIn}

procedure Input(Typ: Char          ;    { Type of input        }
                Default: AString   ;    { Default string       }
                Row,Col: integer   ;    { Where start line     }
                Mlen: integer      ;    { Max length           }
                UpperCase:Boolean) ;    { True if auto Upcase  }
var
  X,X1,J: integer;
  InsertOn: boolean;
  OkChars,Temp: set of Char;

{-------------------------- local procedures ---------------------------}
  procedure GotoX;
   begin
     GotoXY(X+Col-1,Row);
   end;

  procedure Ck_Cap_Num;
   var Value,temp : integer;
   begin
    Value := Mem[0000:1047];      { test for caps, numbers, & cursor cntrl }
    temp := value; Say_Cap_Num; gotoX;
      repeat
        Value := Mem[0000:1047];
        if temp<>value then
          begin temp:=Value; Say_Cap_Num; GotoX; end;
      until mem[0000:1050]<>Mem[0000:1052];
   end;

  procedure PosX;
    begin
      while copy(template,X,1)<>#176 do X:=X+1;
      GotoX;
    end;

  procedure Del_Ans;
    begin
      Answer:=''; X:=1; GotoX; write(template); PosX;
    end;
{------------------------ end local procedures ------------------------}

begin
  Highvideo;
  if Typ='A'then  OKChars:=[' '..'}']
  else OKChars:=['0'..'9','+','-','.'];
  Temp := OKChars;
  Case Typ of
    'A','N': begin  fillchar(template,255,#176);
                    template := copy(template,1,Mlen);
                    if Default = '' then Del_Ans;
             end;
    'F':      begin  Mlen := 0; Del_Ans;
                     for J:=1 to length(template) do
                       if template[J] = #176 then Mlen := Mlen+1;
              end;
    '$':      begin  Fillchar(template,255,#176);
                     template:=copy(template,1,Mlen);
                     X:=0;GotoX;write('$');
                     if Default = '' then Del_Ans;
              end;
  end;

  if Typ = 'A' then if uppercase then KeySet('C',' ','I')
                    else KeySet(' ',' ','I')
  else KeySet(' ','N','I');
  if Default<>'' then begin X:=1;GotoX;write(Default); end;
  if Length(Answer)=1 then X:=2;
  GotoX;
  Answer := '';
  repeat
    Ck_Cap_Num; read(kbd,Ch);
    if keypressed then KeyIn(Ch);
    if (Answer= '') and (Ch <> #13) and (Ch<>^V) then Del_Ans;
    case Ch of
       ^[: begin Del_Ans end;     { ESC pressed   }

       ^D: begin { Move cursor right : rt-arr }
             X:=X+1;
             if (X>length(Answer)+1) or (X>Mlen) then X:=X-1;
             GotoX;
           end;

       ^S: begin { Move cursor left : left-arr }
             if Typ='F' then Del_Ans
             else begin
               X:=X-1;
               if X<1 then X:=1;
               GotoX;
             end;
           end;
       ^O: begin { Move cursor to end of line }
              X:=Length(Answer)+1; if X>Mlen then X:=Mlen;
              GotoX;
           end;
       ^G: begin { Move cursor to beginning of line }
             X:=1;
             GotoX;
           end;
       ^H: begin { Delete left char: BS }
             if Typ='F' then Del_Ans
             else
               begin
                 X:=X-1;
                 if (Length(Answer)>0) and (X>0)  then
                   begin
                     Delete(Answer,X,1); GotoX;
                     Write(copy(Answer,X,(Length(Answer)-X+1)),#176);
                     GotoX;
                     if X<1 then X:=1;
                   end
                 else X:=1;
             end; { Typ <> 'F' }
           end;
       #127: begin { Delete }
               Delete(Answer,X,1);
               Write(copy(Answer,X,Length(Answer)-X+1),#176); GotoX;
             end;

    else
    begin   { non-IBM char }
        if Ch in OkChars  then
         begin
          if InsertOn then begin
           if length(Answer) < Mlen then  { OK to insert }
           begin
             insert(Ch,Answer,X);
               Case Typ of
                'A','N','$' : write(copy(Answer,X,Length(Answer)-X+1));
                'F'         : Write(Ch);
               end; {Case}
           end;        { OK to insert }
          end else     { end InsertOn }
          begin
             write(Ch);
             if X>length(Answer) then Answer:=Answer+Ch
             else Answer[X]:=Ch;
          end;
          if Length(Answer)+1<=Mlen then
            begin
              X:=X+1;
              if (X > Length(Answer)) and (template[X]<>#176) then PosX;
            end;
         end { OkChars }
        else OkChars:=[];  { Line too Long }
        GotoX;
        if Length(Answer)+1<=Mlen then
           OkChars:= Temp                   { Line ok again }
        else if (Ch<>^M) and (Typ<>'F') then
           write(chr(7));                   { beep for last char. alert }
    end;
   end;
  until CH=^M; Lowvideo; GotoX; write(Ch);
 If Answer = '' then Answer:= default;
{ else Answer:=copy(answer,1,pos(^M,Answer)-1);}
 if Typ <> 'F' then
   begin
     X:=length(Answer)+1; GotoX;
     fillchar(Template,255,' ');
     Template:=copy(template,1,Mlen-length(Answer));
     write(Template);
   end;
 writeln(' ');
end;          { end Input Procedure }

{procedure Input_Handler(IpCode: ShortString);}
  { requires procedures Say_Prompt, Do_Validation, Get_Default }
  {          global variables Do_last_entry: boolean, Escape: boolean,
               Filvar: array of [1.25] of string[80] }
{ var Typ                  : Char;
     Default              : Astring;
     R,C,Mlen,I,Code,Count,
     First_var,Last_var,
     Filvar               : integer;
     Def,Pmt,Vall         : string[2];

  procedure Get_Var;
    begin
      val(copy(P[count],1,2),C,Code); val(copy(P[count],3,2),R,Code);
      Typ := copy(P[count],5,1); val(copy(P[count],6,3),Mlen,Code);
      val(copy(P[count],9,2),Filvar,Code); Def:= copy(P[count],12,2);
      Pmt:= copy(P[count],14,2); val(copy(P[count],16,2),Valid,Code);
    end;

 begin
   val(copy(IpCode,2,2),First_Var,Code);
   val(copy(Ipcode,4,2),Last_var,Code);
   IpType := copy(IpCode,1,1);
   Case IpType of
     'N' : for I:= 1 to 25 do Filvar[I] := '';
     'C' :
   end; { Case }
   {count := First_var;
   repeat
     Get_Var;
     if Filvar[count] = '' then Get_Default(Def)
     else Default := Filvar[count];
     Say_Prompt(Pmt);
     Input(Typ,Default,R,C,Mlen,True); Filvar[count] := Answer;
     Do_validation(vall);
     if Do_last_entry then
      begin
        count:=count-1; Do_last_entry:=false;
      end else count:=count+1;
     if count < First_var then begin Escape:=true; Exit:=true; end
     else if (count>Last_var) or (P[count]='') then Exit:=true;
   until Exit = true;
   Exit:=false;
 end;}


procedure InputDemo;
begin
 repeat
   clrscr; LowVideo;
   write('   Alphanumeric Input Routine');
    Input('A','This is Default',1,40,20,true);writeln('Returned  : ',Answer);
   Msg('Numeric Input Routine',5,3);
     Input('N','',5,40,7,true);  ; writeln('Returned : ',Answer);
   Msg('Formatted Input Routine',9,3);  template:='(°°°) °°°-°°°°';
     Input('F','',9,40,0,true);  ;  writeln('Returned : ',answer);
   Msg('Formatted Input Routine',13,3);  template:='°°/°°/°°';
     Input('F','',13,40,0,true);  ;  writeln('Returned : ',answer);
   Msg('Dollar Input Routine',17,3);
     Input('$','',17,40,7,true); writeln('Returned : ',answer); writeln(' ');
   write('Press <E> to exit or Any Key to repeat Demo');
   Read(kbd,Ch); Ch:=upcase(Ch);
 until Ch='E';
end;


begin
  ClrScr; Continue := true; Exit:=false;
  InputDemo;
end.m
NobleAff
NoestUt
Norstr
Nortek
Norton
Norwst
Novo
NrfolkS
Nrthrp  s
Nstr
