Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP5WIO.ZIP/TP5WIO.INC

Text File | 1989-07-07 | 43.6 KB | 1,372 lines

const
   vno = '4.10';      { Package version Number }
   { ASCII values of cursor control keys, like WordStar. }
   prev_char = $13 ;  { ^S }
   next_char = $04 ;  { ^D }
   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    = $2E ;  { $2E = . $5F = _ }

   { the extended key codes from the keyboard }
   HOME      = 199;
   UP        = 200;
   PGUP      = 201;
   BS        = 203;
   FWD       = 205;
   END_C     = 207;
   DN        = 208;
   PGDN      = 209;
   INS       = 210;
   DEL_C     = 211;

   CTRL_HOME = 247;
   CTRL_BS   = 243;
   CTRL_FWD  = 244;
   CTRL_END  = 245;

   { The function keys return a value which is the index 187..196
     used by subtracting 186 from the value and into the user array
     of strings to insert into a field. }
   f1 = 187;
   f2 = 188;
   f3 = 189;
   f4 = 190;
   f5 = 191;
   f6 = 192;
   f7 = 193;
   f8 = 194;
   f9 = 195;
   f10= 196;

   monthtotal : montharray = (0,31,59,90,120,151,181,212,243,273,304,334,365);
                { used to convert julian date to gregorian and back }

type
   { the following variant record is used to map a longint to two integers }
   intlong = record
      case integer of
         0 :(lint:longint);
         1 :(lowint,highint:integer);
      end;

   intset = set of $00 .. $FF ;

   const  { Turbo typed constants -- initialized variables }
   terminating : intset = [carr_rtn, next_fld, prev_fld, escape,
                            next_page, prev_page,PGUP,PGDN,UP,DN] ;
   adjusting   : intset = [prev_char, next_char, del_char, del_fld,
                           del_left,DEL_C,FWD,BS] ;

