home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPKBD10.ZIP / KEYBOARD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-07-08  |  26.7 KB  |  789 lines
  1. unit keyboard;
  2.  
  3. (*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*)
  4. (*                                                                         *)
  5. (*  Turbo Pascal E-Z keyboard interface unit; contains a greatly enhanced  *)
  6. (*  readkey function (getkey), error-free numeric input routines for       *)
  7. (*  inputting signed and unsigned integers and real numbers (readint,      *)
  8. (*  readno, and readreal), string input procedures with line editing and   *)
  9. (*  and the ability to limit input width (readstr and editstr), and many   *)
  10. (*  handy miscellaneous routines.  Does not use the CRT unit; requires a   *)
  11. (*  compatible BIOS.                                                       *)
  12. (*                                                                         *)
  13. (*  Author:  Tom Swingle                                                   *)
  14. (*                                                                         *)
  15. (*  Author can be contacted via e-mail at:                                 *)
  16. (*    tswingle@oucsace.cs.ohiou.edu  -or-  swingle@duce.cs.ohiou.edu       *)
  17. (*                                                                         *)
  18. (*  or via regular U.S. mail:                                              *)
  19. (*                             Tom Swingle                                 *)
  20. (*                             114 Grosvenor St.     (campus address)      *)
  21. (*                             Athens, OH 45701                            *)
  22. (*                                                                         *)
  23. (*                             Tom Swingle                                 *)
  24. (*                             Rt. 1 Box 292         (After June, 1992)    *)
  25. (*                             Waterford, OH 45786                         *)
  26. (*                                                                         *)
  27. (*  All code herein (except modifications made as noted) is the property   *)
  28. (*  of the author, Copyright 1991.  If this code is modified, all          *)
  29. (*  modifications must be documented by the modifier before the code is    *)
  30. (*  distributed.  This file is not to be distributed if any portion of     *)
  31. (*  this comment block has been removed.  However, modifiers may add       *)
  32. (*  modification comments into this comment block so long as all of the    *)
  33. (*  additions are made after all other text in the block, and no text is   *)
  34. (*  removed.  All documentation and demonstration programs that came with  *)
  35. (*  this file should be redistributed along with this file.                *)
  36. (*                                                                         *)
  37. (*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*)
  38.  
  39. interface
  40.  
  41. {$DEFINE NOCRT}
  42.  
  43. { Remove the above line if you are using the CRT unit and do not want the
  44.   last four routines defined in the interface section to interfere with the
  45.   routines normally defined in the CRT unit. }
  46.  
  47. const
  48.  alt=132; { Alt + letter will return the character 132 above the letter }
  49.  home=#128;      uparrow=#129;       pgup=#130; { numeric }
  50.  leftarrow=#131;               rightarrow=#132; { keypad }
  51.  end_=#133;     downarrow=#134;      pgdn=#135; { keys }
  52.  ins=#136; del=#137;
  53.  F1=#138; F2=#139; F3=#140; F4=#141; F5=#142;
  54.  F6=#143; F7=#144; F8=#145; F9=#146; F10=#147;
  55.  shiftF1=#148; shiftF2=#149; shiftF3=#150; shiftF4=#151; shiftF5=#152;
  56.  shiftF6=#153; shiftF7=#154; shiftF8=#155; shiftF9=#156; shiftF10=#157;
  57.  cntlF1=#158; cntlF2=#159; cntlF3=#160; cntlF4=#161; cntlF5=#162;
  58.  cntlF6=#163; cntlF7=#164; cntlF8=#165; cntlF9=#166; cntlF10=#167;
  59.  altF1=#168; altF2=#169; altF3=#170; altF4=#171; altF5=#172;
  60.  altF6=#173; altF7=#174; altF8=#175; altF9=#176; altF10=#177;
  61.    { Regular, shifted, control, and alternate sets of function keys }
  62.  cntlhome=#183; cntlpgup=#178;
  63.  cntlleftarrow=#179; cntlrightarrow=#180;
  64.  cntlend=#181; cntlpgdn=#182; { Control + keypad keys }
  65.  alt1=#184; alt2=#185; alt3=#186; alt4=#187; alt5=#188;
  66.  alt6=#189; alt7=#190; alt8=#191; alt9=#192; alt0=#193;
  67.    { Alt + numbers from top row of keyboard }
  68.  altminus=#194; altequal=#195; { Alt + "-" or "=" from middle of keyboard }
  69.  reversetab=#196; { Shift + tab key }
  70.  on=true;    { Boolean constans for GetCapslock, GetNumLock, }
  71.  off=false;  { GetScrollLock, SetCapsLock, SetNumLock, and SetScrollLock }
  72.  nonnumeric:boolean=false; { Disallow numbers on numeric keypad }
  73.  
  74. type charset=set of char;
  75.  
  76. var alttyped:boolean; { TRUE if the last key returned by getkey was entered
  77.   on the numeric keypad.  This can be done by holding down the alt key and
  78.   typing the key's ASCII code on the numeric keypad.  Undefined before the
  79.   first call to getkey. }
  80.  
  81. function getkey:char; { enhanced readkey }
  82. procedure readno(var number:word; lobound,hibound:word);
  83. procedure readint(var number:integer; lobound,hibound:integer);
  84. procedure readreal(var number:real; lobound,hibound:real; decimals:byte);
  85.  { Read an unsigned integer, signed integer, or real number between lobound
  86.    and hibound, and with maximum number of decimal places for real number. }
  87. procedure readstr(var s:string; maxlen:byte; charstoexclude:charset);
  88.  { Read a new string into s, starting with an empty string; allow no more
  89.    than maxlen chars; do not allow any characters in the charstoexclude set
  90.    to be entered into the string. }
  91. procedure editstr(var s:string; maxlen:byte; charstoexclude:charset);
  92.  { Edit the string currently in s; same rules as readstr. }
  93. procedure flushbuffer; { Flush all typed-ahead keystrokes from buffer. }
  94. procedure setcapslock(state:boolean);   { Set the caps lock, num lock, }
  95. procedure setnumlock(state:boolean);    { scroll lock, or insert key state }
  96. procedure setscrolllock(state:boolean); { on or off.  State=TRUE means turn }
  97. procedure setinsert(state:boolean);     { on; state=FALSE means turn off. }
  98. function getcapslock:boolean;   { \                                     }
  99. function getnumlock:boolean;    {  \Return current caps lock, num lock, }
  100. function getscrolllock:boolean; {  /scroll lock, or insert state.       }
  101. function getinsert:boolean;     { /                                     }
  102. function screenwidth:byte; { Tell how many characters wide the screen is. }
  103. function leftshiftdown:boolean;  { Returns true if left shift key is down. }
  104. function rightshiftdown:boolean; { Returns true if right shift key is down. }
  105. function shiftdown:boolean; { Returns true if either shift key is down. }
  106. function controldown:boolean; { Returns true if control key is down. }
  107. function altdown:boolean; { Returns true if alt key is down. }
  108. procedure chgcursor(startline,endline:byte);
  109.          { Change the cursor so it starts at startline and ends at endline. }
  110.          { Chgcursor ($20,0) will completely erase the cursor. }
  111. procedure getcursor(var startline,endline:byte);
  112.           { Get the current starting and ending line of the cursor. }
  113. {$IFDEF NOCRT}
  114. function keypressed:boolean; { Returns true if a key is waiting in buffer. }
  115. function wherex:byte; { Returns x-coordinate of cursor. }
  116. function wherey:byte; { Returns y-coordinate of cursor. }
  117. procedure gotoxy(x,y:byte); { Positions cursor at (x,y). }
  118. {$ENDIF}
  119.  
  120. implementation
  121.  
  122. uses dos;
  123.  
  124. var
  125.  keyflag:byte absolute $40:$17; { Location of keyboard status flags. }
  126.  scancode:byte; { Contains the scan code of last key pressed. }
  127.  
  128. { Following are five routines normally defined in the CRT unit.  Originally,
  129.   this unit was written using these routines directly from the CRT unit.
  130.   However, they have been rewritten using BIOS calls because the CRT unit
  131.   seems to be incompatible with text modes greater than 80 columns wide.
  132.   Four of them are included in the interface section so that programs using
  133.   this unit need not include the CRT unit in order to do basic keyboard
  134.   functions.  A program using the CRT unit can call crt.keypressed,
  135.   crt.wherex, etc., if use of the CRT unit's routines is desired (or simply
  136.   remove the conditional compilation definition of NOCRT above.  This is
  137.   probably unecessary because the routines are functionally equivalent, to
  138.   the best of my knowledge, except for one difference with keypressed.
  139.   Please read KEYBOARD.DOC for more details. }
  140.  
  141. function wherex:byte;
  142.  
  143. var regs:registers;
  144.  
  145. begin
  146.  regs.ah:=$F;
  147.  intr($10,regs); { Get correct display page into bh }
  148.  regs.ah:=3;
  149.  intr($10,regs); { Call BIOS int 10h, function 3--get cursor position }
  150.  wherex:=regs.dl+1;
  151. end;
  152.  
  153. function wherey:byte;
  154.  
  155. var regs:registers;
  156.  
  157. begin
  158.  regs.ah:=$F;
  159.  intr($10,regs); { Get correct display page into bh }
  160.  regs.ah:=3;
  161.  intr($10,regs); { Call BIOS int 10h, function 3--get cursor position }
  162.  wherey:=regs.dh+1;
  163. end;
  164.  
  165. procedure gotoxy(x,y:byte);
  166.  
  167. var regs:registers;
  168.  
  169. begin
  170.  regs.ah:=$F;
  171.  intr($10,regs); { Get correct display page into bh }
  172.  regs.ah:=2;
  173.  regs.dl:=x-1;
  174.  regs.dh:=y-1;
  175.  intr($10,regs); { Call BIOS int 10h, function 2--set cursor position }
  176. end;
  177.  
  178. function keypressed:boolean;
  179.  
  180. { Please read KEYBOARD.DOC for information on the additional side effect
  181.   that this function has. }
  182.  
  183. var regs:registers;
  184.  
  185. begin
  186.  repeat
  187.   regs.ah:=1;
  188.   intr($16,regs); { Call BIOS int 16h, function 1--check buffer status }
  189.   if (regs.flags and fzero=0) and (regs.ah=76) and nonnumeric
  190.    then begin { clear out keypad 5's in non-numeric mode }
  191.     regs.ah:=0;
  192.     intr($16,regs); { Call BIOS int 16h, function 0--get keystroke }
  193.    end;
  194.  until (regs.flags and fzero<>0) or (regs.flags and fzero=0) and
  195.   ((regs.ah<>76) or not nonnumeric);
  196.  keypressed:=regs.flags and fzero=0; { ZF clear if keystroke waiting }
  197. end;
  198.  
  199. function readkey:char;
  200.  
  201. var regs:registers;
  202.  
  203. begin
  204.  regs.ah:=0;
  205.  intr($16,regs); { Call BIOS int 16h, function 0--get keystroke }
  206.  readkey:=chr(regs.al);
  207.  scancode:=regs.ah; { global variable containing scan code of last key }
  208. end;
  209.  
  210. procedure beep;
  211.  
  212. begin
  213.  { Not implemented.  Adding a beep without the CRT unit would require
  214.    appropriate Port out instructions, as well as a calibrated delay loop,
  215.    and the usefulness of a beep as a signal to the user is questionable, and
  216.    somewhat a matter of taste.  If you care to add a beep to signal
  217.    incorrect input, put it here (remove this comment if you do).  }
  218. end;
  219.  
  220. function screenwidth;
  221.  
  222. var regs:registers;
  223.  
  224. begin
  225.  regs.ah:=$F;
  226.  intr($10,regs); { Call BIOS int 10h, function 15--get video mode }
  227.  screenwidth:=regs.ah;
  228. end;
  229.  
  230. procedure backup(count:byte);
  231.  
  232. { Back up the cursor a given number of spaces, allowing for backing up in
  233.   the leftmost column of the screen, which takes it to the row above }
  234.  
  235. var x,y:integer;
  236.  
  237. begin
  238.  x:=wherex; y:=wherey;
  239.  dec(x,count); { Back up the appropriate number of spaces }
  240.  while x<1 do begin { If it goes off the left edge, move to the row above }
  241.   inc(x,screenwidth);
  242.   dec(y);
  243.  end;
  244.  gotoxy(x,y);
  245. end;
  246.  
  247. function getkey;
  248.  
  249. var
  250.  head:byte;
  251.  ch:char;
  252.  
  253. begin
  254.  repeat
  255.   ch:=readkey;
  256.   alttyped:=scancode=0;
  257.        { A character typed on the numeric keypad will have a scan code of 0 }
  258.   if nonnumeric and (ch in ['0'..'9','.']) and (scancode>70) then begin
  259.    case ch of { Translate from number key to cursor control key }
  260.     '0':getkey:=ins;
  261.     '1':getkey:=end_;
  262.     '2':getkey:=downarrow;
  263.     '3':getkey:=pgdn;
  264.     '4':getkey:=leftarrow;
  265.     '6':getkey:=rightarrow;
  266.     '7':getkey:=home;
  267.     '8':getkey:=uparrow;
  268.     '9':getkey:=pgup;
  269.     '.':getkey:=del;
  270.    end;
  271.    if ch<>'5' then exit;
  272.   end;
  273.  until not((ch='5') and nonnumeric and (scancode>70));
  274.  if ch=#0 then begin { Special keys return an ASCII code=0.  Process them. }
  275.   ch:=chr(scancode);
  276.   case ch of
  277.    #3:        getkey:=#0; { null }
  278.    #15:       getkey:=reversetab; { shift + tab key }
  279.    #59..#68:  getkey:=chr(ord(ch)+79); { F1..F10 }
  280.    #84..#113: getkey:=chr(ord(ch)+64); { any other F key }
  281.    #71..#73:  getkey:=chr(ord(ch)+57); { home, up arrow, pgup }
  282.    #75:       getkey:=leftarrow;
  283.    #77:       getkey:=rightarrow;
  284.    #79..#83:  getkey:=chr(ord(ch)+54); { end, down arrow, pgdn, ins, del }
  285.    #115..#131:getkey:=chr(ord(ch)+64); { control+left arrow, right arrow,
  286.      end, pgdn, home; alt+1,2,...,9,0,_,= }
  287.    #132:      getkey:=cntlpgup;
  288.    #16:       getkey:=chr(alt+ord('Q'));
  289.    #17:       getkey:=chr(alt+ord('W'));
  290.    #18:       getkey:=chr(alt+ord('E'));
  291.    #19:       getkey:=chr(alt+ord('R'));
  292.    #20:       getkey:=chr(alt+ord('T'));
  293.    #21:       getkey:=chr(alt+ord('Y'));
  294.    #22:       getkey:=chr(alt+ord('U'));
  295.    #23:       getkey:=chr(alt+ord('I'));
  296.    #24:       getkey:=chr(alt+ord('O'));
  297.    #25:       getkey:=chr(alt+ord('P'));
  298.    #30:       getkey:=chr(alt+ord('A'));
  299.    #31:       getkey:=chr(alt+ord('S'));
  300.    #32:       getkey:=chr(alt+ord('D'));
  301.    #33:       getkey:=chr(alt+ord('F'));
  302.    #34:       getkey:=chr(alt+ord('G'));
  303.    #35:       getkey:=chr(alt+ord('H'));
  304.    #36:       getkey:=chr(alt+ord('J'));
  305.    #37:       getkey:=chr(alt+ord('K'));
  306.    #38:       getkey:=chr(alt+ord('L'));
  307.    #44:       getkey:=chr(alt+ord('Z'));
  308.    #45:       getkey:=chr(alt+ord('X'));
  309.    #46:       getkey:=chr(alt+ord('C'));
  310.    #47:       getkey:=chr(alt+ord('V'));
  311.    #48:       getkey:=chr(alt+ord('B'));
  312.    #49:       getkey:=chr(alt+ord('N'));
  313.    #50:       getkey:=chr(alt+ord('M'));
  314.   end;
  315.  end else getkey:=ch; { If not #0, return ch as is }
  316. end;
  317.  
  318. procedure readno;
  319.  
  320. var
  321.  i,maxlen:byte;
  322.  temp:longint;
  323.  ch:char;
  324.  s:string[5];
  325.  error:integer;
  326.  
  327. begin
  328.  if hibound<lobound then exit;
  329.  str(hibound,s);
  330.  maxlen:=length(s); { Figure maximum input width that can be needed }
  331.  repeat
  332.   s:=''; { Set s to null }
  333.   repeat { Get characters into s until ^M is pressed }
  334.    ch:=getkey;
  335.    case ch of
  336.     '0'..'9' : if length(s)<maxlen then begin
  337.                 s:=s+ch;
  338.                 write(ch)
  339.                end;
  340.     #8       : if length(s)>0 then begin
  341.                 delete(s,length(s),1);
  342.                 backup(1);
  343.                 write(' ');
  344.                 backup(1);
  345.                end;
  346.     #13      : if length(s)=0 then exit; { null string; no changes }
  347.    end
  348.   until ch=#13;
  349.   val(s,temp,error); { Now test number entered against bounds passed }
  350.   if (temp<lobound) or (temp>hibound) then begin
  351.    beep;
  352.    backup(length(s));
  353.    for i:=1 to length(s) do write(' ');
  354.    backup(length(s));
  355.   end;
  356.  until (temp>=lobound) and (temp<=hibound);
  357.  number:=temp;
  358. end;
  359.  
  360. procedure readint;
  361.  
  362. var
  363.  i,maxlen:byte;
  364.  temp:longint;
  365.  ch:char;
  366.  s:string[6];
  367.  error:integer;
  368.  
  369. begin
  370.  if hibound<lobound then exit;
  371.  str(lobound,s);
  372.  maxlen:=length(s); { Maximum width needed is the width of the }
  373.  str(hibound,s);    { lobound or the hibound, whichever is wider }
  374.  if length(s)>maxlen then maxlen:=length(s);
  375.  repeat { Same type of loop-within-loop as in previous procedure }
  376.   s:='';
  377.   repeat
  378.    ch:=getkey;
  379.    case ch of
  380.     '-' : if length(s)=0 then begin
  381.            s:='-'; { minus sign allowed if it is the first character in s }
  382.            write('-');
  383.           end;
  384.     '0'..'9' : if (length(s)<maxlen) then begin
  385.                 s:=s+ch;
  386.                 write(ch)
  387.                end;
  388.     #8       : if length(s)>0 then begin
  389.                 delete(s,length(s),1);
  390.                 backup(1);
  391.                 write(' ');
  392.                 backup(1);
  393.                end;
  394.     #13      : if length(s)=0 then exit;
  395.    end
  396.   until ch=#13;
  397.   val(s,temp,error);
  398.   if (temp<lobound) or (temp>hibound) then begin
  399.    beep;
  400.    backup(length(s));
  401.    for i:=1 to length(s) do write(' ');
  402.    backup(length(s));
  403.   end;
  404.  until (temp>=lobound) and (temp<=hibound);
  405.  number:=temp;
  406. end;
  407.  
  408. procedure readreal;
  409.  
  410. var
  411.  i,maxlen:byte;
  412.  temp:real;
  413.  ch:char;
  414.  s:string;
  415.  error:integer;
  416.  
  417. begin
  418.  if hibound<lobound then exit;
  419.  str(lobound:1:decimals,s);
  420.  maxlen:=length(s);         { Maximum width is the wider of the hibound and }
  421.  str(hibound:1:decimals,s); { the lobound with the appropriate decimals }
  422.  if length(s)>maxlen then maxlen:=length(s);
  423.  repeat { Again, same loop-within-loop }
  424.   s:='';
  425.   repeat
  426.    ch:=getkey;
  427.    case ch of
  428.     '-' : if length(s)=0 then begin
  429.            s:='-'; { minus sign allowed if it is the first character in s }
  430.            write('-');
  431.           end;
  432.     '.' : if (pos('.',s)=0) and (length(s)<maxlen) then begin
  433.            s:=s+'.'; { decimal pt. allowed if there is not already one in s }
  434.            write('.');
  435.           end;
  436.     '0'..'9' : if length(s)<maxlen then begin
  437.                 s:=s+ch;
  438.                 write(ch)
  439.                end;
  440.     #8       : if length(s)>0 then begin
  441.                 delete(s,length(s),1);
  442.                 backup(1);
  443.                 write(' ');
  444.                 backup(1);
  445.                end;
  446.     #13      : if length(s)=0 then exit;
  447.    end
  448.   until ch=#13;
  449.   val(s,temp,error);
  450.   if (temp<lobound) or (temp>hibound) then begin
  451.    beep;
  452.    backup(length(s));
  453.    for i:=1 to length(s) do write(' ');
  454.    backup(length(s));
  455.   end;
  456.  until (temp>=lobound) and (temp<=hibound);
  457.  number:=temp;
  458. end;
  459.  
  460. procedure editstr;
  461.  
  462. var
  463.  regs:registers;
  464.  ch:char;
  465.  n,position,startline,endline:byte;
  466.  inson:boolean;
  467.  
  468. procedure update(noblanks,stepsback,startpos:byte);
  469.  
  470. { Update the string, starting at position startpos.  Stepsback contains how
  471.   many spaces to back up before starting the update.  Noblanks contains how
  472.   many blanks to write after the updated string is written.  After writing
  473.   the blanks (if any), the cursor is backed up to the end of the string. }
  474.  
  475. var
  476.  i:byte;
  477.  temp:string;
  478.  
  479. begin
  480.  temp:=copy(s,startpos,length(s)-startpos+1);
  481.  chgcursor($20,0);
  482.  backup(stepsback);
  483.  write(temp);
  484.  for i:=1 to noblanks do write(' ');
  485.  backup(length(temp)-stepsback+noblanks);
  486.  if inson then chgcursor(4,7) else chgcursor(6,7); { set cursor type }
  487. end;
  488.  
  489. procedure addchar;
  490.  
  491. { add the character ch to the string, only if:
  492.    - ch is not in the set charstoexclude of disallowed characters,
  493.    - ch is either less than #128 or has been typed on the numeric keypad (to
  494.      disallow special keys like F1 that are not trapped as editing keys), and
  495.    - there is room to insert the character (if in insert mode) or to add it
  496.      to the end of the string (if the cursor is at the end of the string) }
  497.  
  498. begin
  499.  if not (ch in charstoexclude) and (alttyped or (ch<#128))
  500.   and ((length(s)<maxlen) or not inson and (position<length(s))) then begin
  501.    write(ch);
  502.    if inson or (position=length(s)) then begin
  503.     insert(ch,s,position+1);
  504.     if position<length(s)-1 then update(0,0,position+2);
  505.    end else s[position+1]:=ch;
  506.    inc(position);
  507.   end; { echo the character, and insert it into the string if in insert mode
  508.         or overwrite the character at the cursor if in overstrike mode }
  509. end;
  510.  
  511. begin
  512.  getcursor(startline,endline); { save cursor shape }
  513.  inson:=false; { overstrike mode at first }
  514.  chgcursor(6,7); { start with a thin cursor }
  515.  position:=length(s); { put cursor at end of string }
  516.  write(s); { write out the initial string }
  517.  charstoexclude:=charstoexclude+[^G,^J,^Z];
  518.           { these characters won't display, so make sure they are excluded }
  519.  repeat
  520.   gotoxy(wherex,wherey); { This removed a problem with updating the cursor on
  521.    my screen, for some reason.  Something in my ANSI driver, I think. }
  522.   ch:=getkey;
  523.   case ch of
  524.    ^H        : if (length(s)>0) and (position>0) then begin
  525.                 delete(s,position,1);
  526.                 update(1,1,position);
  527.                 dec(position);
  528.                 backup(1);
  529.                end; { backspace }
  530.    ^I        : if not alttyped and (position<length(s)-4) then begin
  531.                 for n:=1 to 5 do if wherex=screenwidth
  532.                  then gotoxy(1,wherey+1)
  533.                  else gotoxy(wherex+1,wherey);
  534.                 inc(position,5);
  535.                end; { tab key moves cursor forward five spaces }
  536.    ^M        : begin
  537.                 chgcursor($20,0);
  538.                 backup(position);
  539.                 write(s);
  540.                end; { do final update before exiting }
  541.    ^[        : begin
  542.                 n:=length(s);
  543.                 s:='';
  544.                 update(n,position,1);
  545.                 chgcursor($20,0);
  546.                 backup(position);
  547.                 position:=0;
  548.                 if inson then chgcursor(4,7) else chgcursor(6,7);
  549.                end; { ESC key--clear out string }
  550.    ins       : if alttyped then addchar else begin
  551.                 inson:=not inson;
  552.                 if inson then chgcursor(4,7) else chgcursor(6,7);
  553.                end;
  554.    del       : if alttyped then addchar else
  555.                 if (length(s)>0) and (position<length(s)) then begin
  556.                  delete(s,position+1,1);
  557.                  update(1,0,position+1);
  558.                 end;
  559.    cntlhome  : if alttyped then addchar else
  560.                 if (length(s)>0) and (position>0) then begin
  561.                  delete(s,1,position);
  562.                  update(position,position,1);
  563.                  chgcursor($20,0);
  564.                  backup(position);
  565.                  position:=0;
  566.                  if inson then chgcursor(4,7) else chgcursor(6,7);
  567.                 end; { delete from cursor to beginning of string }
  568.    cntlend   : if alttyped then addchar else
  569.                 if (length(s)>0) and (position<length(s)) then begin
  570.                  n:=length(s)-position;
  571.                  delete(s,position+1,n);
  572.                  update(n,0,position+1);
  573.                 end; { delete from cursor to end of string }
  574.    home      : if alttyped then addchar else begin
  575.                 chgcursor($20,0);
  576.                 backup(position);
  577.                 position:=0;
  578.                 if inson then chgcursor(4,7) else chgcursor(6,7);
  579.                end;
  580.    end_      : if alttyped then addchar else begin
  581.                 chgcursor($20,0);
  582.                 backup(position);
  583.                 write(s);
  584.                 if inson then chgcursor(4,7) else chgcursor(6,7);
  585.                 position:=length(s);
  586.                end;
  587.    reversetab: if not alttyped and (position>4) then begin
  588.                 backup(5);
  589.                 dec(position,5);
  590.                end; { reverse tab backs the cursor up five spaces }
  591.    leftarrow : if alttyped then addchar else if position>0 then begin
  592.                 backup(1);
  593.                 dec(position);
  594.                end;
  595.    rightarrow: if alttyped then addchar else if position<length(s) then begin
  596.                 if wherex=screenwidth
  597.                  then gotoxy(1,wherey+1) { wrap to next line if at end }
  598.                  else gotoxy(wherex+1,wherey);
  599.                 inc(position);
  600.                end;
  601.    uparrow:    if alttyped then addchar else
  602.                 if position>=screenwidth then begin
  603.                  dec(position,screenwidth);
  604.                  gotoxy(wherex,wherey-1);
  605.                 end; { go up one line }
  606.    downarrow:  if alttyped then addchar else
  607.                 if position+screenwidth<=length(s) then begin
  608.                  inc(position,screenwidth);
  609.                  gotoxy(wherex,wherey+1);
  610.                 end; { go down one line }
  611.    else addchar; { character is not an editing key, add it to the string }
  612.   end;
  613.  until ch=#13; { many keys have "if alttyped then addchar else ..." after
  614.    them; this means that if the key was typed on the numeric keypad, that it
  615.    should be taken literally and added to the string rather than being
  616.    interpreted as an editing key }
  617.  chgcursor(startline,endline); { restore cursor to the way it was }
  618. end;
  619.  
  620. procedure readstr;
  621.  
  622. { quite simple; just call editstr with an initially null string and return
  623.  the new string if it was changed }
  624.  
  625. var temp:string;
  626.  
  627. begin
  628.  temp:='';
  629.  editstr(temp,maxlen,charstoexclude);
  630.  if temp>'' then s:=temp;
  631. end;
  632.  
  633. procedure flushbuffer;
  634.  
  635. var regs:registers;
  636.  
  637. begin
  638.  regs.ah:=$C;
  639.  regs.al:=0; { al=0 means don't do anything after flushing buffer }
  640.  msdos(regs); { Call DOS function 12--flush stdin buffer }
  641. end;
  642.  
  643. { The next four routines affect keyboard toggle states.  They should be used
  644.   sparingly, if at all.  The states are affected by toggling the appropriate
  645.   bit in the keyboard flag byte. }
  646.  
  647. procedure setcapslock;
  648.  
  649. begin
  650.  if state then keyflag:=keyflag or $40 else keyflag:=keyflag and $BF;
  651. end;
  652.  
  653. procedure setnumlock;
  654.  
  655. begin
  656.  if state then keyflag:=keyflag or $20 else keyflag:=keyflag and $DF;
  657. end;
  658.  
  659. procedure setscrolllock;
  660.  
  661. begin
  662.  if state then keyflag:=keyflag or $10 else keyflag:=keyflag and $EF;
  663. end;
  664.  
  665. procedure setinsert;
  666.  
  667. begin
  668.  if state then keyflag:=keyflag or $80 else keyflag:=keyflag and $7F;
  669. end;
  670.  
  671. function getcapslock;
  672.  
  673. var regs:registers;
  674.  
  675. begin
  676.  regs.ah:=2;
  677.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  678.  getcapslock:=regs.al and 64=64; { Bit 6 contains caps lock status }
  679. end;
  680.  
  681. function getnumlock;
  682.  
  683. var regs:registers;
  684.  
  685. begin
  686.  regs.ah:=2;
  687.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  688.  getnumlock:=regs.al and 32=32; { Bit 5 contains num lock status }
  689. end;
  690.  
  691. function getscrolllock;
  692.  
  693. var regs:registers;
  694.  
  695. begin
  696.  regs.ah:=2;
  697.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  698.  getscrolllock:=regs.al and 16=16; { Bit 4 contains scroll lock status }
  699. end;
  700.  
  701. function getinsert;
  702.  
  703. var regs:registers;
  704.  
  705. begin
  706.  regs.ah:=2;
  707.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  708.  getinsert:=regs.al and 128=128; { Bit 7 contains insert status }
  709. end;
  710.  
  711. function rightshiftdown;
  712.  
  713. var regs:registers;
  714.  
  715. begin
  716.  regs.ah:=2;
  717.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  718.  rightshiftdown:=regs.al and 1=1; { Bit 0 contains right shift status }
  719. end;
  720.  
  721. function leftshiftdown;
  722.  
  723. var regs:registers;
  724.  
  725. begin
  726.  regs.ah:=2;
  727.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  728.  leftshiftdown:=regs.al and 2=2; { Bit 1 contains right shift status }
  729. end;
  730.  
  731. function shiftdown;
  732.  
  733. var regs:registers;
  734.  
  735. begin
  736.  regs.ah:=2;
  737.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  738.  shiftdown:=regs.al and 3<>0; { Check either bit 0 or 1 }
  739. end;
  740.  
  741. function controldown;
  742.  
  743. var regs:registers;
  744.  
  745. begin
  746.  regs.ah:=2;
  747.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  748.  controldown:=regs.al and 4=4; { Bit 2 contains control status }
  749. end;
  750.  
  751. function altdown;
  752.  
  753. var regs:registers;
  754.  
  755. begin
  756.  regs.ah:=2;
  757.  intr($16,regs); { Call BIOS int 16h, function 2--get keyboard shift status }
  758.  altdown:=regs.al and 8=8; { Bit 3 contains alt status }
  759. end;
  760.  
  761. procedure chgcursor;
  762.  
  763. var regs:registers;
  764.  
  765. begin
  766.  with regs do begin
  767.   ah:=1;
  768.   ch:=startline;
  769.   cl:=endline;
  770.  end;
  771.  intr($10,regs); { Call BIOS int 10h, function 1--set cursor shape }
  772. end;
  773.  
  774. procedure getcursor;
  775.  
  776. var regs:registers;
  777.  
  778. begin
  779.  with regs do begin
  780.   ah:=$F;
  781.   intr($10,regs); { Get correct display page into bh }
  782.   ah:=3;
  783.   intr($10,regs); { Call BIOS int 10h, function 3--get cursor shape }
  784.   startline:=ch;
  785.   endline:=cl;
  786.  end;
  787. end;
  788.  
  789. end.