home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / EDUCATON / TYPDR11.ZIP / SCREENIO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-28  |  5.2 KB  |  132 lines
  1. {    SCREENIO  is a set of routines to make screen I/O easier.
  2.      ReKey                  restores the function key labels on screen.
  3.      OnKey (num, label)     activates function key NUM and labels it.
  4.      OffKey (num)           deactivates function key NUM.
  5.      GetKey                 gets the next keystroke.
  6.      GetLine (var inplin)   gets a line (can be terminated by function key).
  7. }
  8.  
  9. uses   crt,Turbo3;
  10.  
  11. type   KeyLbl = string [6];   { label for a function key }
  12.        Line = string [80];
  13.        ScrnArea = array [0..4000] of byte;  { a complete screen image }
  14. const  KeyLbls : array [1..10] of KeyLbl = ('','','','','','','','','','');
  15.        KeyOn   : array [1..10] of boolean =
  16.         (FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE);
  17.        KeyLine : array [0..79] of integer =
  18.                    { function key labels formatted for display }
  19.                    (0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
  20.                     0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
  21.                     0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,
  22.                     0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0);
  23. var    InChar : char;       { where the most recent keyboard input is found }
  24.        MonoSeg  : array [0..4000] of byte  absolute $B000:0;
  25.        ColorSeg : array [0..4000] of byte  absolute $B800:0;
  26.                     { monochrome and color display areas, same layout,
  27.                       color starts at $B800 }
  28.        DispTop : word;  { segment start for display }
  29.        VidMode  : byte  absolute $40:$49;  { current BIOS video mode }
  30.        ScrnStack : array [0..1] of ScrnArea;
  31.  
  32. procedure ReKey;    (* restores function key labels on screen. *)
  33.     var    i : integer;
  34.     begin
  35.         if VidMode = 7 then DispTop := $B000  else DispTop := $B800;
  36.         for i:= 0 to 79 do
  37.             memw [DispTop:3840+2*i] := KeyLine[i];
  38.     end;
  39.  
  40. procedure OnKey (num:integer; lbl:KeyLbl);
  41.                          (* activates function key NUM and labels it. *)
  42.     const   Iattr : integer = $7000;  { inverse video attribute }
  43.             Nattr : integer = $0700;  { normal video attribute }
  44.     var     i,base,len : integer;
  45.     begin
  46.         KeyOn [num] := TRUE;
  47.         KeyLbls [num] := lbl;
  48.       { write NUM in KeyLine, normal video }
  49.         base := (num -1) * 8;
  50.         if num<>10 then KeyLine [base+1] := num + 48 + Nattr { ASCII for NUM }
  51.                    else begin                       { ASCII for '1' '0' }
  52.                        Keyline [base]:=49+Nattr; KeyLine [base+1]:=48+Nattr;
  53.                    end;
  54.       { write LBL in KeyLine, inverse video }
  55.         base := base + 1;  { 2 to the right }
  56.         len := length (lbl);
  57.         for i:=1 to 6 do KeyLine [base+i] := Iattr;
  58.         if len>0 then
  59.             for i:=1 to len do Keyline [base+i] := Iattr + integer (lbl [i]);
  60.       { now display it }
  61.         ReKey;
  62.     end;
  63.  
  64. procedure OffKey (num:integer);
  65.                 (* deactivates function key NUM. *)
  66.     var    i,base : integer;
  67.     begin
  68.         KeyOn [num] := FALSE;
  69.         KeyLbls [num] := '';
  70.         base := (num-1) *8;
  71.         for i:= base to base+7 do  Keyline [i] := 0;
  72.         ReKey;
  73.     end;
  74.  
  75. function GetKey : boolean;
  76.           (* gets the next keystroke, and puts it in INCHAR.
  77.              If normal keystroke, returns TRUE.
  78.              If preceded by ESC, returns FALSE.
  79.           *)
  80.     begin
  81.         read (kbd, inchar);
  82.         if ((inchar = ^[  { ESC }) and KeyPressed) then
  83.         begin         { function or cursor key }
  84.             read (kbd, inchar);
  85.             GetKey := FALSE;
  86.         end
  87.         else  GetKey := TRUE;
  88.     end;
  89.  
  90. function GetLine (var inplin:Line) : boolean;
  91.           (* gets a line from the keyboard, appended into INPLINE.
  92.              If terminated normally (ENTER), returns TRUE.
  93.              If terminated by overflow (>80 chars), returns TRUE.
  94.              If terminated by ESC, function or cursor key, returns FALSE,
  95.              with the special character in INCHAR.
  96.           *)
  97.     var    done : boolean;
  98.     begin
  99.         if length (inplin) > 0 then write (inplin);
  100.         done := FALSE;  GetLine := FALSE;
  101.         repeat
  102.             if not GetKey then done := TRUE
  103.             else
  104.             case inchar of
  105.             ^[:    { ESC - treat as special }
  106.                 done := TRUE;
  107.             ^M,^J: { newline - normal return }
  108.                 begin
  109.                     GetLine := TRUE;
  110.                     done := TRUE;
  111.                 end;
  112.             ^H:    { BACKSPACE }
  113.                 if length (inplin) >0 then
  114.                 begin
  115.                     delete (inplin, length (inplin),1); { delete last char }
  116.                     write (^H' '^H);    { wipe last char from screen }
  117.                 end
  118.                 else  write (^G);   { bell to signal error }
  119.             else   { normal character - append and write }
  120.                 if length (inplin) >= 80 then
  121.                 begin
  122.                     GetLine := TRUE;
  123.                     done := TRUE;
  124.                 end
  125.                 else
  126.                 begin
  127.                     inplin := concat (inplin, inchar);
  128.                     write (inchar);
  129.                 end;
  130.             end;
  131.         until done;
  132.     end;