ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MISC/EDUCATIO/CATTEST.ZIP/UTILITY.PAS

Pascal/Delphi Source File | 1991-04-03 | 40.0 KB | 1,214 lines

UNIT UTILITY;
(*
 August 7, 1990;    added erase after Pause, YesNo
 August 14, 1990;   added Clear_all_blanks,
                    added erasures at all exits to Read_Eqn
 October 14, 1990;  added requirements for "good" input
                    Read_Real_Masked
                    1)cursor control
                    2)insert/overtype switch
                    3)legal character set
                    4)legal function and editing keys
                    5)default value on input entry
                    6)default value on exit by ESC
                    by adding Read_Masked_Number, and attempt using a
                    '+0.yyyE+00' type mask to get input acceptable.
October 26, 1990;    added changes to sound (NOISE)
November 21, 1990;   added Read_Integer_Masked, cloned from above.
November 28, 1990;   changed read_integer_masked to get sign position
                    correct.
November 30, 1990;   added Frame
                    YesNo defaults to No if Carriage Return
December 1, 1990     Txt := '' in read_integer_masked
                    PF keys assigned
January 4, 1991     Removed limits from read_real, changed name to
                    read_float.
January 8, 1991     Added Read_fixed, changed both to ignore decimal
                    points.
January 11, 1991    Cleaned up 'x' and 'y' from Read_fixed and read_float

April 3, 1991       Added Fileexists

*)

INTERFACE

USES
CRT;

TYPE
  Sounds = (Good,Bad,FinishedGood,FinishedBad,Acknowledge,Cont);
  set_of_char = SET OF char;

  CONST
    OK_Message : STRING = 'O.K.';
    Not_OK_Message : STRING = 'Not O.K.';
    PF1 = #59;
    PF2 = #60;
    PF3 = #61;
    PF4 = #62;
    PF5 = #63;
    PF6 = #64;
    PF7 = #65;
    PF8 = #66;
    PF9 = #67;
    PF10 = #68;

VAR
  Err,ErrPos : integer;     {Error response from Checking, and position}
  Contents : STRING;                 { Contains a formula or some text }
  Escape_struck,            {Global Variable which tells if ESC pressed}
  PF : Boolean;   {Global Variable which tells if Function Keys pressed}
  Ch,
  variable : Char;
  lc_var,uc_var : CHAR; { known case versions of variable }
  question : STRING;                 {contains the question to be asked}

PROCEDURE NOISE(WhatSound:Sounds);

FUNCTION Read_Key: char;


(*   page layout
     X=1->80...
     Y --------------------------
     = |
     1 |
     | |
     2 |
     5 |
*)

PROCEDURE Our_Write(x,
                    y: {positions of cursor for first character}
                    integer;
                    s: {string to be written}
                    STRING);

FUNCTION YesNo(x,
               y: {positions of cursor for first character of prompt}
               integer;
               s: {prompt text}
               STRING): boolean;

PROCEDURE Pause(x,
                y: {positions of cursor for first character of prompt}
                integer;
                s: {prompt text}
                STRING);

PROCEDURE CheckBrackets(Str: {formula containing string to be checked}
                          STRING;
                        VAR Err: {Code for error <>0 means yes}
                          Integer;
                        VAR Err_Message: {message string}
                          STRING);

PROCEDURE Remove_double_blanks(VAR Str:STRING);

PROCEDURE Remove_all_blanks(VAR Str:STRING);

PROCEDURE Trim_fore_aft(VAR Str:STRING);

PROCEDURE PoseQuestion(line: {y position of line, x=1 assumed}
                          INTEGER;
                       question: {text of question, max length 255}
                          STRING);

FUNCTION Read_Eqn(X,Y,L:integer;s:STRING): STRING; {original, obsolete}

FUNCTION Read_Number(X,Y,L:integer;s:STRING): STRING; {original, obsolete}

FUNCTION Read_Masked_Number(X,Y:integer;s,mask:STRING): STRING; {original, obsolete}

FUNCTION Read_Equation(X,
                       Y, {positions of cursor for first character of prompt}
                       L: {length of string allowed for this equation}
                       integer;
                       s:
                       STRING;
                       char_set:
                       set_of_char): STRING;

