add lserial.pas

[lcore.git] / lserial.pas

diff --git a/lserial.pas b/lserial.pas
new file mode 100755 (executable)
index 0000000..e7b6d27
--- /dev/null
+++ b/lserial.pas
@@ -0,0 +1,71 @@
+{$mode delphi}
+unit lserial;\r
+interface\r
+uses \r
+  lcore;\r
+  \r
+type\r
+  tlserial=class(tlasio)\r
+  public \r
+    device: string;\r
+       baudrate: longint;\r
+    procedure open;\r
+  end;\r
+  \r
+  \r
+implementation\r
+uses\r
+  baseunix,\r
+  unix,\r
+  unixutil,\r
+  termio, // despite the name the fpc termio unit seems to be an interface to termios\r
+  sysutils;\r
+procedure tlserial.open;\r
+var\r
+  fd : longint;\r
+  config : termios;\r
+  baudrateos : longint;\r
+begin\r
+  fd := fpopen(device,O_RDWR or O_NOCTTY);\r
+  \r
+  if isatty(fd)=0 then begin\r
+    writeln('not a tty');\r
+    halt(1);\r
+  end;\r
+\r
+  fillchar(config,sizeof(config),#0);\r
+  config.c_cflag := CLOCAL or CREAD;\r
+  cfmakeraw(config);\r
+  case baudrate of\r
+    50:     baudrateos := B50;\r
+       75:     baudrateos := B75;\r
+       110:    baudrateos := B110;\r
+       134:    baudrateos := B134;\r
+       150:    baudrateos := B150;\r
+       200:    baudrateos := B200;\r
+       300:    baudrateos := B300;\r
+       600:    baudrateos := B600;\r
+       1200:   baudrateos := B1200;\r
+       1800:   baudrateos := B1800;\r
+       2400:   baudrateos := B2400;\r
+       4800:   baudrateos := B4800;\r
+       9600:   baudrateos := B9600;\r
+       19200:  baudrateos := B19200;\r
+       38400:  baudrateos := B38400;\r
+       57600:  baudrateos := B57600;\r
+       115200: baudrateos := B115200;\r
+       230400: baudrateos := B230400; \r
+       else raise exception.create('unrecognised baudrate');\r
+  end;\r
+  cfsetispeed(config,baudrateos);\r
+  cfsetospeed(config,baudrateos);\r
+  config.c_cc[VMIN]  := 1;\r
+  config.c_cc[VTIME] := 0;\r
+  if   tcsetattr(fd,TCSAFLUSH,config) <0 then begin\r
+    writeln('could not set termios attributes');\r
+    halt(3);\r
+  end;\r
+  dup(fd);\r
+  closehandles := true;\r
+end;\r
+end.
\ No newline at end of file