home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBT41S3.ZIP / RDKEYBRD.MOD < prev    next >
Encoding:
Text File  |  1988-02-14  |  5.8 KB  |  161 lines
  1. (*----------------------------------------------------------------------*)
  2. (*  PibTerm_KeyPressed --- Replaces standard Turbo KeyPressed routine   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION PibTerm_KeyPressed : BOOLEAN;
  6.  
  7. VAR
  8.    Regs : Registers;
  9.  
  10. (* STRUCTURED *) CONST
  11.    XOFF_Message : STRING[13] = 'XOFF received';
  12.    XON_Message  : STRING[13] = '             ';
  13.  
  14. BEGIN (* PibTerm_KeyPressed *)
  15.  
  16.    IF ( LENGTH( Keyboard_Buffer ) = 0 ) THEN
  17.       BEGIN
  18.  
  19.          IF ( Extended_KeyBoard AND ( ( Mem[$40:$96] AND $10 ) <> 0 ) ) THEN
  20.             Regs.Ah := $11
  21.          ELSE
  22.             Regs.Ah := 1;
  23.  
  24.          INTR( $16 , Regs );
  25.  
  26.          PibTerm_KeyPressed := ( ( Regs.Flags AND Zero_Flag ) = 0 );
  27.  
  28.       END
  29.    ELSE
  30.       BEGIN
  31.          PibTerm_KeyPressed := Return_KeyPressed;
  32.          Return_KeyPressed  := TRUE;
  33.       END;
  34.  
  35.    IF Do_Status_Line THEN
  36.       BEGIN
  37.          IF Do_Status_Time THEN
  38.             Update_Status_Line;
  39.          IF Async_XOFF_Rec_Display THEN
  40.             BEGIN
  41.                Async_XOFF_Rec_Display := FALSE;
  42.                Write_To_Status_Line( XOFF_Message , 65 );
  43.             END;
  44.          IF Async_XON_Rec_Display THEN
  45.             BEGIN
  46.                Async_XON_Rec_Display := FALSE;
  47.                Write_To_Status_Line( XON_Message , 65 );
  48.             END;
  49.       END;
  50.  
  51. END   (* PibTerm_KeyPressed *);
  52.  
  53. (*----------------------------------------------------------------------*)
  54. (*   ReadKeyboard --- Reads character from keyboard or PibTerm buffer   *)
  55. (*----------------------------------------------------------------------*)
  56.  
  57. FUNCTION ReadKeyboard : CHAR;
  58.  
  59. (*----------------------------------------------------------------------*)
  60. (*                                                                      *)
  61. (*     Function:   ReadKeyboard                                         *)
  62. (*                                                                      *)
  63. (*     Purpose:    Reads characters from keyboard or buffer             *)
  64. (*                                                                      *)
  65. (*     Calling Sequence:                                                *)
  66. (*                                                                      *)
  67. (*        Ch := ReadKeyboard : CHAR;                                    *)
  68. (*                                                                      *)
  69. (*           Ch --- the character read                                  *)
  70. (*                                                                      *)
  71. (*     Calls:                                                           *)
  72. (*                                                                      *)
  73. (*        INTR                                                          *)
  74. (*                                                                      *)
  75. (*----------------------------------------------------------------------*)
  76.  
  77. VAR
  78.    L       : INTEGER;
  79.    Regs    : Registers;
  80.    KCh     : CHAR;
  81.    I       : INTEGER;
  82.    Do_Ext  : BOOLEAN;
  83.  
  84. LABEL 1;
  85.  
  86. BEGIN (* ReadKeyboard *)
  87.                                    (* Get length of internal keyboard *)
  88.                                    (* buffer                          *)
  89.  
  90.    L := LENGTH( Keyboard_Buffer );
  91.  
  92.                                    (* If PibTerm's keyboard buffer *)
  93.                                    (* not empty, read from it.     *)
  94.    IF ( L > 0 ) THEN
  95.       BEGIN
  96.  
  97.          KCh := Keyboard_Buffer[1];
  98.          DELETE( Keyboard_Buffer, 1, 1 );
  99.          DEC( L );
  100.                                    (* Ensure keypressed flag set *)
  101.                                    (* correctly.                 *)
  102.  
  103.          Return_KeyPressed := ( KCh <> CHR( ESC ) );
  104.  
  105.                                    (* Distinguish ESC sequence from *)
  106.                                    (* "ordinary" ESC.               *)
  107.          IF ( KCh = #$E0 ) THEN
  108.             IF ( L > 0 ) THEN
  109.                IF ( Keyboard_Buffer[1] = #$E0 ) THEN
  110.                   BEGIN
  111.                      KCh := CHR( ESC );
  112.                      DELETE( Keyboard_Buffer, 1, 1 );
  113.                   END;
  114.  
  115.       END
  116.    ELSE
  117.                                    (* PibTerm's buffer empty -- do *)
  118.                                    (* actual keyboard read.        *)
  119.       WITH Regs DO
  120.          BEGIN
  121.                                    (* BIOS read a character -- differs *)
  122.                                    (* depending upon whether 84 or 101 *)
  123.                                    (* key keyboard installed.          *)
  124.  
  125.             Do_Ext  := ( Extended_KeyBoard AND ( ( Mem[$40:$96] AND $10 ) <> 0 ) );
  126.  
  127.             IF Do_Ext THEN
  128.                Ah := $10
  129.             ELSE
  130.                Ah := 0;
  131.  
  132.             INTR( $16 , Regs );
  133.                                    (* If AL <> 0 Then it's ascii char *)
  134.                                    (* else either CHR(0) or escape    *)
  135.                                    (* sequence.  AH has scan code.    *)
  136.  
  137.             IF Do_Ext THEN
  138.                FOR I := 1 TO Max_Extended_Keys DO
  139.                   IF ( Regs.AX = Ext_AX_Vals[ I ] ) THEN
  140.                      BEGIN
  141.                         Regs.AX := Key_Values[ I ] SHL 8;
  142.                         GOTO 1;
  143.                      END;
  144. 1:
  145.             IF ( NOT ( AL IN [0, $E0, $F0 ] ) ) THEN
  146.                KCh := CHR( AL )
  147.             ELSE IF ( AX = $0300 ) THEN
  148.                KCh := CHR( 0 )
  149.             ELSE
  150.                BEGIN
  151.                   KCh                := CHR( ESC );
  152.                   Keyboard_Buffer[1] := CHR( AH );
  153.                   Keyboard_Buffer[0] := CHR( 1 );
  154.                END;
  155.  
  156.          END;
  157.                                    (* Return current character *)
  158.    ReadKeyboard := KCh;
  159.  
  160. END   (* ReadKeyboard *);
  161.