PROCEDURE Read_Float_Masked
                        (X,
                         Y, {position of prompt}
                         L: {number of places to right of decimal point}
                           integer;
                         Prompt:
                           STRING;
                         Print_Prompt : {show old value?}
                           Boolean;
                         VAR W : {resultant value/or original one}
                         real);

PROCEDURE Read_Fixed_Masked
                  (X,
                   Y, {position of prompt}
                   L_left,
                   L_right {number of places to left and
                                 right of decimal point}
                   :integer;
                   Prompt:STRING;
                   Print_Prompt : Boolean; {show old value?}
                   VAR W : real);

PROCEDURE Read_Integer_Masked
                  (X,
                   Y, {position of prompt}
                   L {number of digits}
                     :integer;
                   Prompt
                     :STRING;
                   Print_Prompt {show old value?}
                     : Boolean;
                   VAR W {resultant value/or original one}
                     :  integer);


PROCEDURE Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);

function FileExists(fn:string):boolean;

IMPLEMENTATION

PROCEDURE NOISE(WhatSound:Sounds);
{This procedure was invented by Peter Sawatzki, [e-mail]
address current as of Sept 26, 1990 }

VAR i,j : Byte;

BEGIN
  CASE WhatSound OF
    Cont :
           BEGIN
             Sound(500);
             Delay(5);
           END;
    Good :
           BEGIN
             Sound(500);
             Delay(30);
           END;
    Bad  :
           BEGIN
             Sound(100);
             Delay(200);
             Sound(200);
             Delay(200);
             Sound(300);
             Delay(200);
           END;
    FinishedGood : FOR j := 1 TO 2 DO
                            FOR i := 1 TO 5 DO
                            BEGIN
                            Sound(500+i*200);
                         Delay(30);
                       END;
    FinishedBad  : FOR j := 1 TO 2 DO
                            FOR i := 1 TO 5 DO
                            BEGIN
                            Sound(200-i*20);
                         Delay(30);
                       END;
    Acknowledge   :
                    BEGIN
                      Sound(1000);
                      Delay(15);
                    END;
  END;
  NoSound;
END;

FUNCTION Read_Key: char;

VAR
  temp_var : char;

BEGIN
  Temp_var := ReadKey;
  PF := False; {this was not a PF key}
  IF Temp_var = #0
    THEN PF := True; {Oh Yes it was, so read again}
  IF PF
    THEN Temp_var := ReadKey;
  Escape_struck := False;
  IF Temp_var = #27
    THEN Escape_struck := True;
  Read_key := Temp_var;
END;

PROCEDURE Our_Write(X,Y:integer;s:STRING);
BEGIN  {effect is to terminate line properly without carriage return}
  GoToXY(X,Y);
  Write(s);
  ClrEol;
END;


