<table cellspacing="0" cellpadding="0" border="0" ><tr><td valign="top" style="font: inherit;">Hi, Jason.<br>Thank you for your explanations. They were very useful. In the light of what you said, I modified the programs as shown below (commented lines failed to work). Forcing the C function to return a number, wrapping the returned number in IO, and printing the number, I succeeded in bringing falures down to 1 case in 20 trials (average). By the way, I talked to doctors who work with capnograms, and they said that all Windows or Linux machines have problems in closing communication ports. However, it seems that capnographs are not turned off very often. I mean, when the doctor move the capnograph from one patient to another, s/he turns off the instrument. Therefore, this behavior does not create problems. However, what bothers me is that Clean always succeds in closeing the port.<br><br>{-# LANGUAGE ForeignFunctionInterface #-}<br>{-
file: SER/IAL.hs -}<br>module SER.IAL where<br> <br> import Control.Monad<br> import Foreign<br> import Foreign.C.Types<br> import Foreign.C <br><br> foreign import ccall "rs232.h opencport" opencport :: CInt -> IO ()<br> -- foreign import ccall "rs232.h closecport" closecport :: CInt -> CInt<br> -- foreign import stdcall unsafe "rs232.h closecport" closecport :: IO () <br> -- foreign import ccall unsafe "rs232.h closecport" c_closecport :: CInt<br> foreign import ccall unsafe "rs232.h closecport" c_closecport :: CInt -> CInt<br><br> closecport :: Int -> IO Int<br> closecport n= return (fromIntegral (c_closecport (fromIntegral n)))<br><br><br> foreign import ccall "rs232.h rdrs232" c_sendmsg :: CInt -> CString -> CString<br> sendMessage :: Int -> String -> IO String<br> sendMessage n msg = <br> withCString msg
$<br> \str -> peekCString (c_sendmsg (fromIntegral n) str)<br><br><br>{- file: sensors.hs -}<br>import Gui.Binding<br>import Gui.Types<br>import Gui.Constants<br>import SER.IAL<br>import Control.Monad<br>import Data.Char<br><br>main = do rv <- j_start<br> frame <- j_frame "Sensors"<br> avg <- j_button frame "Sampling"<br> j_setpos avg 20 150<br> j_setsize avg 90 30<br> rb <- j_button frame "Read"<br> j_setpos rb 125 150<br> j_setsize rb 90 30<br> tb <- j_button frame "Acquisition"<br> j_setpos tb 230 150<br> j_setsize tb 90 30<br> fld <- j_textfield frame 40 <br> j_setpos fld 20
100<br> menubar <- j_menubar frame<br> file <- j_menu menubar "File"<br> quitMI <- j_menuitem file "Quit"<br> j_show frame<br> opencport(3)<br> waitForFrameAction frame fld rb tb avg quitMI<br> r <- closecport 5<br> putStrLn (show r)<br> return j_quit<br> <br>waitForFrameAction frame f rb tb avg q = <br> do obj <- j_nextaction<br> again <- if obj == event q then return False
<br> else if obj == event rb then <br> (do msg <- sendMessage 1 "r"<br> putStrLn msg<br> return True)<br> else if obj == event tb then <br> (do <br> tx <- sendMessage 1 "t"<br> let tp= filter (> ' ') tx<br>
j_settext f tp<br> return True)<br> else if obj == event avg then<br> (do ok <- sendMessage 1 "m"<br> val <- j_gettext f 300<br> ns <- sendMessage 2 val<br> putStrLn ((filter (> ' ') ok) ++ ns)<br> return True)<br> else <br> (do <br> tx <- sendMessage 1 "t"<br>
let tp= filter (> ' ') tx<br> rx <- sendMessage 1 "x"<br> let rd= filter (> ' ') rx<br> let x = hex2dec rd<br> let tt= (fromIntegral x)*209.1/1023.0 - 67.23<br> j_settext f ((show tt)++" ==> "++tp)<br> return True)<br> if not again<br> then return True<br> else waitForFrameAction frame f rb tb avg q<br><br>hex2dec :: String -> Int<br>hex2dec h= sum (zipWith (*)
<br> (map (16^) [3,2,1,0])<br> [digitToInt c | c <- h]) <br> <br>convert d r s0= (fromIntegral (hex2dec d))*r/1024.0- s0 <br><br>{- 1a43 67.23; 082b - 209.1 -}<br><br><br>// file: serial.c<br>#include "serial.h"<br>#include <string.h><br>#include <stdio.h><br><br>/*<br>Possible baudrates on a normal pc:<br><br>50, 75, 110, 134, 150, 200, 300, 600, 1200, 1800,<br>2400, 4800, 9600, 19200, 38400, 57600, 115200<br>*/<br><br>#define BAUD "baud=9600 data=8 parity=N stop=1"<br><br><br>HANDLE Cport;<br><br><br>char comports[16][10]={"\\\\.\\COM1", "\\\\.\\COM2", "\\\\.\\COM3",
"\\\\.\\COM4",<br> "\\\\.\\COM5", "\\\\.\\COM6", "\\\\.\\COM7", "\\\\.\\COM8",<br> "\\\\.\\COM9", "\\\\.\\COM10", "\\\\.\\COM11", "\\\\.\\COM12",<br> "\\\\.\\COM13", "\\\\.\\COM14", "\\\\.\\COM15", "\\\\.\\COM16"};<br><br><br>int OpenComport(int comport_number)<br>{<br> if(comport_number>15)<br> {<br> printf("illegal comport number\n");<br> return(1);<br> }<br><br> Cport =
CreateFileA(comports[comport_number],<br> GENERIC_READ|GENERIC_WRITE,<br> 0, /* no share */<br> NULL, /* no security */<br>
OPEN_EXISTING,<br> 0, /* no threads */<br> NULL); /* no templates */<br><br> if(Cport==INVALID_HANDLE_VALUE)<br> {<br> printf("unable to open comport\n");<br> return(1);<br> }<br><br> DCB port_settings;<br> memset(&port_settings, 0, sizeof(port_settings)); /* clear the new struct */<br> port_settings.DCBlength = sizeof(port_settings);<br><br>
if(!BuildCommDCBA(BAUD, &port_settings))<br> {<br> printf("unable to set comport dcb settings\n");<br> CloseHandle(Cport);<br> return(1);<br> }<br><br> if(!SetCommState(Cport, &port_settings))<br> {<br> printf("unable to set comport cfg settings\n");<br> CloseHandle(Cport);<br> return(1);<br> }<br><br> COMMTIMEOUTS Cptimeouts;<br><br> Cptimeouts.ReadIntervalTimeout = MAXDWORD;<br> Cptimeouts.ReadTotalTimeoutMultiplier = 10;<br> Cptimeouts.ReadTotalTimeoutConstant = 10;<br> Cptimeouts.WriteTotalTimeoutMultiplier = 10;<br> Cptimeouts.WriteTotalTimeoutConstant = 10;<br><br> if(!SetCommTimeouts(Cport, &Cptimeouts))<br> {<br> printf("unable to set comport time-out
settings\n");<br> CloseHandle(Cport);<br> return(1);<br> }<br><br> return(0);<br>}<br><br><br>int PollComport(unsigned char *buf, int size)<br>{<br> int n;<br><br> if(size>4096) size = 4096;<br><br>/* added the void pointer cast, otherwise gcc will complain about */<br>/* "warning: dereferencing type-punned pointer will break strict aliasing rules" */<br><br> ReadFile(Cport, buf, size, (LPDWORD)((void *)&n), NULL);<br><br> return(n);<br>}<br><br><br>int RdByte(unsigned char* m)<br>{<br> int n;<br><br><br> ReadFile(Cport, m, 1, (LPDWORD)((void *)&n), NULL);<br><br> return(n);<br>}<br><br><br>int SendByte(unsigned char byte)<br>{<br> int n;<br><br> WriteFile(Cport, &byte, 1, (LPDWORD)((void *)&n), NULL);<br><br> if(n<0) return(1);<br><br> return(0);<br>}<br><br><br>int SendBuf(unsigned char *buf, int
size)<br>{<br> int n;<br><br> if(WriteFile(Cport, buf, size, (LPDWORD)((void *)&n), NULL))<br> {<br> return(n);<br> }<br><br> return(-1);<br>}<br><br><br>int CloseComport(void)<br>{<br> CloseHandle(Cport);<br> return(0);<br>}<br><br><br>int IsCTSEnabled(void)<br>{<br> int status;<br><br> GetCommModemStatus(Cport, (LPDWORD)((void *)&status));<br><br> if(status&MS_CTS_ON) return(1);<br> else return(0);<br>}<br><br><br><br>int cprintf(const char *text) /* sends a string to serial port */<br>{<br> while(*text != 0) SendByte(*(text++));<br> return(0);<br>}<br><br>int opencport(int p) {<br> OpenComport(p-1);<br> return 3;<br><br>}<br><br>int closecport(int n) {<br> CloseHandle(Cport);<br> printf("Bye\n");<br> return n; }<br><br><br>char* rdrs232(int n, char* msg)
{<br><br><br> char *str;<br><br> char mm;<br> int i, j;<br><br> for (j=0; j<n; j++) {<br> SendByte(msg[j]); }<br> str = (char *) malloc(16000);<br><br> i=0;<br> mm=0;<br> while (mm != 10) {<br> RdByte(&mm);<br> str[i]= mm;<br><br> i= i+1;<br><br>}<br> if (i>0 && str[0]==0) { str[0]= ' ';}<br><br> return(str);<br>}<br><br><br>//file: serial.h<br>#ifndef rs232_INCLUDED<br>#define rs232_INCLUDED<br><br>#ifdef __cplusplus<br>extern "C" {<br>#endif<br><br>#include <stdio.h><br>#include <string.h><br><br><br><br>#ifdef __linux__<br><br>#include <termios.h><br>#include <sys/ioctl.h><br>#include
<unistd.h><br>#include <fcntl.h><br>#include <sys/types.h><br>#include <sys/stat.h><br>#include <limits.h><br><br>#else<br><br>#include <windows.h><br><br>#endif<br><br>int OpenComport(int);<br>int PollComport(unsigned char *, int);<br>int SendByte(unsigned char);<br>int SendBuf(unsigned char *, int);<br>int CloseComport(void);<br>int cprintf(const char *);<br>int IsCTSEnabled(void);<br>char *topa(int n);<br>int opencport(int p);<br>int closecport(int n);<br>char* rdrs232(int n, char* msg);<br><br>#ifdef __cplusplus<br>} /* extern "C" */<br>#endif<br><br>#endif<br><br><br><br>--- On <b>Tue, 11/10/09, Jason Dusek <i><jason.dusek@gmail.com></i></b> wrote:<br><blockquote style="border-left: 2px solid rgb(16, 16, 255); margin-left: 5px; padding-left: 5px;"><br>From: Jason Dusek <jason.dusek@gmail.com><br>Subject: Re: [Haskell-cafe] Help Haskell driving Medical Instruments<br>To: "Philippos Apolinarius"
<phi500ac@yahoo.ca><br>Cc: "Haskell Cafe" <haskell-cafe@haskell.org><br>Received: Tuesday, November 10, 2009, 1:09 PM<br><br><div class="plainMail">2009/11/10 Philippos Apolinarius <<a ymailto="mailto:phi500ac@yahoo.ca" href="/mc/compose?to=phi500ac@yahoo.ca">phi500ac@yahoo.ca</a>><br>> I don't know how to mark the call unsafe. [...] I am running<br>> the main program on Windows.<br><br> Marking it unsafe is done by putting "unsafe" in the foreign<br> import declaration. Even if it turns out not to fix the<br> problem, it reduces the overhead of foreign calls (and is safe<br> as long as they aren't going to call back into Haskell).<br><br> Because your on Windows, you want to use "stdcall", as<br> mentioned by Daniel Fischer. Thus the full declaration is:<br><br> foreign import stdcall unsafe "rs232.h closecport" closecport :: IO ()<br><br> Let us know if this
helps.<br><br>> Here is the compilation script:<br>><br>> ghc -fglasgow-exts serial.c %1.hs -L./ -ljapi --make<br>> erase *.hi<br>> erase *.o<br>> strip %1.exe<br><br> I encourage you to look into Cabal soon :)<br><br>--<br>Jason Dusek<br></div></blockquote></td></tr></table><br>
<hr size=1>
Looking for the perfect gift?<a href="http://www.flickr.com/gift/"><b> Give the gift of Flickr!</b></a>