home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S2.ARC / LEARNACH.MOD < prev    next >
Encoding:
Text File  |  1987-12-03  |  4.3 KB  |  108 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Learn_A_Character --- Learn character for script              *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Learn_A_Character( Ch : CHAR );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*       Procedure:   Learn_A_Character                                 *)
  10. (*                                                                      *)
  11. (*       Purpose:     Learn character for script in learn mode          *)
  12. (*                                                                      *)
  13. (*       Calling Sequence:                                              *)
  14. (*                                                                      *)
  15. (*          Learn_A_Character( Ch: CHAR );                              *)
  16. (*                                                                      *)
  17. (*             Ch --- Character to be learned                           *)
  18. (*                                                                      *)
  19. (*----------------------------------------------------------------------*)
  20.  
  21. VAR
  22.    L: INTEGER;
  23.    I: INTEGER;
  24.    J: INTEGER;
  25.    K: INTEGER;
  26.  
  27. BEGIN (* Learn_A_Character *)
  28.                                    (* Output stuff from remote system *)
  29.  
  30.    IF ( LENGTH( Script_String_2 ) <> 0 ) THEN
  31.  
  32.                                    (* Any waitstring after first in sequence *)
  33.                                    (* is spurious so don't generate it.      *)
  34.  
  35.       IF ( NOT Script_Wait_Generated ) THEN
  36.          BEGIN
  37.  
  38.             L := LENGTH( Script_String_2 );
  39.             J := L;
  40.             K := 0;
  41.                                    (* If last chars are CR+LF, back up    *)
  42.                                    (* in front of them.                   *)
  43.             IF ( L > 1 ) THEN
  44.                IF ( ( Script_String_2[L]       = CHR( LF ) ) AND
  45.                     ( Script_String_2[PRED(L)] = CHR( CR ) ) ) THEN
  46.                   BEGIN
  47.                      DEC( L , 2 );
  48.                      J := L;
  49.                   END;
  50.                                    (* Loop until required number of lines *)
  51.                                    (* picked up.                          *)
  52.             REPEAT
  53.  
  54.                I := J;
  55.                L := J;
  56.                                    (* Scan for CR and LFs *)
  57.  
  58.                WHILE ( ( I > 1 ) AND ( NOT ( Script_String_2[I] IN [^M,^J] ) ) ) DO
  59.                   DEC( I );
  60.                                    (* Adjust text pointer for next line *)
  61.  
  62.                IF ( Script_String_2[I] = CHR( LF ) ) THEN
  63.                   IF ( Script_String_2[PRED(I)] = CHR( CR ) ) THEN
  64.                      J := I - 2
  65.                   ELSE
  66.                      J := PRED( I )
  67.                ELSE
  68.                   J := PRED( I );
  69.                                    (* Point after CR or LF *)
  70.  
  71.                IF ( Script_String_2[I] IN [^M,^J] ) THEN
  72.                   INC( I );
  73.                                    (* Generate waitstring if we got something *)
  74.  
  75.                IF ( I > 0 ) THEN
  76.                   IF ( ( L - I + 1 ) > 0 ) THEN
  77.                      BEGIN
  78.                         WRITELN( Script_File , 'WaitString "',
  79.                                  Write_Ctrls( COPY( Script_String_2, I, L - I + 1 ) ), '"' );
  80.                         INC( K );
  81.                      END;
  82.  
  83.             UNTIL ( ( K >= Script_Learn_Lines ) OR ( I <= 1 ) );
  84.  
  85.                                    (* Indicate a waitstring has been generated *)
  86.  
  87.             Script_Wait_Generated := TRUE;
  88.  
  89.          END;
  90.  
  91.    Script_String_2 := '';
  92.                                    (* If CR, end of user input, generate SText *)
  93.    IF( ORD( Ch ) = CR ) THEN
  94.       BEGIN
  95.          WRITELN( Script_File , 'SText "', Script_String, '|"' );
  96.          Script_String         := '';
  97.          Script_Wait_Generated := FALSE;
  98.       END
  99.    ELSE
  100.       IF ( LENGTH( Script_String ) = 240 ) THEN
  101.          BEGIN
  102.             MOVE( Script_String[2], Script_String[1], 239 );
  103.             Script_String[240] := Ch;
  104.          END
  105.       ELSE
  106.          Script_String := Script_String + Ch;
  107.  
  108. END   (* Learn_A_Character *);