Power-Programmierung/CD1.mdf/pascal/library/dos/io/io_23/io23unit.pas

Pascal/Delphi Source File | 1988-03-20 | 36.7 KB | 1,063 lines

{ IO23UNIT.PAS -- Global I/O procedures to include in programs generally
  by Bill Meacham
  Ver 2.0 -- includes prev_page and next_page, changes where pause text
             is displayed -- 2/26/86.
             Cosmetic improvements -- 4/16/86.
  Ver 2.l -- Add function Pad -- 10/12/86.
  Ver 2.2 -- Add ability to move cursor within input line -- 5/24/87.
  Ver 2.3 -- Add proc buzz, error_buzz; add buzzes to read routines.
             Converted to Turbo 4.0 -- 12/2/87
             Converted to a Unit -- 12/2/87
             Fixed bug in ReadReal -- 1/3/88 -- TP4 cannot handle a trailing
             decimal point where TP3 could
             Added home-key and end_key -- 1/24/88
             Fixed bug in Read_Int -- 2/18/88
             Added Read_longint and write_longint -- 3/19/88 }

{ -------------------------------------------------------------------------- }

unit io23unit ;
{$v-}
interface

uses
    crt ;

const
                       { ASCII values of cursor control keys, like WordStar. }
    null      = $00 ;
    prev_char = $13 ;  { ^S }
    next_char = $04 ;  { ^D }
    home_key  = $01 ;  { ^A }
    end_key   = $06 ;  { ^F }
    prev_fld  = $05 ;  { ^E }
    next_fld  = $18 ;  { ^X }
    prev_page = $12 ;  { ^R }
    next_page = $03 ;  { ^C }
    del_char  = $07 ;  { ^G }
    del_left  = $08 ;  { ^H (Backspace) }
    del_fld   = $19 ;  { ^Y }
    del       = $7F ;  { Delete }
    escape    = $1B ;
    carr_rtn  = $0D ;
    space     = $20 ;
    filler    = $5F ;  { _ }

type
    str1      = string[1] ;
    str14     = string[14] ;
    str_type  = string[80] ;

    intset = set of $00 .. $FF ;

const  { Turbo typed constants -- initialized variables }
    terminating : intset = [carr_rtn,next_fld,prev_fld,escape,next_page,prev_page] ;
    adjusting   : intset = [prev_char,next_char,home_key,end_key,del_char,del_fld,del_left] ;

var
    fld, scrn   : integer ; { For field & screen cursor control }

procedure clrline (col,row : byte) ;
  { clears to end of line }
procedure beep ;
  { sounds bell }
procedure buzz (pitch,duration : integer) ;
  { makes a sound }
procedure error_buzz ;
  { makes a particular sound }
procedure do_fld_ctl (key : integer) ;
  { Adjusts global FLD based on value of key, ORD of last key pressed }
procedure do_scrn_ctl ;
  { Checks value of FLD and adjusts value of SCRN accordingly }
procedure write_str (st:str_type ; col,row:byte) ;
  { writes a string on screen at column and row specified }
procedure write_int (int:integer ; width,col,row:byte) ;
  { writes an integer }
procedure write_longint (lint:longint ; width,col,row:byte) ;
  { writes a long integer }
procedure set_bool (var bool : boolean) ;
  { sets boolean to undefined, neither true nor false }
function defined (bool : boolean) : boolean ;
  { whether boolean is defined }
procedure write_bool (bool:boolean ; col, row:byte) ;
  { writes a boolean as 'YES' or 'NO' }
procedure write_real (r:real ; width,frac,col,row:byte) ;
  { writes a real }
procedure keyin (var ch:char) ;
  { Reads a single character from keyboard without echoing it back.
    Maps function key scan codes to single keyboard keys. }
function build_str (ch : char ; n : integer) : str_type ;
  { returns a string of length n of the character ch }
