[Haskell-cafe] Help Haskell driving Medical Instruments

Tue Nov 10 00:04:05 EST 2009

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/
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20091109/202f3ff0/attachment.html