lserial.pas

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