function pad (st : str_type ; ch : char ; i : integer) : str_type ;
  { Pad string with ch to length of i.
    Do not let i exceed 80 (length of str_type! }
function purgech (instr : str_type ; inchar : char) : str_type ;
  { Purges all instances of the character from the string }
function stripch (instr:str_type ; inchar:char) : str_type ;
  { Strips leading instances of the character from the string }
function chopch (instr:str_type ; inchar:char) : str_type ;
  { Chops trailing instances of the character from the string }
procedure read_str (var st:str_type ; maxlen, col, row:byte) ;
  { Read String.  This procedure gets input from the keyboard one
    character at a time and edits on the fly, rejecting invalid
    characters.  COL and ROW tell where to begin the data input
    field, and MAXLEN is the maximum length of the string to be
    returned. }
procedure read_int (var int:integer ; maxlen, col, row:byte) ;
  { Read Integer.  This procedure gets input from the keyboard
    one character at a time and edits on the fly, rejecting
    invalid characters.  COL and ROW tell where to begin the data
    input field, and MAXLEN is the maximum length of the integer
    to be returned. }
procedure read_longint (var lint:longint ; maxlen, col, row:byte) ;
  { Read Long Integer.  Just like read_int. }
function equal (r1,r2 : real) : boolean ;
  { Tests functional equality of two real numbers.
    True if r1 = r2. }
function greater (r1,r2 : real) : boolean ;
  { Tests functional inequality of two real numbers.
    True if r1 > r2. }
procedure read_real (var r:real ; maxlen,frac,col,row:byte) ;
  { Read Real.  This procedure gets input from the keyboard
    one character at a time and edits on the fly, rejecting
    invalid characters.  COL and ROW tell where to begin the data
    input field; MAXLEN is the maximum length of the string
    representation of the real number, including sign and decimal
    point; FRAC is the fractional part, the number of digits to
    right of the decimal point. }
procedure read_yn (var bool:boolean; col,row:byte) ;
  { Inputs "Y" OR "N" to boolean at column and row specified,
    prints "YES" or "NO."
    Note -- use this when the screen control will not return
    to the question and the boolean IS NOT defined before the
    user answers the question.  Does not affect global FLD. }
procedure read_bool (var bool:boolean; col,row:byte) ;
  { Displays boolean at column and row specified, inputs "Y"
    or "N" to set new value of boolean, prints "YES" or "NO."
    Boolean is "forced;" user cannot cursor forward past undefined
    boolean.  Pressing "Y" or "N" terminates entry. }
procedure pause ;
  { Prints message on bottom line, waits for user response. }
procedure hard_pause ;
  { Like Pause, but only accepts space bar or Escape and only goes forward }
procedure show_msg (msg : str_type) ;
  { Beeps, displays message centered on line 23, pauses }

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

implementation

{ procedure gotoxy (col,row) ; -- Built-in proc in Turbo to place
  cursor on screen.  Upper left is (1,1) not (0,0)! }

{ procedure clrscr ; -- Built-in proc in Turbo to clear screen. }

{ procedure clreol ; -- built-in proc in Turbo to clear to end of line }

{ -------------------------------------------------------------------------- }

procedure clrline (col,row : byte) ;
    begin
        gotoxy (col,row) ;
        clreol
    end ;

{ -------------------------------------------------------------------------- }

procedure beep ;
    begin
        write (chr(7))
    end ;

{ -------------------------------------------------------------------------- }

procedure buzz (pitch,duration : integer) ;
  begin
    sound(pitch) ;
    delay(duration) ;
    nosound
  end ;

{ -------------------------------------------------------------------------- }

procedure error_buzz ;
  begin
    buzz (50,100)
  end ;

{ -------------------------------------------------------------------------- }

procedure do_fld_ctl (key : integer) ;
  { Adjusts global FLD based on value of key, the ordinal value of last key pressed }
  { global
        fld : integer -- for field cursor control }
    begin
        case key of
          carr_rtn, next_fld : fld := succ(fld) ;
          prev_fld           : fld := pred(fld) ;
          next_page          : fld := 999 ;
          prev_page          : fld := -999 ;
          escape             : fld := maxint ;
        end  { case }
    end ;  { proc do_fld_ctl }

{ ------------------------------------------------------------ }

procedure do_scrn_ctl ;
  { Checks value of FLD and adjusts value of SCRN accordingly }
  { Global
        fld, scrn : integer -- For field and screen cursor control }
    begin
        if fld < 1 then
                scrn := pred(scrn)
        else if fld = maxint then
                scrn := maxint
        else
                scrn := succ(scrn)
    end ;

{ ------------------------------------------------------------ }

procedure write_str (st:str_type ; col,row:byte) ;
    begin
        gotoxy (col,row) ;
        write (st)
    end ;

{ -------------------------------------------------------------------------- }

procedure write_int (int:integer ; width,col,row:byte) ;
    begin
        gotoxy (col,row) ;
        write (int:width)
    end ;

{ -------------------------------------------------------------------------- }

procedure write_longint (lint:longint ; width,col,row:byte) ;
    begin
        gotoxy (col,row) ;
        write (lint:width)
    end ;

{ -------------------------------------------------------------------------- }

procedure set_bool (var bool : boolean) ;
  { Sets boolean to be undefined, neither true nor false.
    Boolean is stored as one byte:
        $80 = undefined
        $01 = true
        $00 = false.
    Note : Turbo interprets $80 as true because it is greater than zero! }

    var
        b : byte absolute bool ;
    begin
        b := $80
    end ;  { proc set_bool }

{ -------------------------------------------------------------------------- }

function defined (bool : boolean) : boolean ;
  { Determines whether the boolean is defined or not }
    var
        b : byte absolute bool ;
    begin
        defined := not (b = $80)
    end ;  { function defined }

{ -------------------------------------------------------------------------- }

procedure write_bool (bool:boolean ; col, row:byte) ;
    begin
        gotoxy (col,row) ;
        if not defined(bool) then
            write ('___')
        else if bool then
            write ('YES')
        else
            write ('NO ')
    end ;

{ -------------------------------------------------------------------------- }

procedure write_real (r:real ; width,frac,col,row:byte) ;
    begin
        gotoxy (col,row) ;
        write (r:width:frac)
    end ;

{ -------------------------------------------------------------------------- }

procedure keyin (var ch:char) ;
{ Reads a single character from keyboard without echoing it back.
  Maps function key scan codes to single keyboard keys.
  From Turbo 3.0 manual, page 360 -- 5/29/85
  Modified for IO20 -- 2/26/86
  Modified for IO23 -- 5/24/87
  Modified for Turbo 4.0 -- 11/26/87 }

    var
        func : boolean ;     { Whether function key or not }
           c : char ;        { Character read }
         key : integer ;     { ORD of character returned }

    begin
        func := false ;
        c := readkey ;                    { Get first char }
        if  (ord(c) = null) then          { If there is a second ... }
          begin
            c := readkey ;                { Get 2nd char }
            func := true
          end ;
        key := ord(c) ;

        if func then                      { Translate function keys }
            case key of
              63,75 : key := prev_char ;  { F5, left-arrow }
              64,77 : key := next_char ;  { F6, right-arrow }
              71    : key := home_key ;   { Home }
              79    : key := end_key ;    { End }
              61,72 : key := prev_fld ;   { F3, up-arrow }
              62,80 : key := next_fld ;   { F4, down-arrow }
              65,73 : key := prev_page ;  { F7, PgUp }
              66,81 : key := next_page ;  { F8, PgDn }
              59,83 : key := del_char ;   { F1, DEL }
              60    : key := del_fld ;    { F2 }
            else      key := 00 ;
            end  { case }
        else  { not a function key }
            case key of                   { CP/M-like control keys }
              $0B   : key := prev_fld ;   { ^K }
              $0A   : key := next_fld ;   { ^J }
              $0C   : key := next_char ;  { ^L }
            end ;  { case }

        ch := chr(key)                    { finally, return the character }
    end ; { procedure keyin }

{ ------------------------------------------------------------ }

function build_str (ch : char ; n : integer) : str_type ;
  { returns a string of length n of the character ch }
    var
        st : str_type ;
    begin
        if n < 0 then
            n := 0 ;
        st[0] := chr(n) ;
        fillchar (st[1],n,ch) ;
        build_str := st
    end ;  { function build_str) ;

{ -------------------------------------------------------------------------- }

function pad (st : str_type ; ch : char ; i : integer) : str_type ;
{ Pad string with ch to length of i.  Do not let i exceed 80 (length of str_type! }
  var
    l : integer ;
  begin
    l := length(st) ;
    if l < i then
      begin
        fillchar (st[l+1],i-l,ch) ;
        st[0] := chr(i)
      end ;
    pad := st
  end;

{ ------------------------------------------------------------ }

procedure adjust_str (var st : str_type ;
                      var  p : byte ;     { position of char to left of cursor }
                         key,             { ord of adjusting character }
            maxlen, col, row : byte ) ;
  { Adjusts position of cursor within string, deletes characters, etc. }
    begin
      case key of
        home_key  : p := 0 ;
        end_key   : p := length(st) ;
        prev_char : if p > 0 then
                        p := pred(p)
                    else
                        error_buzz ;
        next_char : if p < length(st) then
                        p := succ(p)
                    else
                        error_buzz ;
        del_left  : if p > 0 then
                      begin
                        delete (st,p,1) ;
                        write (^H,copy(st,p,maxlen),chr(filler)) ;
                        p := pred(p)
                      end
                    else
                        error_buzz ;
        del_char  : if p < length(st) then
                      begin
                        delete (st,p+1,1) ;
                        write (copy(st,p+1,maxlen),chr(filler))
                      end
                    else
                        error_buzz ;
        del_fld   : begin
                      st := '' ;
                      p := 0  ;
                      write_str (build_str(chr(filler),maxlen),col,row)
                    end
      end  { case }
    end ; { proc adjust_str }

{ -------------------------------------------------------------------------- }

function purgech (instr : str_type ; inchar : char) : str_type ;
    {Purges all instances of the character from the string}
    var
        n      : integer ;  {Loop counter}
        outstr : str_type ; {Result string}

    begin
        outstr := '' ;
        for n := 1 to length (instr) do
                if not (instr[n] = inchar) then
                        outstr := concat (outstr, instr[n]) ;
        purgech := outstr
    end ;

{ -------------------------------------------------------------------------- }

function stripch (instr:str_type ; inchar:char) : str_type ;
    {Strips leading instances of the character from the string}
    begin
        while not (length(instr) = 0)
        and (instr[1] = inchar) do
                delete (instr, 1, 1) ;
        stripch := instr
    end ;

{ -------------------------------------------------------------------------- }

function chopch (instr:str_type ; inchar:char) : str_type ;
    {Chops trailing instances of the character from the string}
    begin
        while not (length(instr) = 0)
        and (instr[length(instr)] = inchar) do
                delete (instr, length(instr), 1) ;
        chopch := instr
    end ;

{ -------------------------------------------------------------------------- }

procedure read_str (var st:str_type ; maxlen, col, row:byte) ;

  { Read String.  This procedure gets input from the keyboard one
    character at a time and edits on the fly, rejecting invalid
    characters.  COL and ROW tell where to begin the data input
    field, and MAXLEN is the maximum length of the string to be
    returned.

    Revised 6/04/85 -- WPM }

    var
        ch   : char ;     { character from keyboard }
        key  : integer ;  { ord(ch) }
        p    : byte ;     { position of char to left of cursor }

    procedure add_to_str ;
        begin
          if not (length(st) = maxlen) then
            begin
              p := p + 1 ;
              insert (ch,st,p) ;
              write (copy(st,p,maxlen))
            end
          else
              error_buzz
        end ; {--- of add_to_str ---}

    begin {--- read_str ---}
        write_str (st, col, row) ;
        write (build_str(chr(filler),maxlen - length(st))) ;
        p := length(st) ;
        repeat
            gotoxy (col + p, row) ;
            keyin (ch) ;
            key := ord(ch) ;
            if key in [$20 .. $7E] then  { printable character }
                add_to_str
            else if key in adjusting then
                adjust_str (st,p,key,maxlen,col,row)
            else if key in terminating then
                do_fld_ctl (key)
            else
                error_buzz
        until key in terminating ;
        gotoxy (col + length(st), row) ;
        write ('':maxlen - length(st))
    end ; {--- of read_str ---}

{ -------------------------------------------------------------------------- }

procedure read_int (var int:integer ; maxlen, col, row:byte) ;

  { Read Integer.  This procedure gets input from the keyboard
    one character at a time and edits on the fly, rejecting
    invalid characters.  COL and ROW tell where to begin the data
    input field, and MAXLEN is the maximum length of the integer
    to be returned.

    Revised 6/04/85 -- WPM }

    const
        maxst : string[5] = '32767' ;  { string representation of maxint }

    var
        ch    : char ;       { character from keyboard }
        key   : integer ;    { ord(ch) }
        p     : byte ;       { position of char to left of cursor }
        st    : string[5] ;  { string representation of integer }
        code  : integer ;    { result of string to integer conversion }

    procedure add_to_str ;
        begin
          if not (length(st) = maxlen) then
            begin
              p := p + 1 ;
              insert (ch,st,p) ;
              write (copy(st,p,maxlen))
            end
          else
              error_buzz
        end ; {--- of add_to_str---}

    begin {--- read_int ---}
        str (int:maxlen, st) ;          { convert integer into string }
        st := purgech (st, ' ') ;
        st := stripch (st, '0') ;
        write_str (st, col, row) ;
        write (build_str(chr(filler),maxlen - length(st))) ;
        p := length(st) ;
        repeat
            gotoxy (col + p, row) ;
            keyin (ch) ;
            key := ord(ch) ;
            if key = $2D then                 { minus sign }
              begin
                if  (pos('-',st) = 0)
                and (length(st) < maxlen)
                and (p = 0) then
                    add_to_str
                else
                    error_buzz
              end
            else if key in [$30 .. $39] then  {digits 0 - 9}
              begin
                add_to_str ;
                if (length(st) = 5)
                and (st > maxst) then
                  begin
                    delete (st,p,1) ;
                    write (^H,copy(st,p,maxlen),chr(filler)) ;
                    p := p - 1 ;
                    error_buzz
                  end
              end
            else if key in adjusting then
                adjust_str (st,p,key,maxlen,col,row)
            else if key in terminating then
                do_fld_ctl (key)
            else
                error_buzz
        until key in terminating ;
        if (st = '')
        or (st = '-') then
          begin
            int := 0 ;
            code := 0
          end
        else
            val (st, int, code) ;              {Make string into integer}

        if code = 0 then                       {Conversion worked OK}
          begin
            gotoxy (col, row) ;
            write (int:maxlen)
          end
        else
          begin
            gotoxy (col+maxlen,row) ;
            write ('** CONVERSION ERROR ', code) ;
            halt
          end
end ; {--- of read_int ---}

{ -------------------------------------------------------------------------- }

procedure read_longint (var lint:longint ; maxlen, col, row:byte) ;

  { Read Long Integer.  Just like read_int.

    Revised 3/19/88 -- WPM }

    const
        maxst : string[10] = '2147483647' ;  { string representation
                                               of maximum longint }

    var
        ch    : char ;       { character from keyboard }
        key   : integer ;    { ord(ch) }
        p     : byte ;       { position of char to left of cursor }
        st    : string[10] ; { string representation of longint }
        code  : integer ;    { result of string to integer conversion }

    procedure add_to_str ;
        begin
          if not (length(st) = maxlen) then
            begin
              p := p + 1 ;
              insert (ch,st,p) ;
              write (copy(st,p,maxlen))
            end
          else
              error_buzz
        end ; {--- of add_to_str---}

    begin {--- read_longint ---}
        str (lint:maxlen, st) ;          { convert integer into string }
        st := purgech (st, ' ') ;
        st := stripch (st, '0') ;
        write_str (st, col, row) ;
        write (build_str(chr(filler),maxlen - length(st))) ;
        p := length(st) ;
        repeat
            gotoxy (col + p, row) ;
            keyin (ch) ;
            key := ord(ch) ;
            if key = $2D then                 { minus sign }
              begin
                if  (pos('-',st) = 0)
                and (length(st) < maxlen)
                and (p = 0) then
                    add_to_str
                else
                    error_buzz
              end
            else if key in [$30 .. $39] then  {digits 0 - 9}
              begin
                add_to_str ;
                if (length(st) = 10)
                and (st > maxst) then
                  begin
                    delete (st,p,1) ;
                    write (^H,copy(st,p,maxlen),chr(filler)) ;
                    p := p - 1 ;
                    error_buzz
                  end
              end
            else if key in adjusting then
                adjust_str (st,p,key,maxlen,col,row)
            else if key in terminating then
                do_fld_ctl (key)
            else
                error_buzz
        until key in terminating ;
        if (st = '')
        or (st = '-') then
          begin
            lint := 0 ;
            code := 0
          end
        else
            val (st, lint, code) ;             {Make string into integer}

        if code = 0 then                       {Conversion worked OK}
          begin
            gotoxy (col, row) ;
            write (lint:maxlen)
          end
        else
          begin
            gotoxy (col+maxlen,row) ;
            write ('** CONVERSION ERROR ', code) ;
            halt
          end
end ; {--- of read_longint ---}

{ -------------------------------------------------------------------------- }

function equal (r1,r2 : real) : boolean ;
  { tests functional equality of two real numbers -- 4/30/85 }
    begin
        equal := abs(r1 - r2) < 1.0e-5
    end ;  { function equal }

{ -------------------------------------------------------------------------- }

function greater (r1,r2 : real) : boolean ;
  { tests functional inequality of two real numbers -- 5/1/85 }
    begin
        greater := (r1 - r2) > 1.0e-5
    end ;  { function greater }

{ -------------------------------------------------------------------------- }

procedure read_real (var r:real ; maxlen,frac,col,row:byte) ;

  { Read Real.  This procedure gets input from the keyboard
    one character at a time and edits on the fly, rejecting
    invalid characters.  COL and ROW tell where to begin the data
    input field; MAXLEN is the maximum length of the string
    representation of the real number, including sign and decimal
    point; FRAC is the fractional part, the number of digits to
    right of the decimal point.

    Note -- In Turbo the maximum number of significant digits in
    decimal (not scientific) representation is 11.  In TurboBCD,
    the maximum number of significant digits is 18.  It is the
    programmer's responsibility to limit input and computed output
    to the maximum significant digits.

    Define MAXLEN as at least two more than FRAC.  When a real
    less than one is written, Turbo puts a leading zero on it.  If
    it is negative, Turbo puts a leading minus sign and zero.  This
    can corrupt your display unless you allow space for the extra
    characters.

    Revised 12/08/87 -- WPM }

    var
        ch   : char ;       { Input character }
        key  : integer ;    { ord(ch) }
        p    : byte ;       { position of char to left of cursor }
        st   : string[21] ; { String representation of real number -- }
                            { max digits + minus sign + dec point + one extra }
        code : integer ;    { Result of VAL conversion }
        rlen,               { Current length of st to right of dec. pt. }
        llen,               { Current length to left, including dec. pt. }
        maxl,               { Max allowable to left, including dec. pt. }
        posdec : byte ;     { position of decimal point in string }

  { +++++++++++++++++++++++++++++++++++++ }

    procedure compute_length ;
      { Compute length of left and right portions of string }
        begin
            posdec := pos('.',st) ;
            if posdec = 0 then                { If no dec. pt. ... }
                begin
                    llen := length(st) ;      { the whole string is Left }
                    rlen := 0                 { and none is Right }
                end
            else    {There is a decimal point ...}
                begin
                    llen := posdec ;          { Left is all up to and incl. dec. pt. }
                    rlen := length(st) - llen { Right is the rest }
                end
        end ; { proc compute_length }

  { +++++++++++++++++++++++++++++++++++++ }

    procedure add_to_str ;

        procedure add_it ;
            begin
              p := p + 1 ;
              insert (ch,st,p) ;
              write (copy(st,p,maxlen))
            end ;

        begin {add_to_str}
            posdec := pos ('.',st) ;
            if ch = '.' then        { Decimal point; if room, add it }
              begin
                if  (posdec = 0)
                and (length(st) - p <= frac) then
                    add_it
              end
                                    { else it's not a decimal point }
                                    { see if digit fits in whole part }
            else if  (    (posdec = 0)
                      and (llen < maxl - 1)  { only dec. pt. allowed in pos. maxl }
                     )
                 or  (    (posdec > 0)
                      and (llen < maxl)
                      and (p < posdec)
                     ) then

                add_it

                                    { digit is candidate for fractional part }
            else if  (not(posdec = 0))
                 and (p >= posdec)
                 and (rlen < frac) then

                add_it
            else
                error_buzz

        end ; {--- of add_to_str---}

  { +++++++++++++++++++++++++++++++++++++ }

    begin {--- read_real ---}
                              {Initialize}
        maxl  := maxlen - frac ;

                              {Set up string representation of real and }
                              {determine length of left & right portions}

        str(r:maxlen:frac,st) ;           {Make real into string}
        st := purgech (st, ' ') ;         {Purge all blanks}
        st := stripch (st, '0') ;         {Strip leading zeroes}
        if not (pos('.', st) = 0) then    {If there is a dec. pt ... }
            begin
                st := chopch (st, '0') ;  {Chop trailing zeroes}
                st := chopch (st, '.')    {and trailing dec. pt.}
            end ;
        compute_length ;

                              {Write string on console}

        write_str (st, col, row) ;
        write (build_str(chr(filler),maxlen - length(st))) ;
        p := length(st) ;

                              {Get input a character at a time & edit it}

        repeat
            gotoxy (col + p, row) ;
            compute_length ;
            if (    (posdec = 0)
                and (llen > maxl - 1)
               )
            or (    (not (posdec = 0))
                and (llen > maxl)
               )
            or (rlen > frac) then                   { if number is larger than }
              begin                                 { spec then delete it all }
                key := del_fld ;
                adjust_str (st,p,key,maxlen,col,row) ;
                gotoxy (col,row) ;
                beep
              end ;
            keyin (ch) ;
            key := ord(ch) ;
            if key = $2D  then                      { minus sign }
              begin
                if  (pos('-',st) = 0)
                and (p = 0)
                and (  (    (posdec = 0)
                        and (llen < maxl - 1)
                       )
                    or (    (not (posdec = 0))
                        and (llen < maxl)
                       )
                    ) then

                    add_to_str
                else
                    error_buzz
              end
            else if key in [$2E, $30 .. $39] then   { decimal point, numeric digits }
                add_to_str
            else if key in adjusting then
                adjust_str (st,p,key,maxlen,col,row)
            else if key in terminating then
                do_fld_ctl (key)
            else
                error_buzz
        until key in terminating ;

                              {Done getting input, now convert back to real}
        code := -1 ;                             {Use Code as a flag}
        if (st = '')                             {If null string ... }
        or (st = '.')
        or (st = '-')
        or (st = '-.') then
          begin
            r := 0.0 ;                           {Make real zero}
            code := 0
          end
        else if (pos ('.',st) = 1) then          {If not null string, we must }
            insert ('0',st,1)                    {check for a decimal point   }
        else if (pos ('.',st) = 2)               {before any digits, which is }
        and     (pos ('-',st) = 1) then          {OK in Turbo 3.0 but not 4.0.}
            insert ('0',st,2)                    {If we find one, we insert a }
                                                 {0 so conversion will work.  }

        else if (pos('.', st) = length(st)) then {If there is a trailing dec. }
            delete (st,length(st),1) ;           {point we must get rid of it.}
                                                 {Yet another incompatibility }
                                                 {with Turbo 3.0!             }

        if code = -1 then                        {Real is not zero, so }
            val (st,r,code) ;                    {convert string into real}

        if code = 0 then                         {Conversion worked OK}
          begin
            gotoxy (col, row) ;
            write (r:maxlen:frac)                {Write the real on screen}
          end
        else
          begin
            gotoxy (col+maxlen,row) ;
            write ('** CONVERSION ERROR ', code) ;
            halt
          end
end ; {--- of read_real ---}

{ -------------------------------------------------------------------------- }

procedure read_yn (var bool:boolean; col,row:byte) ;
  { Inputs "Y" OR "N" to boolean at column and row specified,
    prints "YES" or "NO."

    Note -- use this when the screen control will not return
    to the question and the boolean IS NOT defined before the
    user answers the question.  Does not affect global FLD. }

    var ch:char ;
    begin
        gotoxy (col,row) ;
        write ('   ') ;
        gotoxy (col,row) ;
        repeat
            keyin (ch) ;
            ch := upcase(ch) ;
            if not (ch in ['Y','N']) then error_buzz
        until (ch in ['Y','N']) ;
        if (ch = 'Y') then
            begin
                write ('YES') ;
                bool := true
            end
        else
            begin
                write ('NO ') ;
                bool := false
            end
    end ; { proc read_yn }

{ ------------------------------------------------------------ }

procedure read_bool (var bool:boolean; col,row:byte) ;
  { Displays boolean at column and row specified, inputs "Y"
    or "N" to set new value of boolean, prints "YES" or "NO."
    Boolean is "forced;" user cannot cursor forward past undefined
    boolean.  Pressing "Y" or "N" terminates entry.

    Boolean is stored as one byte:
        $80 = undefined
        $01 = true
        $00 = false.
    Note : Turbo interprets $80 as true because it is greater than zero! }

    var
        ch  : char ;
        key : integer ;

    begin
        write_bool (bool, col, row) ;
        gotoxy (col, row) ;
        repeat
            keyin (ch) ;
            key := ord(ch) ;
            if key in [$59,$79] then          { 'Y','y' }
              begin
                bool := true ;
                key  := next_fld ;
                do_fld_ctl(key)
              end
            else if key in [$4E, $6E] then    { 'N','n' }
              begin
                bool := false ;
                key  := next_fld ;
                do_fld_ctl(key)
              end
            else if key in terminating then
              begin
                if  (not defined(bool))
                and (key in [carr_rtn, next_fld, next_page]) then
                  begin
                    key := $00 ;
                    error_buzz
                  end
                else
                    do_fld_ctl (key)
              end
            else
                error_buzz
        until key in terminating ;
        write_bool (bool, col, row)
    end ; {--- of read_bool ---}

{ -------------------------------------------------------------------------- }

procedure pause ;
    {Prints message on bottom line, waits for user response}
    var
        ch   : char ;
        key : integer ;
    begin
        clrline (1,24) ;
        write_str ('PRESS SPACE BAR TO CONTINUE OR UP-ARROW TO GO BACK',14,24) ;
        repeat
                keyin (ch) ;
                key := ord(ch) ;
                case key of
                  $20      : fld := succ(fld) ;
                  prev_fld : fld := pred(fld) ;
                  prev_page : fld := -999 ;
                  escape   : fld := maxint
                  else
                      error_buzz
                end ;
        until key in [$20, prev_fld, prev_page, escape] ;
        clrline (1,24)
    end ; { proc pause }

{ ------------------------------------------------------------ }

procedure hard_pause ;
  { Like Pause, but only accepts space bar or Escape and only goes forward }
    var
        ch   : char ;
        key : integer ;
    begin
        clrline (1,24) ;
        write_str ('PRESS SPACE BAR TO CONTINUE',26,24) ;
        repeat
                keyin (ch) ;
                key := ord(ch) ;
                case key of
                  $20      : fld := succ(fld) ;
                  escape   : fld := maxint ;
                  else
                      error_buzz
                end ;
        until key in [$20, escape] ;
        clrline (1,24)
    end ; { proc hard_pause }

{ ------------------------------------------------------------ }

procedure show_msg (msg : str_type) ;
  { Beeps, displays message centered on line 23, pauses }

    var
        savefld : integer ;

    begin
        savefld := fld ;
        beep ;
        clrline (1,23) ;
        write_str (msg,((80-length(msg)) div 2),23) ;
        hard_pause ;
        clrline (1,23) ;
        fld := savefld ;
    end ; { proc show_msg }

end. { implementation }

{ ----- EOF IO23UNIT.PAS ------------------------------------------------ }