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
__________________________________________________________________
Make your browsing faster, safer, and easier with the new Internet Explorer® 8.
Optimized for Yahoo! Get it Now for Free! at
http://downloads.yahoo.com/ca/internetexplorer/_______________________________________________
Haskell-Cafe mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/haskell-cafe
