| Recently, I received as gift medical instruments designed by one of my father former students. There is a description of these instruments on my web page. Here is the address: http://www.discenda.org/med/ By the way, I am not that guy that appears in a picture wearing emg sensors. That said, the instruments and everything else are programmed in Clean. Then I have a new opportunity of translating Clean programs to Haskell and test them in a real application application. Of course, I simplified the programs to see how they work. The medical instruments have on-board computers, that record signals (electromyograms, electroencephalograms, electrocardiograms, end-tydal CO2 partial pressure and temperature), pre-process them and send them to the main computer. The main-computer recognizes patterns in the signals, and use the result to drive a wheelchair, or to call a doctor. On my page you wil find more complete explanations and pictures of the instruments. For ready reference, here is my address: http://www.discenda.org/med/ I decided start my translation work from the most simple programs, the graphical interface and the communication protocol. After substituting a Haskell program for the Clean original, I discovered that the system did not work anymore if I exited the Haskell program. In few words, after leaving the Haskell program without turning off the computer or the sensors, and entering the Haskell program again, Haskell failed to communicate with the sensors. I did what I always do in such a situation: I simplified the program until I reduced it to a few lines. I discovered that Haskell failed to close the serial port. There is a serial to UART-0 driver that allows me to plug the serial cable to a USB port, that both feeds the sensors, and permit communication. I fixed the bug by passing a useless integer argument to the function used to close the port. Since I don't like this kind of patch (useless arguments), I would like to know why the original program does not work, and also I would appreciate if someone could suggest a way to get rid of the argument whose sole job is force Haskell to close the port. The GUI is based on the Small JAPI biding, fixed and incremented with text processing components. Here is the fixed Haskell program: import Gui.Binding import Gui.Types import Gui.Constants import SER.IAL import Control.Monad import Data.Char main = do rv <- j_start frame <- j_frame "Sensors" exit_button <- j_button frame "Exit" j_setpos exit_button 50 50 j_setsize exit_button 80 30 fld <- j_textfield frame 30 j_setpos fld 50 100 j_show frame opencport(4) waitForFrameAction frame fld exit_button let r = closecport 7 {- without the argument, closecport does not work -} print r return j_quit waitForFrameAction :: Frame -> Object -> Object -> IO Bool waitForFrameAction frame f b = do obj <- j_nextaction again <- if obj == event b then return False else do {- nm <- j_gettext f 200 -} tx <- sendMessage 1 "t" let tp= filter (> ' ') tx rx <- sendMessage 1 "x" let rd= filter (> ' ') rx let x = hex2dec rd let tt= (fromIntegral x)*209.0/1024 - 67.5 j_settext f ((show tt)++" ==> "++tp) return True if not again then return True else waitForFrameAction frame f b hex2dec :: String -> Int hex2dec h= sum (zipWith (*) (map (16^) [3,2,1,0]) [digitToInt c | c <- h]) convert d r s0= (fromIntegral (hex2dec d))*r/1024.0- s0 As I told before, let r = closecport 7 did not work until I gave it an argument. Here is the interface between the C-side, and the Haskell-side of the program: {-# LANGUAGE ForeignFunctionInterface #-} module SER.IAL where import Control.Monad import Foreign import Foreign.C.Types import Foreign.C foreign import ccall "rs232.h opencport" opencport :: CInt -> IO () foreign import ccall "rs232.h closecport" closecport :: CInt -> CInt foreign import ccall "rs232.h rdrs232" c_sendmsg :: CInt -> CString -> CString sendMessage :: Int -> String -> IO String sendMessage n msg = withCString msg $ \str -> peekCString (c_sendmsg (fromIntegral n) str) Originally, I had the following line (that did not work properly): foreign import ccall "rs232.h closecport" closecport :: IO () You will find below the C-program. The original program (that did not work) had the following definition for closecport: int closecport() { CloseComport(); return 3; } This deffinition (that did not work) was replaced by the following one: int closecport(int n) { CloseComport(); return n; } Here is the complete C program: #include "serial.h" #include <string.h> #include <stdio.h> /* Possible baudrates on a normal pc: 50, 75, 110, 134, 150, 200, 300, 600, 1200, 1800, 2400, 4800, 9600, 19200, 38400, 57600, 115200 */ #define BAUD "baud=9600 data=8 parity=N stop=1" HANDLE Cport; char comports[16][10]={"\\\\.\\COM1", "\\\\.\\COM2", "\\\\.\\COM3", "\\\\.\\COM4", "\\\\.\\COM5", "\\\\.\\COM6", "\\\\.\\COM7", "\\\\.\\COM8", "\\\\.\\COM9", "\\\\.\\COM10", "\\\\.\\COM11", "\\\\.\\COM12", "\\\\.\\COM13", "\\\\.\\COM14", "\\\\.\\COM15", "\\\\.\\COM16"}; int OpenComport(int comport_number) { if(comport_number>15) { printf("illegal comport number\n"); return(1); } Cport = CreateFileA(comports[comport_number], GENERIC_READ|GENERIC_WRITE, 0, /* no share */ NULL, /* no security */ OPEN_EXISTING, 0, /* no threads */ NULL); /* no templates */ if(Cport==INVALID_HANDLE_VALUE) { printf("unable to open comport\n"); return(1); } DCB port_settings; memset(&port_settings, 0, sizeof(port_settings)); /* clear the new struct */ port_settings.DCBlength = sizeof(port_settings); if(!BuildCommDCBA(BAUD, &port_settings)) { printf("unable to set comport dcb settings\n"); CloseHandle(Cport); return(1); } if(!SetCommState(Cport, &port_settings)) { printf("unable to set comport cfg settings\n"); CloseHandle(Cport); return(1); } COMMTIMEOUTS Cptimeouts; Cptimeouts.ReadIntervalTimeout = MAXDWORD; Cptimeouts.ReadTotalTimeoutMultiplier = 10; Cptimeouts.ReadTotalTimeoutConstant = 10; Cptimeouts.WriteTotalTimeoutMultiplier = 10; Cptimeouts.WriteTotalTimeoutConstant = 10; if(!SetCommTimeouts(Cport, &Cptimeouts)) { printf("unable to set comport time-out settings\n"); CloseHandle(Cport); return(1); } return(0); } int PollComport(unsigned char *buf, int size) { int n; if(size>4096) size = 4096; /* added the void pointer cast, otherwise gcc will complain about */ /* "warning: dereferencing type-punned pointer will break strict aliasing rules" */ ReadFile(Cport, buf, size, (LPDWORD)((void *)&n), NULL); return(n); } int RdByte(unsigned char* m) { int n; ReadFile(Cport, m, 1, (LPDWORD)((void *)&n), NULL); return(n); } int SendByte(unsigned char byte) { int n; WriteFile(Cport, &byte, 1, (LPDWORD)((void *)&n), NULL); if(n<0) return(1); return(0); } int SendBuf(unsigned char *buf, int size) { int n; if(WriteFile(Cport, buf, size, (LPDWORD)((void *)&n), NULL)) { return(n); } return(-1); } int CloseComport(void) { CloseHandle(Cport); return(0); } int IsCTSEnabled(void) { int status; GetCommModemStatus(Cport, (LPDWORD)((void *)&status)); if(status&MS_CTS_ON) return(1); else return(0); } int cprintf(const char *text) /* sends a string to serial port */ { while(*text != 0) SendByte(*(text++)); return(0); } int opencport(int p) { OpenComport(p-1); return 3; } int closecport(int n) { CloseComport(); return n; } char* rdrs232(int n, char* msg) { char *str; char mm; int i, j; for (j=0; j<n; j++) { SendByte(msg[j]); } str = (char *) malloc(16000); i=0; mm=0; while (mm != 10) { RdByte(&mm); str[i]= mm; i= i+1; } if (i>0 && str[0]==0) { str[0]= ' ';} return(str); } Finally, here is the serial.h file: #ifndef rs232_INCLUDED #define rs232_INCLUDED #ifdef __cplusplus extern "C" { #endif #include <stdio.h> #include <string.h> #ifdef __linux__ #include <termios.h> #include <sys/ioctl.h> #include <unistd.h> #include <fcntl.h> #include <sys/types.h> #include <sys/stat.h> #include <limits.h> #else #include <windows.h> #endif int OpenComport(int); int PollComport(unsigned char *, int); int SendByte(unsigned char); int SendBuf(unsigned char *, int); int CloseComport(void); int cprintf(const char *); int IsCTSEnabled(void); char *topa(int n); int opencport(int p); int closecport(int n); char* rdrs232(int n, char* msg); #ifdef __cplusplus } /* extern "C" */ #endif #endif |