FUNCTION YesNo(X,Y:integer;s:STRING): boolean;
BEGIN
  YesNo := False;
  REPEAT
    Our_Write(X,Y,s);
    Ch := Read_Key;
    Ch := UpCase(Ch);
    UNTIL Ch IN ['Y','N',#13];
    IF Ch = 'Y'
      THEN YesNo := True
      ELSE YesNo := False;
    GoToXY(X,Y);
    ClrEol;
END;

PROCEDURE Pause(x,y:integer;s:STRING);
BEGIN
  Our_Write(x,y,s);
  Ch := Read_Key;
  GoToXY(x,y);
  ClrEol;
END;

PROCEDURE CheckBrackets(Str:STRING;
                        VAR Err:Integer;  {Code for error <>0 means yes}
                        VAR Err_Message:STRING); {message string}

VAR
  i,k : integer;
BEGIN
  Err := 0;
  Err_Message := OK_Message;
  i := 0;
  FOR k := 1 TO Length(Str) DO
           BEGIN
           IF Str[k] = '('
           THEN inc(i)
        ELSE IF Str[k] = ')'
               THEN dec(i);
    END;
  IF i <> 0
    THEN
      BEGIN
        Err := 1;
        Err_Message := 'Brackets do not match.';
      END;
END;

PROCEDURE Remove_double_blanks(VAR Str:STRING);

VAR
  k : integer;
BEGIN
  k := POS('  ',Str);
  WHILE k > 0  DO
    BEGIN
      delete(Str,k,1);
      k := POS('  ',Str);
    END;
END;

PROCEDURE Remove_all_blanks(VAR Str:STRING);

VAR
  k_blank : integer;
BEGIN
  k_blank := POS(' ',Str);
  WHILE k_blank <> 0 DO
    BEGIN
      Delete(Str,k_blank,1);
      k_blank := POS(' ',Str);
    END;
END;

PROCEDURE Trim_fore_aft(VAR Str:STRING);
BEGIN
  WHILE Str[1] = ' ' DO
                 delete(Str,1,1);
  WHILE Str[Length(Str)] = ' ' DO
                           delete(Str,Length(Str),1);
END;

PROCEDURE PoseQuestion(line:INTEGER;question:STRING);

VAR
  k,kk,ypos  : Integer;
BEGIN {purpose is to write a question on the screen without splitting
                                                         words.}

  Remove_Double_blanks(question);
  GoToXY(1,line);
  k := 79;
  ypos := line;
  WHILE Length(question) > 79 DO
    BEGIN
      WHILE question[k]<>' ' DO
        dec(k); {find last blank less than 80
                                     characters in from r.h.s}
      IF k <2
        THEN
          BEGIN
            Pause(1,25,'Your text can not be split into 80 char units.');
            halt;
          END;
      FOR kk := 1 TO k DO
                Write(question[kk]); {write those characters}
      ClrEol;                          {clean up the rest of the line.}
      inc(ypos); {goto next line}
      GoToXY(1,ypos);
      IF k > 1
        THEN Delete(question,1,k); {delete part written out already}
    END;
  Write(question);
  ClrEol; {write the last section and clean up.}
END; {PoseQuestion}

FUNCTION Read_Eqn(X,Y,L:integer;s:STRING): STRING;

VAR
  Ichar : char;
  done  : Boolean;
  s1 : STRING;

  CONST
    CR = #13; {Carriage Return}
    BS = #8;  {Back Space}

BEGIN
  uc_var := UpCase(variable);
  IF variable = uc_var
    THEN
      lc_var := CHR(ORD(variable)+$20);
  s1 := '';
  done := False;
  Our_Write(X,Y,s);
  IChar := #0; {set to not carriage return }
  WHILE (Ichar <> CR) AND (Length(s1)<= L)
                                         DO {do not continue past the Carriage Return}
                                         BEGIN
                                         REPEAT
                                           IChar := Read_Key; {get a character }
                                           IF Escape_Struck
                                             THEN
                                               BEGIN
                                                 s1 := '';
                                                 GoToXY(X,Y);
                                                 ClrEol;
                                                 exit;
                                               END;
                                           UNTIL Ichar IN ['0'..'9','.',
                                           { legal numerics }
                                           CR,
                                           { line terminator and end }
                                           BS,
                                           { back space, erase last char }
                                           variable,
                                           { the global char used as variable }
                                           lc_var,
                                           uc_var,
                                           {upper / lower case versions of var }
                                           '+','-','/','*',          { allowed operators }
                                           '^',                      { power symbol }
                                           '(',')',                  { grouping symbols }
                                           '?'];
                                           { UNIVERSAL help symbol }
                                           IF Ichar = '?'
                                             THEN
                                               BEGIN
                                                 Read_Eqn := Ichar;
                                                 { ignore partial input and }
                                                 GoToXY(X,Y);
                                                 ClrEol;
                                                 exit;
                                                 {     leave this function }
                                               END
                                             ELSE
                                               IF Ichar = CR
                                                 THEN done := True
                                                        { do not append, signal finished }
                                                 ELSE
                                                   IF (Ichar = BS) AND (Length(s1) > 0 )
                                                      { deleteable? }
                                                     THEN delete(s1,length(s1),1)
                                                     ELSE s1 := s1 + Ichar;
                                           Our_Write(X,Y,s1);
                                         END;
  Read_Eqn := s1;
  GoToXY(X,Y);
  ClrEol;
END;

FUNCTION Read_Number(X,Y,L:integer;s:STRING): STRING;

VAR
  Ichar : char;
  done  : Boolean;
  s1 : STRING;

  CONST
    CR = #13; {Carriage Return}
    BS = #8;  {Back Space}

BEGIN
  uc_var := UpCase(variable);
  IF variable = uc_var
    THEN
      lc_var := CHR(ORD(variable)+$20);
  s1 := '';
  done := False;
  Our_Write(X,Y,s);
  IChar := #0; {set to not carriage return }
  WHILE (Ichar <> CR) AND (Length(s1)<= L)
                                         DO {do not continue past the Carriage Return}
                                         BEGIN
                                         REPEAT
                                           IChar := Read_Key; {get a character }
                                           IF Escape_Struck
                                             THEN
                                               BEGIN
                                                 s1 := '';
                                                 GoToXY(X,Y);
                                                 ClrEol;
                                                 exit;
                                               END;
                                           UNTIL Ichar IN ['0'..'9','.',
                                           { legal numerics }
                                           CR,
                                           { line terminator and end }
                                           BS,
                                           { back space, erase last char }
                                           variable,
                                           { the global char used as variable }
                                           lc_var,
                                           uc_var,
                                           {upper / lower case versions of var }
                                           '+','-','/','*',          { allowed operators }
                                           '^',                      { power symbol }
                                           '(',')',                  { grouping symbols }
                                           '?'];
                                           { UNIVERSAL help symbol }
                                           IF Ichar = '?'
                                             THEN
                                               BEGIN

                                                 GoToXY(X,Y);
                                                 ClrEol;
                                                 exit;
                                                 {     leave this function }
                                               END
                                             ELSE
                                               IF Ichar = CR
                                                 THEN done := True
                                                        { do not append, signal finished }
                                                 ELSE
                                                   IF (Ichar = BS) AND (Length(s1) > 0 )
                                                      { deleteable? }
                                                     THEN delete(s1,length(s1),1)
                                                     ELSE s1 := s1 + Ichar;
                                           Our_Write(X,Y,s1);
                                         END;
  Read_Number := s1;
  GoToXY(X,Y);
  ClrEol;
END;

FUNCTION Read_Masked_Number(X,Y:integer;s,mask:STRING): STRING;

VAR
  Ichar : char;
  done  : Boolean;
  s1 : STRING;
  L : Integer;

  CONST
    CR = #13; {Carriage Return}
    BS = #8;  {Back Space}

BEGIN
  uc_var := UpCase(variable);
  IF variable = uc_var
    THEN
      lc_var := CHR(ORD(variable)+$20);
  s1 := '';
  done := False;
  Our_Write(X,Y,s);
  L := Length(mask);
  IChar := #0; {set to not carriage return }
  WHILE (Ichar <> CR) AND (Length(s1)   <= L )
                                            DO {do not continue past the Carriage Return}
                                            BEGIN
                                            REPEAT
                                              IChar := Read_Key; {get a character }
                                              IF Escape_Struck
                                                THEN
                                                  BEGIN
                                                    s1 := '';
                                                    GoToXY(X,Y);
                                                    ClrEol;
                                                    exit;
                                                  END;
                                              UNTIL Ichar IN ['0'..'9','.',
                                           { legal numerics }
                                              CR,
                                           { line terminator and end }
                                              BS,
                                           { back space, erase last char }
                                              '^'];                     { power symbol }

                                              IF Ichar = CR
                                                THEN done := True
                                                        { do not append, signal finished }
                                                ELSE
                                                  IF (Ichar = BS) AND (Length(s1) > 0 )
                                                  { deleteable? }
                                                    THEN delete(s1,length(s1),1)
                                                    ELSE s1 := s1 + Ichar;
                                              Our_Write(X,Y,mask);
                                              Our_Write(X,Y+L+1,s1);
                                            END;
  Read_Masked_Number := s1;
  GoToXY(X,Y);
  ClrEol;
END;

FUNCTION Read_Equation(X,Y,L:integer;s:STRING;char_set:set_of_char): STRING;

VAR
  Ichar : char;
  done  : Boolean;
  s1 : STRING;
  operating_char_set : set_of_char;

  CONST
    CR = #13; {Carriage Return}
    BS = #8;  {Back Space}

BEGIN
  operating_char_set := ['0'..'9','.', { legal numerics }
                        CR,                       { line terminator and end }
                        BS,                       { back space, erase last char }
                        variable,                 { the global char used as variable }
                        lc_var,
                        uc_var,                   {upper / lower case versions of var }
                        '+','-','/','*',          { allowed operators }
                        '^',                      { power symbol }
                        '(',')',                  { grouping symbols }
                        '?'] + char_set;
  uc_var := UpCase(variable);
  IF variable = uc_var
    THEN
      lc_var := CHR(ORD(variable)+$20);
  s1 := '';
  done := False;
  Our_Write(X,Y,s);
  IChar := #0; {set to not carriage return }
  WHILE (Ichar <> CR) AND (Length(s1) <= L)
                                          DO {do not continue past the Carriage Return}
                                          BEGIN
                                          REPEAT
                                            IChar := Read_Key; {get a character }
                                            IF Escape_Struck
                                              THEN
                                                BEGIN
                                                  s1 := '';
                                                  GoToXY(X,Y);
                                                  ClrEol;
                                                  exit;
                                                END;
                                            UNTIL Ichar IN operating_char_set;

                                            IF Ichar = '?'
                                              THEN
                                                BEGIN
                                                  Read_Equation := Ichar;
                                                 { ignore partial input and }
                                                  GoToXY(X,Y);
                                                  ClrEol;
                                                  exit;
                                                 {     leave this function }
                                                END
                                              ELSE
                                                IF Ichar = CR
                                                  THEN done := True
                                                        { do not append, signal finished }
                                                  ELSE
                                                    IF (Ichar = BS) AND (Length(s1) > 0 )
                                                      { deleteable? }
                                                      THEN delete(s1,length(s1),1)
                                                      ELSE s1 := s1 + Ichar;
                                            Our_Write(X,Y,s1);
                                          END;
  Read_Equation := s1;
  GoToXY(X,Y);
  ClrEol;
END;

{ From: "Chunqing N. Cheng" <[e-mail]>
(edited enclosure message follows)
The TechnoJock Toolkit is so lousy on real numbers, it
cannot show them correctly.  It just shows very small number as all
bunches of zero's.

For me, an engineer, a program should accept a real number just like
a computer without keyboard.  So, I started to modify the code.
The following is the modified part, with the capability to

1.  display a real number smartly.  I mean that if it cannot fit
  in normal way, it goes to scientific format automatically.
  So, you do not need separately procedure for this.

2.  Accept scientific format.

3.  retain others in original way, (hopefully).

}

FUNCTION inttoStr(i:longint): STRING;

VAR
  s: STRING[11];
BEGIN
  str(i,s);
  inttostr := s;
END;

FUNCTION Real_to_str(Number:real;Decimals:byte): STRING;

VAR Temp : STRING;
  i: byte;
  sign : STRING[1];
  power: word;

FUNCTION Strip(left_right,character : char;VAR s:STRING): STRING;
BEGIN
  IF UpCase(left_right) = 'R'
    THEN
      WHILE s[length(s)] = character DO
                           s := copy (s,1,length(s)-1)
      ELSE IF UpCase(left_right) = 'L'
             THEN
               WHILE s[1] = character DO
                            s := copy(s,2,length(s));
  strip := s;
  END;


CONST
  Floating : byte = 3;

VAR
  Width : Integer;
  t1 : real;
BEGIN
  Real_to_Str := '';
  IF abs(number)>0.
    THEN t1 := ln(ABS(number))/2.303
    ELSE exit;
  Width := abs(TRUNC(t1));
  IF number > -1.E+11
    THEN {will fit in eleven decimal digits when
                            made into a string, what about Planck's
                                        constant?}
      Str(Number:Width+Decimals:11
                                {max for TURBO},
                                Temp);
  REPEAT
       IF copy(Temp,1,1) = ' '
         THEN delete(Temp,1,1);
    UNTIL copy(temp,1,1) <> ' ';
    Real_to_Str := Temp;
    IF Decimals+7 < Width
      THEN
        BEGIN
          Temp := Strip('R','0',Temp);
          IF Temp[Length(temp)] = '.'
            THEN
              Delete(temp,Length(temp),1);
          IF ((Temp='0') AND (Number<>0)) OR (abs(number)>1.0E12)
             OR ((Temp='-0') AND (Number<>0))
            THEN
              BEGIN
                sign := '';
                IF number<0
                  THEN sign := '-';
                number := abs(number);
                power := 0;
                IF number<1
                  THEN
                    BEGIN
                    REPEAT
                      power := power+1;
                      number := number*10;
                      UNTIL number >= 1;
                      IF sizeof(number)=6
                        THEN Str(Number:20:12,Temp)
                               ELSE Str(Number:20:8,Temp);
                    REPEAT
                      IF copy(Temp,1,1) = ' '
                        THEN delete(Temp,1,1);
                      UNTIL copy(temp,1,1) <> ' ';
                      Temp := Sign+Strip('R','0',Temp)+'E-'+inttoStr(power);
                    END
                  ELSE
                    BEGIN
                    REPEAT
                      power := power+1;
                      number := number/10;
                      UNTIL number<10;
                      IF sizeof(number)=6
                        THEN Str(Number:20:12,Temp)
                        ELSE Str(Number:20:8,Temp);
                    REPEAT
                      IF copy(Temp,1,1) = ' '
                        THEN delete(Temp,1,1);
                      UNTIL copy(temp,1,1) <> ' ';
                      Temp := Sign+Strip('R','0',Temp)+'E'+inttoStr(power);
                    END;
              END;
          Real_to_Str := Temp;
        END;
END;

{================================================}

PROCEDURE Read_Line(X, {x-position of cursor at outset}
                    Y, {y-position of cursor at outset}
                    L_left,
                    L_right  {number of places to right of decimal point}
                    :integer;
                    VAR Text {resultant character representation
                             of the number                     }
                    :STRING);

CONST
  CursorRight = #77;
  CursorLeft = #75;
  Home_Key = #71;
  End_Key = #79;
  Ins_Key = #82;
  Del_Key = #83;
  BackSpace = #15;
  Esc_Key = #27;
  Enter_Key = #13;

VAR
  k_digits,Where_sign,
  Cursor_X,Cursor_Y,CursorPos : byte;
  Insert,InsertMode,FirstCharPress,AllDone: Boolean;
  Ch : Char;
  TempText : STRING;

PROCEDURE WriteString;
BEGIN
  GoToXY(Cursor_X,Cursor_Y);
  Write(TempText);
  ClrEol;
  GoToXY(Cursor_X+CursorPos-1,Cursor_Y);
END;

PROCEDURE InsertChar;

VAR
  TempCh : Char;
BEGIN
  TempText[CursorPos] := Ch;
  IF CursorPos < Length(TempText)
    THEN
      BEGIN
        CursorPos := succ(CursorPos);
        TempCh := TempText[CursorPos];
        IF (TempCh = '.') OR
           (TempCh = '+' ) OR
           (TempCh = '-' ) OR
           (TempCh = 'E' )
          THEN CursorPos := succ(CursorPos);
      END;
END;

BEGIN                  {main Procedure Read_Line}
  FirstCharPress := false;
  Cursor_X := WhereX;
  Cursor_Y := WhereY;{mark end of prompt}
  CursorPos := 2;
  Insert := False;
  AllDone := False;
  IF L_left = 0
    THEN
      BEGIN
        IF L_right > 0
          THEN
            BEGIN
              TempText := '+0.y';
              FOR k_digits := 2 TO L_right DO
                              TempText := TempText + 'y';
              TempText := TempText+'E+00';
              Where_sign := Length(TempText)-2;
            END
          ELSE {trick for doing integer reads}
            BEGIN
              TempText := ' 0';
              FOR k_digits := 2 TO abs(L_right) DO
                              TempText := TempText+'0';
              L_right := abs(L_right);
              Where_sign := 0;
            END;
      END
    ELSE
      BEGIN {fixed read}
        TempText := ' ';
        FOR k_digits := 1 TO L_left DO
                        TempText := TempText + 'x';
        TempText := TempText + '.';
        FOR k_digits := 2 TO L_right DO
                        TempText := TempText + 'y';
      END;
  WriteString;

  FirstCharPress := true;
  REPEAT
       Ch := ReadKey;
       IF Ch = #0 {this was a function key pressed}
         THEN Ch := ReadKey; {cursor pad}
       Ch := upcase(Ch);
       IF Ch IN [Esc_Key,Enter_Key]
         THEN
           BEGIN
             AllDone := True;
             IF CH = Esc_Key
               THEN
                 BEGIN
                   Escape_Struck := True;
                   exit;
                 END
               ELSE
                 IF Ch <> Esc_Key
                   THEN
                     BEGIN
                       FOR CursorPos := 1 TO Length(TempText) DO
                                        IF  (TempText[CursorPos] =
                                        'y') OR
                                          (TempText[CursorPos] =
                                        'x')
                                        THEN TempText[CursorPos] := '0';{clean
                                                             up mask}

                       Text := TempText;
                     END;
           END {of carriage return or escape}
         ELSE
           CASE Ch OF
             CursorRight   :
                             BEGIN
                                IF CursorPos < length(TempText)
                                  THEN
                                    BEGIN
                                      CursorPos := Succ(CursorPos);
                                      IF (TempText[CursorPos] = '.') OR
                                         (TempText[CursorPos] = 'E')
                                        THEN
                                          CursorPos := Succ(CursorPos);
                                      GoToXY(Cursor_X + CursorPos,Cursor_Y);
                                    END
                                  ELSE
                                    Noise(Bad);
                             END;
             CursorLeft    :
                             BEGIN
                                IF CursorPos > 1
                                  THEN
                                    BEGIN
                                      CursorPos := Pred(CursorPos);
                                      IF (TempText[CursorPos] = '.') OR
                                         (TempText[CursorPos] = 'E')
                                        THEN
                                          CursorPos := Pred(CursorPos);
                                      GoToXY(Cursor_X + CursorPos,Cursor_Y);
                                    END
                                  ELSE
                                    Noise(Bad);
                             END;
             Home_Key       :
                              BEGIN
                                 CursorPos := 1;
                                 GoToXY(Cursor_X+CursorPos,Cursor_Y);
                              END;
             End_Key        :
                              BEGIN
                                 CursorPos := Length(TempText);
                                 GoToXY(Cursor_X + CursorPos,Cursor_Y);
                              END;

             BackSpace    :       {Char_Backspace, treat as cursor}
                              BEGIN
                                IF CursorPos > 1
                                  THEN
                                    BEGIN
                                      CursorPos := Pred(CursorPos);
                                      IF (TempText[CursorPos] = '.') OR
                                         (TempText[CursorPos] = 'E')
                                        THEN
                                          CursorPos := Pred(CursorPos);
                                      GoToXY(Cursor_X + CursorPos,Cursor_Y);
                                    END
                                  ELSE
                                    Noise(Bad);
                             END;
             Esc_Key        :   Alldone := true;
             Enter_Key      :
                              BEGIN
                                 Alldone := true;
                                 IF Ch <> Esc_Key
                                   THEN
                                     BEGIN
                                       FOR CursorPos := 1 TO Length(TempText) DO
                                                        IF  (TempText[CursorPos] =
                                                        'y') OR
                                                        (TempText[CursorPos] =
                                                        'x')
                                                        THEN TempText[CursorPos] := '0';
                                       {clean
                                                             up mask}
                                        END;
                                 Text := TempText;
                              END;
             #43          :
                            BEGIN {plus sign}
                              IF (CursorPos = 1) OR (CursorPos =Where_sign )
                                    THEN
                                      InsertChar;
                            END;
             #45          :
                            BEGIN {minus sign}
                              IF (CursorPos = 1) OR (CursorPos =Where_sign )
                                THEN
                                  InsertChar;
                            END;

             #48..#57,' ' :
                            BEGIN {digits, 0 to 9}
                              IF Ch = ' '
                                THEN Ch := '0';
                                IF (CursorPos <> 1) AND
                                   (CursorPos <= Length(TempText)) AND
                                   (CursorPos <> Where_sign ) AND
                                   (TempText[CursorPos] <> '.') AND
                                   (TempText[CursorPos] <> 'E')
                                  THEN
                                    InsertChar;
                              END;
             '.'            : ;
           ELSE Noise(Bad);
    END; {case}
    FirstCharPress := false;
    WriteString;

    UNTIL Alldone;

END;  {Proc Read_Line}

PROCEDURE Read_Float_Masked
                  (X,
                   Y, {position of prompt}
                   L {number of places to right of decimal point}
                   :integer;
                   Prompt:STRING;
                   Print_Prompt : Boolean; {show old value?}
                   VAR W : real);

VAR
  Temp : Real;
  Txt : STRING;
  Valid : boolean;
  Code : integer;
  YT : byte;
  ChR : char;
BEGIN
  Txt := '';
  IF W <> 0.0
    THEN Txt := Real_To_Str(W,L);

  IF Print_Prompt AND (Txt <> '')
    THEN
          Prompt := Prompt + '(old = '+Txt+'):';
  Temp := W;
  Valid := false;
  REPEAT
    GoToXY(X,Y);
    ClrEol;
    GoToXY(X,Y);
    Write(Prompt);
    Read_Line(X,Y,0,L,Txt);
    IF Escape_Struck {the person hit the escape key}
      THEN exit
      ELSE
        BEGIN
    {$R-}
          val(Txt,Temp,code);
    {$R+}
          IF code <> 0
            THEN
              BEGIN
                noise(bad);
                delay(1000);
              END
            ELSE
              BEGIN
                W := Temp; {accept as OK number}
                Valid := true;
              END;
        END;
    UNTIL valid ;
END;

PROCEDURE Read_Fixed_Masked
                  (X,
                   Y, {position of prompt}
                   L_left,
                   L_right {number of places to left and
                                 right of decimal point}
                   :integer;
                   Prompt:STRING;
                   Print_Prompt : Boolean; {show old value?}
                   VAR W : real);

VAR
  Temp : Real;
  Txt : STRING;
  Valid : boolean;
  Code : integer;
  YT : byte;
  ChR : char;
BEGIN
  Txt := '';
  IF W <> 0
    THEN Txt := Real_To_Str(W,L_left+L_right);

  IF Print_Prompt AND (Txt <> '')
    THEN
          Prompt := Prompt + '(old = '+Txt+'):';
  Temp := W;
  Valid := false;
  REPEAT
    GoToXY(X,Y);
    ClrEol;
    GoToXY(X,Y);
    Write(Prompt);
    Read_Line(X,Y,L_left,L_right,Txt);
    IF Escape_Struck {the person hit the escape key}
      THEN exit
      ELSE
        BEGIN
    {$R-}
          val(Txt,Temp,code);
    {$R+}
          IF code <> 0
            THEN
              BEGIN
                noise(bad);
                delay(1000);
              END
            ELSE
              BEGIN
                W := Temp; {accept as OK number}
                Valid := true;
              END;
        END;
    UNTIL valid ;
END;

PROCEDURE Read_Integer_Masked
                  (X,
                   Y, {position of prompt}
                   L {number of digits}
                   :integer;
                   Prompt:STRING;
                   Print_Prompt : Boolean; {show old value?}
                   VAR W : integer);

VAR
  Temp : Integer;
  Txt : STRING;
  Valid : boolean;
  Code : integer;
  YT : integer;
  ChR : char;
BEGIN
  Txt := '';
  IF W <> 0
    THEN Txt := IntToStr(W);

  IF Print_Prompt AND (Txt <> '')
    THEN
          Prompt := Prompt + '(old = '+Txt+'):';
  Temp := W;
  Valid := false;
  REPEAT
    GoToXY(X,Y);
    ClrEol;
    GoToXY(X,Y);
    Write(Prompt);
    YT := -L;
    Escape_Struck := False;
    Read_Line(X,Y,0,YT,Txt);{use this trick to force integer}
    IF Escape_Struck {the person hit the escape key}
      THEN exit
      ELSE
        BEGIN
    {$R-}
          val(Txt,Temp,code);
    {$R+}
          IF code <> 0
            THEN
              BEGIN
                noise(bad);
                delay(1000);
              END
            ELSE
              BEGIN
                W := Temp; {accept as OK number}

                Valid := true;
              END;
        END;
    UNTIL valid ;
END;

PROCEDURE Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);

VAR  I : Integer;

BEGIN {Frame}
  GotoXY(UpperLeftX, UpperLeftY);
  Write(chr(218));
  FOR I := (UpperLeftX + 1) TO (LowerRightX - 1) DO
           BEGIN
           Write(chr(196));
    END;
  Write(chr(191));
  FOR I := (UpperLeftY + 1) TO (LowerRightY - 1) DO
           BEGIN
           GotoXY(UpperLeftX , I);
      Write(chr(179));
      GotoXY(LowerRightX, I);
      Write(chr(179));
    END;
  GotoXY(UpperLeftX, LowerRightY);
  Write(chr(192));
  FOR I := (UpperLeftX + 1) TO (LowerRightX - 1) DO
           BEGIN
           Write(chr(196));
    END;
  Write(chr(217));
END; {Frame}
function FileExists(fn:string):boolean;
var
  f : file;
begin
{$I-}
  assign(f,fn);
  reset(f);
  close(f);
  {$I+}
  FileExists := (IOResult = 0) and (fn<>'');
end;
END.