home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBT41S1.ZIP / DOSCRIPC.MOD < prev    next >
Encoding:
Text File  |  1988-02-25  |  6.6 KB  |  170 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Do_Script_Checks --- Check Script-related quantities for character *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Do_Script_Checks( Ch: CHAR );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Do_Script_Checks                                     *)
  10. (*                                                                      *)
  11. (*     Purpose:    Do script-related checks on character received       *)
  12. (*                 from comm port.                                      *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Do_Script_Checks( Ch : CHAR );                                *)
  17. (*                                                                      *)
  18. (*           Ch --- Character received from Comm. port.                 *)
  19. (*                                                                      *)
  20. (*      Calls:   TimeOfDay                                              *)
  21. (*               TimeDiff                                               *)
  22. (*               Send_Function_Key                                      *)
  23. (*               Check_Wait_String_Time                                 *)
  24. (*                                                                      *)
  25. (*----------------------------------------------------------------------*)
  26.  
  27. VAR
  28.    L  : INTEGER;
  29.    L2 : INTEGER;
  30.    I  : INTEGER;
  31.  
  32. LABEL 1;
  33.  
  34. (*----------------------------------------------------------------------*)
  35.  
  36. FUNCTION CmpS( S1, S2 : AnyStr; N : INTEGER ) : BOOLEAN;
  37.  
  38. BEGIN (* CmpS *)
  39.  
  40.    N := MIN( N , LENGTH( S1 ) );
  41.    N := MIN( N , LENGTH( S2 ) );
  42.  
  43.    CmpS := ( COPY( S1, 1, N ) = COPY( S2, 1, N ) );
  44.  
  45. END   (* CmpS *);
  46.  
  47. (*----------------------------------------------------------------------*)
  48.  
  49. BEGIN (* Do_Script_Checks *)
  50.                                    (* Skip checks for NUL, DEL    *)
  51.  
  52.    IF ( ( Ch = CHR( NUL ) ) OR ( Ch = CHR( DEL ) ) ) THEN
  53.       EXIT;
  54.                                    (* Check for WHEN string       *)
  55.    IF When_Mode THEN
  56.       BEGIN
  57.  
  58.          L := LENGTH( Script_When_Save );
  59.  
  60.          IF ( L < LENGTH( Script_When_Text ) ) THEN
  61.             Script_When_Save := Script_When_Save + Ch
  62.          ELSE
  63.             BEGIN
  64.  
  65.                MOVE( Script_When_Save[2], Script_When_Save[1], PRED( L ) );
  66.                Script_When_Save[L] := Ch;
  67.  
  68.                IF ( Script_When_Text[1] = Script_When_Save[1] ) THEN
  69.                   IF ( CmpS( Script_When_Text , Script_When_Save , L ) ) THEN
  70.                      BEGIN
  71.                         Script_When_Save := '';
  72.                         Send_Function_Key( Read_Ctrls( Script_When_Reply_Text ) );
  73.                      END;
  74.  
  75.             END;
  76.  
  77.       END (* When_Mode *);
  78.  
  79.                                    (* Check for WAITCOUNT *)
  80.    IF WaitCount_Mode THEN
  81.       BEGIN
  82.          INC( Script_Wait_Char_Count );
  83.          IF ( Script_Wait_Char_Count >= Script_Wait_Check_Length ) THEN
  84.             BEGIN
  85.                WaitCount_Mode     := FALSE;
  86.                Really_Wait_String := FALSE;
  87.                Script_Wait_Found  := TRUE;
  88.             END
  89.          ELSE IF ( TimeDiff( Script_Wait_Start , TimeOfDay ) > Script_Wait_Time ) THEN
  90.             BEGIN
  91.                WaitCount_Mode      := FALSE;
  92.                Really_Wait_String  := FALSE;
  93.                Script_Wait_Found   := FALSE;
  94.             END;
  95.       END;
  96.                                    (* Check for WAIT string       *)
  97.    IF WaitString_Mode THEN
  98.       BEGIN
  99.                                    (* Add in new character and        *)
  100.                                    (* check if wait string(s) present *)
  101.  
  102.          L := LENGTH( Script_Wait_Save );
  103.  
  104.          IF ( L < Script_Wait_Check_Length ) THEN
  105.             Script_Wait_Save := Script_Wait_Save + Ch
  106.          ELSE
  107.             BEGIN
  108.                MOVE( Script_Wait_Save[2], Script_Wait_Save[1], PRED( L ) );
  109.                Script_Wait_Save[L] := Ch;
  110.             END;
  111.  
  112.          FOR I := 1 TO Script_Wait_Count DO
  113.             WITH Script_Wait_List[I] DO
  114.                BEGIN
  115.                   L2 := LENGTH( Wait_Text^ );
  116.                   IF( L >= L2 ) THEN
  117.                      IF ( Wait_Text^[1] = Script_Wait_Save[L - L2 + 1] ) THEN
  118.                         IF ( CmpS( Wait_Text^ ,
  119.                              COPY( Script_Wait_Save, L - L2 + 1, 255 ),
  120.                              L2 ) ) THEN
  121.                            BEGIN
  122.                               Script_Wait_Save    := '';
  123.                               Script_Wait_Found   := TRUE;
  124.                               WaitString_Mode     := FALSE;
  125.                               Really_Wait_String  := FALSE;
  126.                               IF ( Script_Wait_Result_Index > 0 ) THEN
  127.                                  Script_Variables^[Script_Wait_Result_Index].Var_Value^ :=
  128.                                      CHR( I ) + CHR( 0 );
  129.                               Send_Function_Key( Read_Ctrls( Wait_Reply^ ) );
  130.                               GOTO 1;
  131.                            END;
  132.                END;
  133.                                    (* Check if wait time exhausted *)
  134. 1:       IF WaitString_Mode THEN
  135.             Check_Wait_String_Time
  136.          ELSE                      (* Free up waitstring storage *)
  137.             BEGIN
  138.                FOR I := 1 TO Script_Wait_Count DO
  139.                   WITH Script_Wait_List[I] DO
  140.                      BEGIN
  141.                         DISPOSE( Wait_Text );
  142.                         DISPOSE( Wait_Reply );
  143.                      END;
  144.                Script_Wait_Count := 0;
  145.             END;
  146.  
  147.       END  (* WaitString_Mode *);
  148.  
  149.                                    (* Check for Script LEARN mode *)
  150.    IF Script_Learn_Mode THEN
  151.       BEGIN
  152.  
  153.          L := LENGTH( Script_String_2 );
  154.  
  155.          IF ( L < Script_Learn_Buffer_Size ) THEN
  156.             Script_String_2 := Script_String_2 + Ch
  157.          ELSE
  158.             BEGIN
  159.                MOVE( Script_String_2[2], Script_String_2[1],
  160.                      PRED( Script_Learn_Buffer_Size ) );
  161.                Script_String_2[Script_Learn_Buffer_Size] := Ch;
  162.             END;
  163.  
  164.       END (* Script_Learn_Mode *);
  165.  
  166.                                    (* Reset WAITQUIET *)
  167.    IF WaitQuiet_Mode THEN
  168.       Script_Wait_Start := TimeOfDayH;
  169.  
  170. END    (* Do_Script_Checks *);