home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / communic / ship / ship.pas
Pascal/Delphi Source File  |  1987-11-08  |  8KB  |  258 lines
  1. {-------------------------------- ship -----------------------------}
  2. {
  3. Purpose: To allow simple communications between the Slicer and
  4.          another system capable of sending and receiving characters
  5.          on an RS-232 port.
  6.  
  7. Method:  In Receive mode, SHIP accepts characters from port A
  8.          of the Expansion Board and puts them into a file. This
  9.          continues until a key is struck (on the Slicer). The
  10.          file is then closed. No error checking can be done with
  11.          this primitive method, so you should check the file for
  12.          errors after you have received it.
  13.  
  14.          In Send mode, SHIP simply opens the requested file and
  15.          sends it out port A of the Expansion board, one character
  16.          at a time until the entire file has been sent.
  17.  
  18.          Terminal mode is mainly for debugging and making sure that
  19.          both ends are cooperating. Terminal mode just gets
  20.          characters from the keyboard and sends them to the other
  21.          end while receiving characters and displaying them on the
  22.          screen.
  23.  
  24. History: Laine Stump     March 30,1985   vrs 1.0
  25.                                                                     }
  26. {-------------------------------------------------------------------}
  27.  
  28. PROGRAM ship (input, output, workfile);
  29.  
  30. CONST
  31.  
  32.     XON  = ^Q;  { codes for stopping/starting character stream }
  33.     XOFF = ^S;
  34.  
  35.     modereg    = $200;      { SC2681 mode }
  36.     statusreg  = $202;      {    "   status }
  37.     baudreg    = $202;      {    "   baudrate }
  38.     commandreg = $204;      {    "   command }
  39.     datareg    = $206;      {    "   data }
  40.     ACRreg     = $208;      {    "   baudrate set }
  41.     IMRreg     = $20A;      {    "   interrupt mode }
  42.  
  43.     TxRdy = 4;              { status mask for Transmit Ready }
  44.     RxRdy = 1;              { status mask for Receive Ready }
  45.  
  46.     IMRBYTE   = $00;    { turn off all interrupts }
  47.     COMBYTE  = $15;     { point to MR1, enable Tx & Rx }
  48.     MODEBYTE1 = $93;    { use RTS/CTS, no parity, 8 bits }
  49.     MODEBYTE2 = $1F;    { 2 stop bits }
  50.     SET2      = $80;    { select baudrate set 2 }
  51.  
  52.     BAUD300   = $44;    BAUD600   = $55;
  53.     BAUD1200  = $66;    BAUD2400  = $88;
  54.     BAUD4800  = $99;    BAUD9600  = $BB;
  55.     BAUD19200 = $CC;
  56.  
  57. VAR
  58.     workfile : text;
  59.  
  60.     { ct & ct2 are global so they will be static variables  }
  61.     { this is because static variables are sometimes faster }
  62.     ct, ct2 : integer;
  63.     buffer  : array[1..2048] of char;
  64.     baudrate : integer;
  65.     bits7    : boolean;
  66.     selection : char;
  67.  
  68. {-----------------------------------------}
  69. { initialize port for reading and writing }
  70. {-----------------------------------------}
  71. PROCEDURE initport ( baudrate : integer );
  72.  
  73.     begin
  74.     port[IMRreg]     := IMRBYTE;    { turn off ints }
  75.     port[commandreg] := COMBYTE;    { point to modebyte1 }
  76.     port[modereg]    := MODEBYTE1;  { set modes }
  77.     port[modereg]    := MODEBYTE2;
  78.     port[ACRreg]     := SET2;       { use baudrate set 2 }
  79.     CASE (baudrate) OF              { set requested baudrate }
  80.         300   : port[baudreg] := BAUD300;
  81.         600   : port[baudreg] := BAUD600;
  82.         1200  : port[baudreg] := BAUD1200;
  83.         2400  : port[baudreg] := BAUD2400;
  84.         4800  : port[baudreg] := BAUD4800;
  85.         9600  : port[baudreg] := BAUD9600;
  86.         19200 : port[baudreg] := BAUD19200
  87.         end     { case baudrate }
  88.     end;
  89.  
  90. {-----------------------------------------------}
  91. {    return TRUE if char ready, FALSE if not    }
  92. {-----------------------------------------------}
  93. FUNCTION ReadPortStat : boolean;
  94.  
  95. begin
  96. ReadPortStat := ((port[statusreg] and RxRdy) <> 0)
  97. end;    { ReadPortStat }
  98.  
  99. {-----------------------------------------------}
  100. { read a byte from port and return it to caller }
  101. {-----------------------------------------------}
  102. FUNCTION ReadPort : char;
  103.  
  104.     begin
  105.     REPEAT UNTIL (ReadPortStat);    { wait for char }
  106.     IF bits7 THEN
  107.         ReadPort := chr(port[datareg] and $7F)
  108.     ELSE
  109.         ReadPort := chr(port[datareg])
  110.     end;    { ReadPort }
  111.  
  112. {-----------------------------------------------}
  113. {           write a byte to port                }
  114. {-----------------------------------------------}
  115. PROCEDURE WritePort ( thisbyte : char );
  116.  
  117.     begin
  118.     REPEAT UNTIL (port[statusreg] and TxRdy) <> 0;
  119.     IF bits7 THEN
  120.         port[datareg] := ord(thisbyte) and $7F
  121.     ELSE
  122.         port[datareg] := ord(thisbyte)
  123.     end;    { WritePort }
  124.  
  125. { - - - beyond here is hardware independent - - - }
  126.  
  127. {-----------------------------------------------}
  128. {    prompt for a baudrate and init the port    }
  129. {-----------------------------------------------}
  130. PROCEDURE SetBaud (var baudrate : integer);
  131.  
  132. var yn : char;
  133.  
  134.     begin
  135.     writeln;
  136.     write ('Baudrate: ');
  137.     readln (baudrate);
  138.     InitPort(baudrate);
  139.     write ('Strip high bit? ');
  140.     read (kbd,yn); writeln (yn);
  141.     bits7 := (upcase(yn) = 'Y')
  142.     end;    { SetBaud }
  143.  
  144. {---------------------------------------}
  145. {   send chars typed at console to port }
  146. {   while echoing received chars        }
  147. {---------------------------------------}
  148. PROCEDURE Terminal;
  149.  
  150. VAR done : boolean;
  151.     ch   : char;
  152.  
  153.     begin
  154.     writeln('Terminal Mode, baudrate is ',baudrate);
  155.     writeln('Type control+_ to end');
  156.     writeln;
  157.     done := FALSE;
  158.     REPEAT
  159.         IF (KeyPressed) THEN    { char typed ? }
  160.             begin
  161.             read(kbd, ch);
  162.             IF (ch = ^_) THEN
  163.                 done := TRUE
  164.             ELSE
  165.                 WritePort(ch);  { send it }
  166.             end;    { if keypressed }
  167.  
  168.         IF (ReadPortStat) THEN  { char received ? }
  169.             write(ReadPort)     { display it }
  170.         UNTIL (done);
  171.     end;    { terminal }
  172.  
  173. {----------------------------------}
  174. {   receive a file from the port   }
  175. {----------------------------------}
  176. PROCEDURE Receive;
  177.  
  178. var filename : string[80];
  179.  
  180.     begin
  181.     write('Name for Received file: ');
  182.     readln(filename);
  183.     assign(workfile, filename);
  184.     rewrite (workfile);
  185.     write ('Start sending from other end, ');
  186.     writeln ('press a key on this keyboard when done');
  187.     ct := 0;
  188.     WHILE (not Keypressed) DO
  189.         IF (ReadPortStat) THEN
  190.             begin
  191.             ct := ct + 1;
  192.             buffer[ct] := ReadPort;     { save in buffer }
  193.             IF (buffer[ct] = ^M) THEN
  194.                 begin
  195.                 WritePort(XOFF);        { turn off other end }
  196.                 FOR ct2 := 1 to ct DO   { dump buffer to file }
  197.                     write (workfile, buffer[ct2]);
  198.                 ct := 0;
  199.                 WritePort(XON);         { turn back on }
  200.                 end;    { if received char = ^M }
  201.             end;    { if character ready }
  202.  
  203.     IF (ct > 0) THEN              { write out partial line }
  204.         FOR ct2 := 1 to ct DO
  205.             write(workfile, buffer[ct2]);
  206.     close (workfile)
  207.     end;    { Receive }
  208.  
  209. {--------------------------------}
  210. {    send a file out the port    }
  211. {--------------------------------}
  212. PROCEDURE Send;
  213.  
  214. var ch : char;
  215.     filename : string[80];
  216.  
  217.     begin
  218.     write('Name of File to Send: ');
  219.     readln(filename);
  220.     assign(workfile, filename);
  221.     reset (workfile);
  222.     write ('Set up other end to receive, ');
  223.     writeln ('press a key on this keyboard when ready');
  224.     REPEAT UNTIL (Keypressed);
  225.     WHILE (not EOF(workfile)) DO
  226.         begin
  227.         IF (ReadPortStat) THEN      { check for XOFF }
  228.             IF (ReadPort = XOFF) THEN
  229.                 REPEAT UNTIL (ReadPort = XON);
  230.         read(workfile, ch);         { get a char }
  231.         WritePort (ch);             { send it }
  232.         IF (ch = ^M) THEN           { IF eoln wait for XON }
  233.             REPEAT UNTIL (ReadPort = XON)
  234.         end;    { while not eof }
  235.     close (workfile)
  236.     end;    { Receive }
  237.  
  238. {---- main ----}
  239.  
  240. begin
  241. SetBaud (baudrate);
  242. REPEAT
  243.     writeln;
  244.     write ('<B>audrate, <T>erminal, <S>end, <R>eceive, <Q>uit: ');
  245.     read(kbd,selection); writeln(selection);
  246.     CASE (upcase(selection)) OF
  247.         'B' : SetBaud (baudrate);
  248.         'T' : Terminal;
  249.         'R' : Receive;
  250.         'S' : Send;
  251.         'Q','E','X' : ;
  252.       ELSE
  253.         writeln ('Bad Option, Try Again');
  254.       end   { case selection }
  255.     UNTIL (upcase(selection) in ['Q','X','E']);
  256. writeln ('Bye now, have a good afternoon.')
  257. end.
  258.