Hi, Jason.
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.
{-# LANGUAGE ForeignFunctionInterface #-}
{- file: SER/IAL.hs -}
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 stdcall unsafe rs232.h closecport closecport :: IO ()
-- foreign import ccall unsafe rs232.h closecport c_closecport :: CInt
foreign import ccall unsafe rs232.h closecport c_closecport :: CInt - CInt
closecport :: Int - IO Int
closecport n= return (fromIntegral (c_closecport (fromIntegral n)))
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)
{- file: sensors.hs -}
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
avg - j_button frame Sampling
j_setpos avg 20 150
j_setsize avg 90 30
rb - j_button frame Read
j_setpos rb 125 150
j_setsize rb 90 30
tb - j_button frame Acquisition
j_setpos tb 230 150
j_setsize tb 90 30
fld - j_textfield frame 40
j_setpos fld 20 100
menubar - j_menubar frame
file - j_menu menubar File
quitMI - j_menuitem file Quit
j_show frame
opencport(3)
waitForFrameAction frame fld rb tb avg quitMI
r - closecport 5
putStrLn (show r)
return j_quit
waitForFrameAction frame f rb tb avg q =
do obj - j_nextaction
again - if obj == event q then return False
else if obj == event rb then
(do msg - sendMessage 1 r
putStrLn msg
return True)
else if obj == event tb then
(do
tx - sendMessage 1 t
let tp= filter ( ' ') tx
j_settext f tp
return True)
else if obj == event avg then
(do ok - sendMessage 1 m
val - j_gettext f 300
ns - sendMessage 2 val
putStrLn ((filter ( ' ') ok) ++ ns)
return True)
else
(do
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.1/1023.0 - 67.23
j_settext f ((show tt)++ == ++tp)
return True)
if not again
then return True
else waitForFrameAction frame f rb tb avg q
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
{- 1a43 67.23; 082b - 209.1 -}
// file: serial.c
#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_number15)
{
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 */
