home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / perqa.tar.gz / perqa.tar / connect232.pas next >
Pascal/Delphi Source File  |  1984-12-04  |  6KB  |  199 lines
  1. MODULE Connect232 ;
  2.  
  3. (*)
  4.  *  A communications routine via the RS232 line to another host.
  5.  *  Parameters are:
  6.  *
  7.  *      EscChar         The "escape" character, when this character is read
  8.  *                      from the keyboard return to caller.
  9.  *      HalfDuplex      The state of the host's connection, if HalfDuplex is
  10.  *                      true echo the keyboard characters locally.
  11.  *      TabletOk        If true, the yellow button on the puck causes an
  12.  *                      exit too.
  13.                         5-Oct-83. Change cursor shape and allow ANY puck button
  14.                         to cause an exit.
  15.  *      RETURN:         ConCharExit    if <EscChar> caused exit,
  16.  *                      ConButtonExit  for puck button.
  17. (*)
  18.  
  19. EXPORTS    (*-------------*)
  20.  
  21. IMPORTS IO_Unit   FROM IO_Unit;
  22. IMPORTS IOErrors  FROM IOErrors;
  23.  
  24. TYPE
  25.     (* What caused "Connect" to exit *)
  26.     ConExitFlag = (ConCharExit, ConButtonExit) ;
  27.  
  28.  
  29. FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
  30.  
  31.  
  32. PRIVATE   (*---------------*)
  33.  
  34. IMPORTS Screen    FROM Screen ;
  35. IMPORTS System    FROM System ;
  36. IMPORTS IO_Others FROM IO_Others;
  37.  
  38. FUNCTION Connect( EscChar: Char; HalfDuplex, TabletOk: Boolean ) : ConExitFlag;
  39.    CONST
  40.       NUL =   Chr(#000) ;
  41.       BS  =   Chr(#010) ;
  42.       TAB =   Chr(#011) ;
  43.       LF  =   Chr(#012) ;
  44.       CR  =   Chr(#015) ;
  45.       CtrlQ = Chr(#021) ;
  46.       CtrlS = Chr(#023) ;
  47.    VAR
  48.       hpos:  Integer ;   (* current position in the line (for tabs) *)
  49.       oldX, oldY: Integer ;    (* Old cursor offsets *)
  50.       quit:  Boolean ;         (* loop control *)
  51.       LineChr, KeyChr:  Char;  (* current RS232 and keyboard characters *)
  52.       OldCurs, NewCurs: CurPatPtr ;  (* Old and New cursors (if TabletOk) *)
  53.       return: ConExitFlag ;    (* the exit flag *)
  54.  
  55.    PROCEDURE WriteChr( c: Char ) ;
  56.       BEGIN
  57.          SPutChr( c ) ;
  58.          Hpos := Hpos + 1
  59.       END ;
  60.  
  61.    HANDLER CtlC ;
  62.       BEGIN
  63.       END ;
  64.  
  65.    BEGIN  (*-Connect-*)
  66.  
  67.       (* Allocate cursor space *)
  68.       New( 0, 4, NewCurs) ;
  69.       New( 0, 4, OldCurs) ;
  70.  
  71.       (* Clear the cursor area *)
  72.       RasterOp(RXor, 64, 64, 0, 0, 4, RECAST(NewCurs, RasterPtr),
  73.                              0, 0, 4, RECAST(NewCurs, RasterPtr) ) ;
  74.  
  75. (* Cursor values from file: Connect3.Cursor *)
  76.       NewCurs^[ 0,0] := #40 ;
  77.       NewCurs^[ 1,0] := #120 ;
  78.       NewCurs^[ 1,1] := #1642 ;
  79.       NewCurs^[ 1,2] := #167000 ;
  80.       NewCurs^[ 2,0] := #210 ;
  81.       NewCurs^[ 2,1] := #1024 ;
  82.       NewCurs^[ 2,2] := #42000 ;
  83.       NewCurs^[ 3,0] := #404 ;
  84.       NewCurs^[ 3,1] := #1610 ;
  85.       NewCurs^[ 3,2] := #42000 ;
  86.       NewCurs^[ 4,0] := #1002 ;
  87.       NewCurs^[ 4,1] := #1024 ;
  88.       NewCurs^[ 4,2] := #42000 ;
  89.       NewCurs^[ 5,0] := #404 ;
  90.       NewCurs^[ 5,1] := #1642 ;
  91.       NewCurs^[ 5,2] := #162000 ;
  92.       NewCurs^[ 6,0] := #2211 ;
  93.       NewCurs^[ 7,0] := #5122 ;
  94.       NewCurs^[ 7,1] := #100000 ;
  95.       NewCurs^[ 8,0] := #10444 ;
  96.       NewCurs^[ 8,1] := #40000 ;
  97.       NewCurs^[ 9,0] := #20210 ;
  98.       NewCurs^[ 9,1] := #20000 ;
  99.       NewCurs^[10,0] := #40120 ;
  100.       NewCurs^[10,1] := #10000 ;
  101.       NewCurs^[11,0] := #20210 ;
  102.       NewCurs^[11,1] := #20000 ;
  103.       NewCurs^[12,0] := #10444 ;
  104.       NewCurs^[12,1] := #40000 ;
  105.       NewCurs^[13,0] := #5122 ;
  106.       NewCurs^[13,1] := #100000 ;
  107.       NewCurs^[14,0] := #2211 ;
  108.       NewCurs^[15,0] := #404 ;
  109.       NewCurs^[16,0] := #1002 ;
  110.       NewCurs^[17,0] := #404 ;
  111.       NewCurs^[18,0] := #210 ;
  112.       NewCurs^[19,0] := #120 ;
  113.       NewCurs^[20,0] := #40 ;
  114.  
  115.  
  116.       (* Debug :- %)
  117.       Writeln('TabletOk = ', TabletOk) ;
  118.       (% Debug    *)
  119.  
  120.  
  121.       SCurOn ;  (* ? *)
  122.  
  123.  
  124.       (* Set up our cursor, or turn the cursor off if we can't use a cursor *)
  125.       IF TabletOk THEN
  126.          BEGIN
  127.             IOReadCursPicture( OldCurs, oldX, oldY ) ;
  128.             IOLoadCursor( NewCurs, 0, 0) ;
  129.             IOSetModeTablet( relTablet ) ;
  130.             IOCursorMode( TrackCursor )
  131.          END
  132.       ELSE
  133.          IOCursorMode( OffCursor ) ;  (* Turn it off *)
  134.  
  135.       return := ConCharExit ;  (* Assume the exit by escape char *)
  136.       quit := False ;
  137.       WHILE NOT quit DO
  138.          BEGIN
  139.             (*----------   RS232 Input   ----------*)
  140.             IF (IOCRead(RS232In, LineChr)=IOEIOC)  THEN
  141.                BEGIN
  142.                   LineChr := Chr( Land( Ord(LineChr), #177) ) ;
  143.                   IF (LineChr = TAB) THEN
  144.                      BEGIN
  145.                         WriteChr( ' ' ) ;
  146.                         WHILE (Hpos MOD 8) <> 0 DO  WriteChr( ' ' )
  147.                      END
  148.                   ELSE
  149.                      IF (LineChr = BS) THEN
  150.                         BEGIN
  151.                            IF Hpos > 0 THEN
  152.                               BEGIN (* Delete the character *)
  153.                                  SBackSpace( ' ' );
  154.                                  SPutChr( ' ' ) ;
  155.                                  SBackSpace( ' ' ) ;
  156.                                  Hpos := Hpos - 1
  157.                               END
  158.                         END
  159.                      ELSE
  160.                         IF (LineChr IN [NUL, CtrlS, CtrlQ]) THEN (* NOTHING *)
  161.                         ELSE
  162.                            WriteChr( LineChr ) ;   (* write it *)
  163.  
  164.                   IF (LineChr IN [CR, LF]) THEN  Hpos := 0 ;  (* a new line *)
  165.                END ; (* RS232 input *)
  166.  
  167.             (*----------   Keyboard Input   ----------*)
  168.             IF (IOCRead(TransKey, KeyChr)=IOEIOC) THEN
  169.                BEGIN
  170.                   IF (KeyChr = EscChar) THEN
  171.                      BEGIN
  172.                         quit := True
  173.                      END
  174.                   ELSE
  175.                      BEGIN
  176.                         IF IOCWrite(RS232Out, KeyChr)<>IOEIOC THEN
  177.                            KeyChr := Chr(#277) ;
  178.                         IF HalfDuplex THEN WriteChr( KeyChr )
  179.                      END
  180.                END ; (* Keyboard input *)
  181.  
  182.             (*----------   Tablet Input   ----------*)
  183.             IF TabletOk AND TabSwitch THEN
  184.               BEGIN
  185.                 return := ConButtonExit ;
  186.                 quit := True
  187.               END
  188.  
  189.          END ; (* while *)
  190.  
  191.       (* Restore cursor *)
  192.       IF TabletOk THEN IOLoadCursor( OldCurs, oldX, oldY )
  193.       ELSE IOCursorMode( TrackCursor ) ; (* I assume it was originally on *)
  194.       Dispose( NewCurs ) ;
  195.  
  196.       Connect := return
  197.    END .  (*-Connect-*)
  198.  
  199.