{ * 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 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