lserial.pas

   1 {$mode delphi}
   2 unit lserial;
   3 interface
   4 uses
   5   lcore;
   6
   7 type
   8   tlserial=class(tlasio)
   9   public
  10     device: string;
  11         baudrate: longint;
  12     procedure open;
  13   end;
  14
  15
  16 implementation
  17 uses
  18   baseunix,
  19   unix,
  20   unixutil,
  21   termio, // despite the name the fpc termio unit seems to be an interface to termios
  22   sysutils;
  23 procedure tlserial.open;
  24 var
  25   fd : longint;
  26   config : termios;
  27   baudrateos : longint;
  28 begin
  29   fd := fpopen(device,O_RDWR or O_NOCTTY or O_NONBLOCK);
  30
  31   if isatty(fd)=0 then begin
  32     writeln('not a tty');
  33     halt(1);
  34   end;
  35
  36   fillchar(config,sizeof(config),#0);
  37   config.c_cflag := CLOCAL or CREAD;
  38   cfmakeraw(config);
  39   case baudrate of
  40     50:     baudrateos := B50;
  41         75:     baudrateos := B75;
  42         110:    baudrateos := B110;
  43         134:    baudrateos := B134;
  44         150:    baudrateos := B150;
  45         200:    baudrateos := B200;
  46         300:    baudrateos := B300;
  47         600:    baudrateos := B600;
  48         1200:   baudrateos := B1200;
  49         1800:   baudrateos := B1800;
  50         2400:   baudrateos := B2400;
  51         4800:   baudrateos := B4800;
  52         9600:   baudrateos := B9600;
  53         19200:  baudrateos := B19200;
  54         38400:  baudrateos := B38400;
  55         57600:  baudrateos := B57600;
  56         115200: baudrateos := B115200;
  57         230400: baudrateos := B230400;
  58         else raise exception.create('unrecognised baudrate');
  59   end;
  60   cfsetispeed(config,baudrateos);
  61   cfsetospeed(config,baudrateos);
  62   config.c_cc[VMIN]  := 1;
  63   config.c_cc[VTIME] := 0;
  64   if   tcsetattr(fd,TCSAFLUSH,config) <0 then begin
  65     writeln('could not set termios attributes');
  66     halt(3);
  67   end;
  68   dup(fd);
  69   closehandles := true;
  70 end;
  71 end.