{ --------------- local definitions for the window procedures -------------- }
const
   maxwindows = 10;     { maximum # on screen windows }

type
   pointer = ^integer;
   windowtype = record
      xl,yl,xr,yr :integer;   { cordinates or corners }
      bufrptr     :pointer;   { pointer to buffer location }
      cursorx,cursory :integer; { cursor position brfore opening }
      screenattr  :byte;      { text attributes before opening }
   end;

var
   windowstack   :array[0..maxwindows] of windowtype;
   maxcols,maxrows :byte;  { # rows and columns for initial video mode }
   numwindows :0..maxwindows; { # windows currently open }
   vidstart   :word;          { location of video memory }
   regs       :registers;
   aw_fore,
   aw_back,
   old_fore,
   old_back   :byte;    { active window fore and background colors }

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

procedure beep;
{ this procedure is called if any routine causes an error }
begin
   sound(200); delay(100);
   sound(350); delay(100);
   sound(100); delay(100);
   nosound;
end; { procedure beep }

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

procedure save_colors;
{ saves the present screen colors to restore later }
begin
   old_fore := aw_fore;
   old_back := aw_back;
end;

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

procedure restore_colors;
{ restores the old colors back to the active colors }
begin
   aw_fore := old_fore;
   aw_back := old_back;
end;

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

procedure SetColor(Fore, Back : byte);
begin
  TextColor(Fore);
  TextBackground(Back);
end; { SetColor }

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

function Center(Len, Left, Right : integer) : integer;
{ find the location to position (x) for title }
begin
   center := (left + ((right-left) div 2) - (len div 2));
end;

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

procedure drawframe(wtitle:string;x1,y1,x2,y2:byte);
{ draws a rectangular frame on the screen with upper left hand corner
  at x1,y1 and lower right hand corner at x2,y2 }
var
   k  :integer;
   currentattr :byte;
begin
   currentattr := textattr;  { save the current text attributes }
   if(col_inv_flag) then
      Textattr := framefgnd + numwindows + 16 * framebkgnd { change attributes for frame }
   else
      Textattr := framefgnd + 16 * framebkgnd; { change attributes for frame }
   gotoxy(x1,y1);
   write(chr(201));
   for k := (x1 + 1) to (x2 -1) do  { top border line }
      write(chr(205));
   write(chr(187));
   for k := (y1 + 1) to (y2 - 1) do
      begin
      gotoxy(x1,k); write(chr(186));
      gotoxy(x2,k); write(chr(186));
   end;
   gotoxy(x1,y2);
   write(chr(200));
   for k := (x1 + 1) to (x2 - 1) do
      write(chr(205));
   write(chr(188));
   { ---- put the title in the center of the window border if there is
     a title, if length(wtitle) > 0 ----- }
   if(length(wtitle) > 0) then
      begin
      if(length(wtitle) > (x2-x1-4)) then  { if title too long, clip it }
         wtitle := copy(wtitle,1,(x2-x1-4));
      GotoXY(Center(Length(WTitle) + 2, X1, X2), y1);
      if(col_inv_flag) then
         TextColor(title_color + numwindows + 1)
      else
         TextColor(title_color);
      Write(' ', WTitle, ' ');
   end;
   textattr := currentattr;  { restore previous text attributes }
end;  { procedure drawframe }

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

procedure saveregion(x1,y1,x2,y2:byte;
                     var startaddr :pointer);
{ saves the contents of the screen rectangle with coordinates x1,y1,x2,y2
  on the heap starting at address startaddr. }
var
   tempptr, lineptr :pointer;
   k,linelength     :integer;
begin
   linelength := (x2 - x1 + 1) * 2; { # bytes per line in rectangel }
   { allocate space on heap }
   getmem(startaddr,linelength * (y2 - y1 + 1));
   tempptr := startaddr; {tempptr points to copy destination on heap }
   for k := y1 to y2 do
      begin { make lineptr point to screen position x=s1, y=k }
      lineptr := ptr(vidstart, (k -1) * maxcols * 2 + (x1 - 1) * 2);
      { move the line from screen to heap }
      move(lineptr^,tempptr^,linelength);
      { increment the screen pointer }
      tempptr := ptr(seg(tempptr^),ofs(tempptr^)+linelength);
   end;
end;  {procedure saveregion }

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

procedure recallregion(x1,y1,x2,y2 :integer;
                       hpptr :pointer);
{ moves the contents of a previously saved region from the heap back
  to the screen. }
var
   tempptr,lineptr  :pointer;
   k,linelength     :integer;
begin
   linelength := (x2 - x1 + 1) * 2; { # bytes per line in rectangle }
   tempptr := hpptr;    { tempptr gives the source location for copy }
   for k := y1 to y2 do
      begin { make lineptr point to screen position x=x1, y=k }
      lineptr := ptr(vidstart,(k - 1) * maxcols * 2 + (x1 -1) * 2);
      move(tempptr^,lineptr^,linelength);
      tempptr := ptr(seg(tempptr^),ofs(tempptr^)+linelength);
   end;
end; { procedure recallregion }

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

procedure closewindow;
var  x,y :integer;
begin
   if numwindows > 0 then
      begin
      with windowstack[numwindows] do
         begin
         recallregion(xl,yl,xr,yr,bufrptr);  { restore underlying text }
         freemem(bufrptr,(xr -xl + 1) * (yr -yl + 1) * 2); { free heap }
         x := cursorx;
         y := cursory;   { prepare to restore cursor position }
         textattr := screenattr;  { restore screen attributes }
      end;
      { activate the underlying window }
      numwindows := numwindows -1;
      with windowstack[numwindows] do
         window(xl+1,yl+1,xr -1,yr -1);
      gotoxy(x,y);     { restore cursor position }
   end;
   if numwindows = 0 then in_window := false;
end; { procedure closewindow }

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

procedure endwindows;
{ close any open windows when exiting the windows system.  Use as the
  last statment in program to insure return to enviroment you came from.
  The global variable is normally set to 0 but may be set to a reserved
  number of windows if using a multi file window system.
}
begin
   while (numwindows > reserv_wind) do
      closewindow;
end;  { procedure endwindows }

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

procedure wind_err(msg : string);
{ Beeps, displays open window error message.  Can not do it right
  as the window system is broke when this is called so will just
  try to put something on the screen.
}
var
   i  : integer ;
   ch :char;

begin
   beep ;
   window(1,1,79,24);   { make sure we have some screen space }
   write_str('+==========================================================+',10,10);
   for i := 1 to 9 do
   write_str('|                                                          |',10,10+i);
   write_str('+=========== Any key to exit to DOS =======================+',10,20);
   if length(msg) > 76 then msg := copy(msg,1,76);
   write_str(msg,((76-length(msg)) div 2),13);
   ch := readkey;
   reserv_wind := 0;    { be sure we get them all }
   endwindows;          { close them all before exit }
end ; { wind_err }

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

procedure openwindow(wtitle       :string;
                     x1,y1,x2,y2  :byte;
                     fgnd,bkgnd   :byte
                    );
{ creates a blank window with the given coordinates, and saves the contents
  of the underlying region on the heap.  If an error occurs in attemping to
  open the window, a message is displayed on the screen before exiting the
  program a message is put on the screen. then the exit procedure returns
  the following error codes: 1 = too many windows, 2 = out of heap memory,
  3 = wrong window dimensions.
  }
var pntr :pointer;
begin
   if(numwindows = 0) then
      begin  { determine current screen parameters }
      maxcols := lo(windmax) + 1;  { add 1 since numbering begins with 0 }
      maxrows := hi(windmax) + 1;
      with windowstack[0] do  { windowstack[0] is the entire screen }
         begin
         xl := 0;
         yl := 0;
         xr := maxcols + 1;
         yr := maxrows + 1;
      end;
   end;
   { check for possible error conditions }
   if(numwindows = maxwindows) then
      begin
      wind_err('Sorry, too may windows requested.');
      halt(1);
   end
   else if(maxavail < (x2 - x1 + 1) * (y2 - y1 + 1) * 2) then
      begin
      wind_err('Sorry, No more Heap storage available.');
      halt(2);
   end
   else if(not ((x1 in [1..maxcols-2]) and (x2 in [3..maxcols]) and
                (x2-x1> 1) and (y1 in [1..maxrows-2]) and
                (y2 in [3..maxrows]) and (y2 - y1 > 1))) then
      begin
      wind_err('Sorry, Invalid window dimensions.');
      halt(3);
   end
   else
      begin  { successful request }
      saveregion(x1,y1,x2,y2,pntr);
      numwindows := numwindows + 1;
      with windowstack[numwindows] do
         begin
         xl := x1;
         yl := y1;
         xr := x2;
         yr := y2;
         bufrptr := pntr;
         cursorx := wherex;
         cursory := wherey;
         screenattr := textattr;
      end;
      window(1,1,maxcols,maxrows);   { make the whole screen a window }
      drawframe(wtitle,x1,y1,x2,y2);
      window(x1+1,y1+1,x2-1,y2-1);  { create the requested window }
      textcolor(fgnd);
      textbackground(bkgnd);
      aw_back := bkgnd;     { save the active window colors }
      aw_fore := fgnd;
      clrscr;
   end;
   in_window := true;
end; { procedure openwindow }

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

procedure openwind(wtitle       :string;
                     x1,y1,x2,y2  :byte);

{ Just a shell which calls the openwindow procedure with the default
  text colors }
begin
   openwindow(wtitle,x1,y1,x2,y2,text_fg,text_bg);
end; {procedure openwind}

{ ------- End window unit ----- }

{ 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 : integer);
begin
   gotoxy (col,row);
   clreol
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,
      DN                 : fld := succ(fld);
      prev_fld,UP        : fld := pred(fld);
      next_page,PGDN     : fld := 999 ;
      prev_page,PGUP     : 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:string ; col,row:integer);
begin
   gotoxy (col,row);
   if((in_window) and (inv_flag)) then
      begin
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
      write (st);
      setcolor(aw_fore,aw_back);
   end
   else
      write(st);
end ;

{ -------------------------------------------------------------------------- }
procedure write_temp(var ln:string;tmp:string;x,y:integer);
{ writes a string using a template.  the string (ln) is printed
  left justified in the template using the filler locations.
  quits when the template is complete on the screen.  Fills unused
  template filler locations with space. }
var
   p,t  :integer;
begin
   p := 1;
   t := 1;
   gotoxy(x,y);
   if((in_window) and (inv_flag)) then
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
   for t := 1 to length(tmp) do
      begin
      if(tmp[t] <> chr(filler)) then
         write(tmp[t])
      else
         begin
         if(p > length(ln)) then
            write(' ')
         else
            begin
            write(ln[p]);
            p := p + 1;
         end;
      end;
   end;
   if((in_window) and (inv_flag)) then
      setcolor(aw_fore,aw_back);
end;  { procedure write_temp }

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

procedure write_int(i:integer ; width,col,row:integer);
begin
   gotoxy (col,row);
   if((in_window) and (inv_flag)) then
      begin
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
      write(i:width);
      setcolor(aw_fore,aw_back);
   end
   else
      write (i:width)
end ;

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

procedure write_lint(lint:longint ; width,col,row:integer);
begin
   gotoxy (col,row);
   if((in_window) and (inv_flag)) then
      begin
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
      write (lint:width);
      setcolor(aw_fore,aw_back);
   end
   else
      write (lint:width)
end ;

{ -------------------------------------------------------------------------- }
PROCEDURE WRITE_WORD(i:word; width,col,row:integer);
begin
   gotoxy (col,row);
   if((in_window) and (inv_flag)) then
      begin
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
      write (i:width);
      setcolor(aw_fore,aw_back);
   end
   else
      write (i:width)
end ;

{ -------------------------------------------------------------------------- }
PROCEDURE WRITE_BYTE(i:byte;width,col,row:integer);
begin
   gotoxy (col,row);
   if((in_window) and (inv_flag)) then
      begin
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
      write (i:width);
      setcolor(aw_fore,aw_back);
   end
   else
      write (i: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:integer);
begin
   gotoxy (col,row);
   if((in_window) and (inv_flag)) then
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
   if not defined(bool) then
      write ('___')
   else if bool then
      write ('YES')
   else
      write ('NO ');
   if((in_window) and (inv_flag)) then
      setcolor(aw_fore,aw_back);
end ;

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

procedure write_real(r:real ; width,frac,col,row:integer);
begin
   gotoxy (col,row);
   if((in_window) and (inv_flag)) then
      begin
      if(col_inv_flag) then
         setcolor(inv_color,aw_back)
      else
         setcolor(aw_back,aw_fore);
      write (r:width:frac);
      setcolor(aw_fore,aw_back);
   end
   else
      write (r:width:frac)
end ;

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

{ This is for IBM PC-DOS only  !!}

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 IO22 -- 5/24/87
  Modified to return different codes for the function keys than
  the keypad keys.  Used to allow special entry for the function
  keys.  10 Dec 87 gbr.
  Changed to use the actual scan codes, key + 128 if extended key.
}
var
      c : char ;                  { Character read }

begin
   c := readkey;                  { Get first char }
   if(c = #0) and keypressed then { If there is a second ... }
      begin
      c := readkey;                { Get 2nd char }
      c := chr(ord(c) + 128);      { add 128 for returned key code }
   end ;
   ch := c;                        { finally, return the character }
end ;

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

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

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

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

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

function purgech (instr : string ; inchar : char) : string ;
{Purges all instances of the character from the string}
var
   n      : integer ;  {Loop counter}
   outstr : string ; {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 ;

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

procedure read_str(var st:string ; maxlen, col, row:integer);

{ 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
  Only use the Function keys for string input data, for other
  types of input will beep.
  10 Dec 87 gbr}

var
   ch   : char ;     { character from keyboard }
   key,              { ord(ch) }
   p    : integer ;  { 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
   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);          {^^^^ read keyboard here ^^^^}
      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 if key in [f1..f10] then { Function key pressed }
         begin
            st := copy(macro[key-f1 + 1],1,maxlen);  { put macro string in st }
            key := carr_rtn;            { cr to terminate entry }
         end
      else
         beep
   until key in terminating ;
   gotoxy (col + length(st), row);
   write_str(st,col,row);              { rewrite for display characteristics }
   write ('':maxlen - length(st))      { delete the filler characters on screen}
end ; {--- of read_str ---}

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

function bld_tmp_str(st:string;  { input string so far }
                    tmp:string;  { template to put it in }
                    ch : char    { filler character }
                    ) : string ;
{ returns a string of template filled in with the input string }
var
   i,t : integer;
   stt :string;
begin
   stt := tmp;
   t := 1;
   for i := 1 to length(st) do
      begin
      while(stt[t] <> ch) do t := t + 1;
   stt[t] := st[i];
   end;
   bld_tmp_str := stt
end ;  { function bld_tmp_str);

{ -------------------------------------------------------------------------- }
procedure read_temp(var st:string;tmp:string;col, row:integer);
{ Read string with a template.  This procedure gets input from
  the keyboard one character at a time and edits on the fly,
  rejecting invalid characters.  tmp is a template which is filled
  in where filler characters exist, any other characters are displayed
  on the screen.  Returned string does NOT have the template imbeded in
  it.  COL and ROW tell where to begin the data input
  field, Max length of the string is the max length of the template.
}
var
   ch   : char ;     { character from keyboard }
   key,              { ord(ch) }
   t,                { position in template }
   maxlen,           { max length of the template }
   maxline,          { max length of returned string }
   p,i     : integer ; { position in input string }

   procedure add_to_str ;
   begin
      if(length(st) < maxline) then
         begin
         p := p + 1 ;
         t := t + 1;
         insert(ch,st,p);
         gotoxy(col,row);
         write(bld_tmp_str(st,tmp,chr(filler)));
         while(tmp[t] <> chr(filler)) and (t < length(tmp)) do t := succ(t);
      end
   end ; {--- of add_to_str ---}

   procedure adj_tmp_str;
   { Adjusts position of cursor within string using a template,
     deletes characters, etc. }
   var
      rwt_flag :boolean;  { need to rewrite line }
   begin
      rwt_flag := false;
      case key of
         prev_char,BS:if p > 0 then
                       begin
                       p := pred(p);
                       t := pred(t);
                       while(tmp[t] <> chr(filler)) and (t > 1) do t := pred(t);
                    end;
         next_char,FWD:if p < length(st) then
                       begin
                       p := succ(p);
                       t := succ(t);
                       while(tmp[t] <> chr(filler)) and (t < length(tmp)) do
                          t := succ(t);
                    end;
         del_left  :if p > 0 then
                       begin
                       delete (st,p,1);
                       rwt_flag := true;
                       p := pred(p);
                       t := pred(t);
                       while(tmp[t] <> chr(filler)) and (t > 1) do t := pred(t);
                    end ;
         del_char,DEL_C:if p < length(st) then
                       begin
                       delete (st,p+1,1);
                       rwt_flag := true;
                    end ;
         del_fld   :begin
                       st := '' ;
                       p := 0  ;
                       t := 1;
                       while(tmp[t] <> chr(filler)) and (t <= maxlen) do
                          t := t + 1;
                       rwt_flag := true;
                    end
      end;  { case }
      if rwt_flag then
         begin
         gotoxy(col,row);
         write(bld_tmp_str(st,tmp,chr(filler)));
      end;
   end ; { proc adj_tmp_str }

begin {--- read_temp ---}
   maxlen := length(tmp);
   maxline := 0;
   for i := 1 to length(tmp) do
      if(tmp[i] = chr(filler)) then maxline := maxline + 1;
   p := length(st);
   t := 1;
   for i := 1 to p do  { find the present st length + template }
      begin
      while(tmp[t] <> chr(filler)) and (t <= maxlen) do t := t + 1;
      t := t + 1;
   end;       { check if the template character we are at is a template }
   while(tmp[t] <> chr(filler)) and (t <= maxlen) do t := t + 1;
   gotoxy(col,row);write(bld_tmp_str(st,tmp,chr(filler)));
   p := length(st);
   repeat
      gotoxy (col + t-1, row);
      keyin (ch);          {^^^^ read keyboard here ^^^^}
      key := ord(ch);
      if key in [$20 .. $7E] then  { printable character }
         add_to_str
      else if key in adjusting then
         adj_tmp_str
      else if key in terminating then
         do_fld_ctl (key)
      else if key in [f1..f10] then { Function key pressed }
         begin
         st := copy(macro[key-f1 + 1],1,maxlen);  { put macro string in st }
         key := carr_rtn;            { cr to terminate entry }
      end
      else
         beep
   until key in terminating ;
   write_temp(st,tmp,col,row);
end ; {--- of read_temp ---}

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

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

{ 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,                 { ord(ch) }
   p     : integer ;    { position of char to left of cursor }
   st    : string;    { 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
   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
      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
         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)
   until key in terminating ;
   if st = '' then
      begin
      int := 0 ;
      code := 0
   end
   else
      val (st, int, code);              {Make string into integer}
   gotoxy (col, row);
   if code = 0 then  {Conversion worked OK}
      write_int(int,maxlen,col,row)
   else
      begin
      write ('** conversion error ', code);
      halt
   end
end ; {--- of read_int ---}

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

procedure read_lint(var lint:longint ; maxlen, col, row:integer);
{ Read LongInt.  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 long integer
  to be returned.
}
const
   maxst : string[10] = '2147483647' ;  { string representation of maxint }

var
   ch    : char ;       { character from keyboard }
   key,                 { ord(ch) }
   p     : integer ;    { position of char to left of cursor }
   st    : string;    { 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
   end ; {--- of add_to_str---}

begin {--- read_int ---}
   str (lint:maxlen, st);      { convert long 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
      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
         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)
   until key in terminating ;
   if st = '' then
      begin
      lint := 0 ;
      code := 0
   end
   else
      val (st, lint, code);              {Make string into integer}
   gotoxy (col, row);
   if code = 0 then  {Conversion worked OK}
      write_lint(lint,maxlen,col,row)
   else
      begin
      write ('** conversion error ', code);
      halt
   end
end ; {--- of read_lint ---}

PROCEDURE READ_WORD(var wd:word; maxlen,col,row:integer);
{ Read Word.  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 word
  to be returned.
  Revised 6/04/85 -- WPM }

const
   maxst : string[5] = '65535' ;  { string representation of maxword }

var
   ch    : char ;       { character from keyboard }
   key,                 { ord(ch) }
   p     : integer ;    { position of char to left of cursor }
   st    : string;    { string representation of integer }
   code  :integer;       { result of string to word 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
   end ; {--- of add_to_str---}

begin {--- read_word ---}
   str (wd:maxlen, st);          { convert word 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
      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
         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)
   until key in terminating ;
   if st = '' then
      begin
      wd := 0 ;
      code := 0
   end
   else
      val (st, wd, code);              {Make string into word}
   gotoxy (col, row);
   if code = 0 then  {Conversion worked OK}
      write_word(wd,maxlen,col,row)
   else
      begin
      write ('** conversion error ', code);
      halt
   end
end ; {--- of read_word ---}

{ -------------------------------------------------------------------------- }
PROCEDURE READ_BYTE(var bt:byte; maxlen,col,row:integer);
{ Read byte.  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 byte
  to be returned.
  }

const
   maxst : string[5] = '255' ;  { string representation of maxbyte }

var
   ch    : char ;       { character from keyboard }
   key,                 { ord(ch) }
   p     : integer ;    { position of char to left of cursor }
   st    : string;    { string representation of integer }
   code  :integer;       { result of string to byte 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
   end ; {--- of add_to_str---}

begin {--- read_byte ---}
   str (bt:maxlen, st);          { convert byte 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
      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
         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)
   until key in terminating ;
   if st = '' then
      begin
      bt := 0 ;
      code := 0
   end
   else
      val (st, bt, code);              {Make string into word}
   gotoxy (col, row);
   if code = 0 then  {Conversion worked OK}
      write_byte(bt,maxlen,col,row)
   else
      begin
      write ('** conversion error ', code);
      halt
   end
end ; {--- of read_byte ---}

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

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:integer);

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

  Revised 6/04/85 -- WPM }

var
   ch   : char ;       { Input character }
   key,                { ord(ch) }
   p    : integer ;    { position of char to left of cursor }
   st   : string;    { String representation of real number -- }
                       { max digits plus minus sign plus decimal point }
   code : integer ;    { Result of VAL conversion }
   rlen : integer ;    { Current length of st to right of dec. pt. }
   llen : integer ;    { Current length to left, including dec. pt. }
   maxl : integer ;    { Max allowable to left, including dec. pt. }
   posdec : integer ;  { 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)) or
                ((posdec > 0) and (llen < maxl) and (p < posdec)) then
                 add_it      { only dec. pt. allowed in pos. maxl }
                             { digit is candidate for fractional part }
         else if(not(posdec = 0)) and (p >= posdec) and (rlen < frac) then
                 add_it
   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)
      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
         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);
   until key in terminating ;
                        {Done getting input, now convert back to real}
   if(st = '') or (st = '.') or (st = '-') or (st = '-.') then
      begin {If null string ... }
      r := 0.0 ;                       {Make real zero}
      code := 0
   end
   else    {Not a null string}
      begin  { check if leading 0, val procedure requires it!!}
      if(st[1] = '.') then st := concat('0',st);
      val (st, r, code);              {Make string into real}
   end;
   gotoxy (col, row);
   if code = 0 then  {Conversion worked OK}
      write_real(r,maxlen,frac,col,row)     {Write the real on screen}
   else
      begin
      write ('** conversion error ', code);
      halt
   end
end ; {--- of read_real ---}

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