home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / pibterm / pibt41s4.arc / SENDFUNK.MOD < prev    next >
Text File  |  1988-02-19  |  6KB  |  166 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       Send_Function_Key  --- Send function key definition            *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Send_Function_Key( Key_Text : AnyStr ) ;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*       Procedure:  Send_Function_Key                                  *)
  10. (*                                                                      *)
  11. (*       Purpose:    Send function key definition                       *)
  12. (*                                                                      *)
  13. (*       Calling Sequence:                                              *)
  14. (*                                                                      *)
  15. (*           Send_Function_Key( Key_Text : AnyStr );                    *)
  16. (*                                                                      *)
  17. (*              Input_Key_Text   --- text to be sent                    *)
  18. (*                                                                      *)
  19. (*       Remarks:                                                       *)
  20. (*                                                                      *)
  21. (*          If the string to be sent has not "Wait For" markers, then   *)
  22. (*          it is sent in its entirety in one call here.  If there ARE  *)
  23. (*          "Wait For" characters, then the flag WaitString_Mode is set *)
  24. (*          TRUE, Script_Wait_Text is set to the character to be found, *)
  25. (*          and  Script_Wait_Reply_Text is set to the remainder of the  *)
  26. (*          function key string.  This allows the terminal emulation to *)
  27. (*          properly process any received characters while PibTerm is   *)
  28. (*          waiting for the selected string to appear.                  *)
  29. (*                                                                      *)
  30. (*----------------------------------------------------------------------*)
  31.  
  32. VAR
  33.    I       : INTEGER;
  34.    L       : INTEGER;
  35.    Ch      : CHAR;
  36.    FK_Char : CHAR;
  37.    Done    : BOOLEAN;
  38.    Kbd_On  : BOOLEAN;
  39.    Delim_Ch: CHAR;
  40.  
  41. CONST
  42.    Alt_Vals: ARRAY['A'..'Z'] OF BYTE =
  43.              ( Alt_A, Alt_B, Alt_C, Alt_D, Alt_E, Alt_F, Alt_G,
  44.                Alt_H, Alt_I, Alt_J, Alt_K, Alt_L, Alt_M, Alt_N,
  45.                Alt_O, Alt_P, Alt_Q, Alt_R, Alt_S, Alt_T, Alt_U,
  46.                Alt_V, Alt_W, Alt_X, Alt_Y, Alt_Z );
  47.  
  48. (*----------------------------------------------------------------------*)
  49.  
  50. PROCEDURE FK_Send_Char( Ch : CHAR );
  51.  
  52. BEGIN (* FK_Send_Char *)
  53.  
  54.    Async_Send_Now( Ch );
  55.  
  56.    IF Local_Echo THEN
  57.       Async_Stuff( Ch );
  58.  
  59.    IF ( FK_Delay_Time > 0 ) THEN
  60.       DELAY( FK_Delay_Time );
  61.  
  62. END   (* FK_Send_Char *);
  63.  
  64. (*----------------------------------------------------------------------*)
  65.  
  66. BEGIN (* Send_Function_Key *)
  67.  
  68.    L        := LENGTH( Key_Text );
  69.    I        := 1;
  70.    Done     := FALSE;
  71.    Kbd_On   := FALSE;
  72.  
  73.    WHILE( I <= L ) AND ( NOT Done ) DO
  74.       BEGIN
  75.  
  76.          FK_Char := Key_Text[I];
  77.  
  78.          IF Kbd_On THEN
  79.             BEGIN
  80.                IF ( Key_Text[I] <> Delim_Ch ) THEN
  81.                   Keyboard_Buffer := Keyboard_Buffer + Key_Text[I]
  82.                ELSE
  83.                   Kbd_On := FALSE;
  84.             END
  85.          ELSE IF FK_Char = FK_CR THEN
  86.             FK_Send_Char( CHR( CR ) )
  87.  
  88.          ELSE IF FK_Char = FK_Delay THEN
  89.             DELAY( One_Second_Delay )
  90.  
  91.          ELSE IF FK_Char = FK_Script_Ch THEN
  92.             BEGIN
  93.                INC( I );
  94.                IF ( I <= L ) THEN
  95.                   BEGIN
  96.                      Ch := UpCase( Key_Text[I] );
  97.                      IF ( Ch IN ['A'..'Z'] ) THEN
  98.                         BEGIN
  99.                            Keyboard_Buffer := Keyboard_Buffer +
  100.                                               #$E0 + #$E0     +
  101.                                               CHR( Alt_Vals[ Ch ] );
  102.                            Kbd_On := FALSE;
  103.                         END
  104.                      ELSE
  105.                         BEGIN
  106.                            Delim_Ch := Key_Text[I];
  107.                            Kbd_On   := TRUE;
  108.                         END;
  109.                   END;
  110.             END
  111.  
  112.          ELSE IF FK_Char = FK_Ctrl_Mark THEN
  113.             BEGIN
  114.                IF ( ( I + 2 ) <= L ) THEN
  115.                   IF ( Key_Text[ SUCC( I ) ] = '''' ) THEN
  116.                      INC( I , 2 );
  117.                Async_Send_Now( Key_Text[I] );
  118.             END
  119.  
  120.          ELSE IF FK_Char = FK_Wait_For THEN
  121.             BEGIN   (* Wait For *)
  122.  
  123.                INC( I );
  124.  
  125.                IF ( I <= L ) THEN
  126.                   BEGIN
  127.  
  128.                      WITH Script_Wait_List[1] DO
  129.                         BEGIN
  130.                            NEW( Wait_Text );
  131.                            IF( Wait_Text <> NIL ) THEN
  132.                               Wait_Text^ := Key_Text[I];
  133.                            NEW( Wait_Reply );
  134.                            INC( I );
  135.                            IF ( Wait_Reply <> NIL ) THEN
  136.                               BEGIN
  137.                                  IF ( I <= L ) THEN
  138.                                     Wait_Reply^ := COPY( Key_Text, I, L - I + 1 )
  139.                                  ELSE
  140.                                     Wait_Reply^:= '';
  141.                                  Script_Wait_Check_Length := 1;
  142.                               END;
  143.                         END;
  144.  
  145.                      Script_Wait_Count      := 1;
  146.                      WaitString_Mode        := TRUE;
  147.                      Really_Wait_String     := TRUE;
  148.                      Script_Wait_Time       := Script_Default_Wait_Time;
  149.                      IF ( Script_Wait_Time <= 0 ) THEN
  150.                         Script_Wait_Time := 60;
  151.                      Script_Wait_Failure    := 0;
  152.                      Done                   := TRUE;
  153.                      Script_Wait_Start      := TimeOfDay;
  154.  
  155.                   END;
  156.  
  157.             END
  158.          ELSE
  159.             FK_Send_Char( Key_Text[I] );
  160.  
  161.          INC( I );
  162.  
  163.       END;
  164.  
  165. END   (* Send_Function_Key *);
  166.