{$D-}

Unit Keyb;

{***************************************************************************}

{* This general-purpose unit is for user keyboard input routines.

{***************************************************************************}



interface

{***************************************************************************}

{***************************************************************************}



Function  AltKey(var InChar: char): boolean;

procedure Ask(QuestionStr: string; var AnswerStr: string);

procedure AskChar(QuestionStr: string; var AnswerChar: char);

Function  AskIntDef(QStr: string; LowNum, HighNum, DefNum: longint): longint;

procedure AskNum(QuestionStr: string; MaxNum: integer;

            var AnswerNum: integer);

procedure AskNumNul(QuestionStr: string; MaxNum: integer;

            var AnswerNum: integer; var NulPresent: boolean);

procedure AskPos(QuestionStr: string; MaxNum: integer;

            var AnswerNum: integer);

procedure AskPosNul(QuestionStr: string; MaxNum: integer;

            var AnswerNum: integer; var NulPresent: boolean);

procedure AskQuit;

procedure AskRealNul(InStr: string; MinVal: real; MaxVal: real;

            var OutVal: real; var NulPresent: boolean);

Function  AskStr(QuestionStr: string): string;

function  AskYN(QuestionStr: string; Default: char): boolean;

Function  GetOption(NumOptions: integer): byte;

Procedure PoliteHalt;

Procedure Stop;

procedure Wait;



implementation

{***************************************************************************}

{***************************************************************************}

Uses

  Crt,

  Data,

  Glob,

  Misc,

  Scrn;



Function  AltKey(var InChar: char): boolean;

{***************************************************************************}

begin

  Delay(100);

  if not(keypressed) then

    AltKey := false

  else

    begin

      AltKey := true;

      InChar := readkey;

    end;

end;



procedure Ask(QuestionStr: string; var AnswerStr: string);

{***************************************************************************}

begin

  write(QuestionStr,':  ');

  readln(AnswerStr);

end;



procedure AskChar(QuestionStr: string; var AnswerChar: char);

{***************************************************************************}

begin

  write(QuestionStr,':  ');

  readln(AnswerChar);

end;



Function AskIntDef(QStr: string; LowNum, HighNum, DefNum: longint): longint;

{***************************************************************************}

var

  Good: boolean;

  InStr: string;

  Temp: longint;

begin

  if DefNum < LowNum then

    DefNum := LowNum;

  if DefNum > HighNum then

    DefNum := HighNum;

  Good := false;

  repeat

    write(QStr,' (',LowNum,' to ',HighNum,') [',DefNum,']:  ');

    readln(InStr);

    if InStr = '' then

      begin

        Temp := DefNum;

        Good := true;

      end

    else

      begin

        Temp := IntStr(InStr);

        if (Temp >= LowNum) and (Temp <= HighNum) then

          Good := true;

      end;

  until Good;

  AskIntDef := Temp;

end;



Procedure AskNum(QuestionStr: string; MaxNum: integer;

  var AnswerNum: integer);

{***************************************************************************}

var

  AnswerStr: string;

  Leave: boolean;

  AnswerReal: real;

  Bad: boolean;

begin

  repeat

    Leave := true;

    Ask(QuestionStr, AnswerStr);

    if AnswerStr = '' then

      Leave := false;

    Val(AnswerStr, AnswerReal, DumInt);

    if (AnswerStr[1] <> '0') and (AnswerReal = 0) then

      Leave := false;

    AnswerNum := trunc(AnswerReal);

    Bad := (AnswerNum < 0) or (AnswerNum > MaxNum);

    if Bad or not(Leave) or (AnswerReal <> int(AnswerReal)) then

      begin

        BackUpLine;

        write(#7);

        Leave := false;

      end;

  until Leave;

end;



procedure AskNumNul(QuestionStr: string; MaxNum: integer;

  var AnswerNum: integer; var NulPresent: boolean);

{***************************************************************************}

var

  AnswerStr: string;

  Leave: boolean;

  AnswerReal: real;

  Bad: boolean;

begin

  repeat

    Leave := true;

    Ask(QuestionStr, AnswerStr);

    if AnswerStr = '' then

      NulPresent := true

    else

      NulPresent := false;

    Val(AnswerStr, AnswerReal, DumInt);

    AnswerNum := trunc(AnswerReal);

    Bad := (AnswerNum < 0) or (AnswerNum > MaxNum);

    if Bad or (AnswerReal <> int(AnswerReal)) then

      begin

        BackUpLine;

        write(#7);

        Leave := false;

      end;

  until Leave;

end;



procedure AskPos(QuestionStr: string; MaxNum: integer;

  var AnswerNum: integer);

{***************************************************************************}

var

  AnswerStr: string;

  Leave: boolean;

  AnswerReal: real;

  Bad: boolean;

begin

  repeat

    Leave := true;

    Ask(QuestionStr, AnswerStr);

    Val(AnswerStr, AnswerReal, DumInt);

    AnswerNum := trunc(AnswerReal);

    Bad := (AnswerNum < 1) or (AnswerNum > MaxNum);

    if Bad or (AnswerReal <> int(AnswerReal)) then

      begin

        BackUpLine;

        write(#7);

        Leave := false;

      end;

  until Leave;

end;



procedure AskPosNul(QuestionStr: string; MaxNum: integer;

  var AnswerNum: integer; var NulPresent: boolean);

{***************************************************************************}

var

  AnswerStr: string;

  Leave: boolean;

  AnswerReal: real;

  Bad: boolean;

begin

  repeat

    Leave := true;

    Ask(QuestionStr, AnswerStr);

    if AnswerStr = '' then

      begin

        AnswerNum := 0;

        NulPresent := true;

        Leave := true;

      end

    else

      begin

        NulPresent := false;

        Val(AnswerStr, AnswerReal, DumInt);

        AnswerNum := trunc(AnswerReal);

        Bad := (AnswerNum < 1) or (AnswerNum > MaxNum);

        if Bad or (AnswerReal <> int(AnswerReal)) then

          begin

            BackUpLine;

            write(#7);

            Leave := false;

          end;

      end;

  until Leave;

end;



procedure AskQuit;

{***************************************************************************}

begin

  writeln;

  if AskYN('Do you want to leave the program?','N') then

    halt;

end;



procedure AskRealNul(InStr: string; MinVal: real; MaxVal: real;

  var OutVal: real; var NulPresent: boolean);

{***************************************************************************}

var

  AnsStr: string;

  InputBad: boolean;

begin

  repeat

    Ask(InStr, AnsStr);

    if AnsStr = '' then

      NulPresent := true

    else

      NulPresent := false;

    Val(AnsStr, OutVal, DumInt);

    if (OutVal < MinVal) or (OutVal > MaxVal) then

      InputBad := true

    else

      InputBad := false;

    if InputBad then

      begin

        write(#7);

        BackUpLine;

      end;

  until not(InputBad);

end;



Function  AskStr(QuestionStr: string): string;

{***************************************************************************}

var

  Temp: string;

begin

  write(QuestionStr,':  ');

  readln(Temp);

  AskStr := Temp;

end;



function AskYN(QuestionStr: string; Default: char): boolean;

{***************************************************************************}

var

  DefStr: string;

  OptStr: string;

  OptChar: char;

  OptGood: boolean;

begin

  if upcase(Default) = 'Y' then

    DefStr := ' (Y/n)'

  else

    DefStr := ' (y/N)';

  repeat

    write(QuestionStr, DefStr, ':  ');

    readln(OptStr);

    if OptStr = '' then

      OptStr := Default;

    OptChar := upcase(OptStr[1]);

    if OptChar = 'Y' then

      begin

        OptGood := true;

        AskYN := true;

      end

    else

      if OptChar = 'N' then

        begin

          OptGood := true;

          AskYN := false;

        end

      else

        begin

          OptGood := false;

          BackUpLine;

          write(Beep);

        end;

  until OptGood;

end;



Function GetOption(NumOptions: integer): byte;

{*************************************************************************}

var

  OptionChar: char;

  Option: byte;

begin

  repeat

    writeln;

    write('Option:  ');

    OptionChar := readkey;

    writeln(OptionChar);

    val(OptionChar, Option, DumInt)

  until Option in [1..NumOptions];

  GetOption := Option;

end;



procedure PoliteHalt;

{***************************************************************************}

begin

  writeln('Halting the program. Hit ENTER when ready...');

  readln;

  halt;

end;



Procedure Stop;

{***************************************************************************}

begin

  writeln('Program stopped...  Hit ENTER to continue...');

  readln;

end;



Procedure Wait;

{***************************************************************************}

begin

  writeln;

  writeln('Press the ENTER key to continue...');

  readln;

end;





{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

end.