/
Comedi.hs
executable file
·208 lines (156 loc) · 7.54 KB
/
Comedi.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
{-# INCLUDE "comedilib.h" #-}
{-# INCLUDE "comedi.h" #-}
{-# INCLUDE "comedi_hs_helper.c" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Comedi where
import Foreign.C
import Foreign.Ptr
import Foreign.Marshal.Array
import Data.List
import GHC.Conc (threadDelay)
{- foreign import ccall safe "comedilib.h comedi_open"
comedi_open :: CString -> IO (Ptr ())
foreign import ccall safe "comedilib.h comedi_close"
comedi_close :: Ptr () -> IO CInt
-}
foreign import ccall safe "comedilib.h comedi_get_board_name"
comedi_get_board_name :: Ptr () -> IO CString
foreign import ccall safe "comedilib.h comedi_find_subdevice_by_type"
comedi_find_subdevice_by_type :: Ptr () -> CInt -> CInt -> IO CInt
foreign import ccall safe "comedilib.h comedi_find_range"
comedi_find_range :: Ptr () -> CInt -> CInt -> CInt -> CDouble -> CDouble ->IO CInt
foreign import ccall safe "comedilib.h comedi_dio_write"
comedi_dio_write :: Ptr () -> CInt -> CInt -> CInt->IO CInt
foreign import ccall safe "comedilib.h comedi_dio_config"
comedi_dio_config :: Ptr () -> CInt -> CInt -> CInt->IO CInt
foreign import ccall safe "comedi_hs_helper.h dio_set_bits"
dio_set_bits :: CInt -> CInt -> CInt-> IO ()
foreign import ccall safe "comedi_hs_helper.h new_trial"
new_trial :: CInt -> CDouble -> IO CInt
foreign import ccall safe "comedi_hs_helper.h get_comedi_ptr"
get_comedi_ptr :: IO (Ptr ())
foreign import ccall safe "comedi_hs_helper.h new_trial_out"
new_trial_out :: CInt -> CDouble -> IO CInt
foreign import ccall safe "comedi_hs_helper.h setup_write_wave"
setup_write_wave :: CInt -> CInt -> CInt -> CInt-> Ptr (CDouble) -> IO ()
foreign import ccall safe "comedi_hs_helper.h setup_read_wave"
setup_read_wave :: CInt -> CInt -> CInt -> CInt-> IO CInt
foreign import ccall safe "comedi_hs_helper.h start_cont_acq"
start_cont_acq :: IO ()
foreign import ccall safe "comedi_hs_helper.h prepare_cont_acq"
prepare_cont_acq :: IO ()
foreign import ccall safe "comedi_hs_helper.h internal_trigger"
internal_trigger :: IO ()
foreign import ccall safe "comedi_hs_helper.h start_cont_output"
start_cont_output :: IO ()
foreign import ccall safe "comedi_hs_helper.h get_wave_ptr"
get_wave_ptr :: CInt -> IO (Ptr (CDouble))
foreign import ccall safe "comedi_hs_helper.h free_trial_results"
free_trial_results :: IO ()
foreign import ccall safe "comedi_hs_helper.h subdev_type"
subdev_type :: CInt -> CInt
foreign import ccall safe "comedi_hs_helper.h getGlobalFreq"
get_global_freq :: IO CDouble
foreign import ccall safe "comedi_hs_helper.h my_find_subdevice_by_type"
my_find_subdevice_by_type :: CInt -> CInt -> IO CInt
{-open :: String -> IO (Ptr ())
open fn = withCString fn comedi_open
close :: (Ptr ()) -> IO ()
close dvptr = do comedi_close dvptr
return ()
-}
{-readVolts :: Chan -> IO Double
readVolts (AIChan devptr subd chan rng _ _)
= return . realToFrac =<< read_volts devptr (fI subd) (fI chan) (fI rng)
-}
setupReadWave (AIChan subd chan rng _ ) npnts
= setup_read_wave (fI subd) (fI chan) (fI rng) (fI npnts)
setupWriteWave (AOChan subd chan rng _ ) pts
= do withArray pts $ setup_write_wave (fI subd) (fI chan) (fI rng) (fI $ length pts)
setupWriteWave och _ = putStrLn "!!!! other write channel" >> print och
getGlobalFreq :: IO Double
getGlobalFreq = return . realToFrac =<<get_global_freq
--int comedi_find_range(comedi_t * device, unsigned int subdevice, unsigned int channel, unsigned int unit, double min, double max);
findRange :: Int -> Int -> (Rational,Rational) ->IO Int
findRange sd ch minmax = do dvptr <- get_comedi_ptr
r <- comedi_find_range dvptr (fI sd) (fI ch) 0 (rTF $ uncurry min minmax) (rTF $ uncurry max minmax) -- 0 = Volts, comedi.h
return $ fromIntegral r
findSubdeviceByType :: SubDevType -> IO Int
findSubdeviceByType sdtp = do sdNum <- my_find_subdevice_by_type (subdev_type (fromIntegral $ subDevTypeToInt sdtp)) 0
putStrLn$ "findSubdeviceByType "++(show sdtp ++ "=>" ++show sdNum)
return $ fromIntegral sdNum
fI = fromIntegral
rTF = realToFrac
data SubDevType = AnalogInput | AnalogOutput | DigitalInput | DigitalOutput | DigitalIO deriving Show
subDevTypeToInt AnalogInput = 10
subDevTypeToInt AnalogOutput = 11
subDevTypeToInt DigitalOutput = 12
subDevTypeToInt DigitalInput = 13
subDevTypeToInt DigitalIO = 14
isAnalog AnalogInput = True
isAnalog AnalogOutput = True
isAnalog _ = False
--------------
{-data ChanDesc = AnalogChannel String SubDevType (Rational,Rational) Int Int
| DigitalChannel String SubDevType Int -}
data Chan = AIChan { subDev ::Int, chanNum :: Int, range:: Int, acqRateHz :: Int }
| AOChan { subDev ::Int, chanNum :: Int, range:: Int, acqRateHz :: Int }
| DIOChan { subDev ::Int, chanNum :: Int, direction :: Int}
| AnalogChannel { subDevType :: SubDevType, rangePair :: (Rational,Rational), acqRateHz :: Int, chanNum :: Int }
| DigitalChannel { subDevType :: SubDevType , chanNum :: Int }
deriving Show
{-
instance Show Chan where
show (AIChan devptr subd chan rng rate devnm)
= "RealChan "++show devnm++" sub "++ show subd++" chan "++ show chan++" rng "++ show rng
show (ChanDesc devnm subd chan rng rate)
= "ChanDesc "++devnm++" sub "++ show subd++" chan "++ show chan++" rng "++ show rng
-}
--actualizeWithPtr :: Ptr () -> Chan -> Chan
--actualizeWithPtr p nc@(DigitalChannel devname subDevType chan)
actualizeChannels :: [Chan] -> [Chan] -> IO [Chan]
actualizeChannels [] existing = return existing
actualizeChannels (c:cs) existing = do nc <- actualizeChannel existing c
actualizeChannels cs (nc:existing)
actualizeChannel existing nc@(AnalogChannel subDevType rngSpan chanNum rtHz)
= do --devPtr <- getDevPtr existing nc
sdt <- findSubdeviceByType subDevType
r <- findRange sdt chanNum rngSpan
--prints "new chan " $ Chan devPtr sdt chanNum rng rtHz devnm
case subDevType of
AnalogInput -> return $ AIChan sdt chanNum r rtHz
AnalogOutput -> return $ AOChan sdt chanNum r rtHz
actualizeChannel existing nc@(DigitalChannel subDevType chan)
= do devPtr <- get_comedi_ptr
sdt <- findSubdeviceByType DigitalIO
let dir = case subDevType of
DigitalOutput -> 1
DigitalInput -> 0
comedi_dio_config devPtr (fI sdt) (fI chan) (fI dir)
--putStrLn "done actualizig dig"
return $ DIOChan sdt chan dir
actualizeChannel existing c = return c
setDigPin :: Chan -> Int -> IO ()
setDigPin (DIOChan sdt chan dir) val
= do devPtr <- get_comedi_ptr
comedi_dio_write devPtr (fI sdt) (fI chan) (fI val)
return ()
beep :: Chan -> IO ()
beep ch = do setDigPin ch 1
threadDelay 1000
setDigPin ch 0
prints s1 s2 = putStrLn (s1++": "++show s2)
multiDigPulse :: [Chan] -> IO ()
multiDigPulse chs = do setMultipleDigOuts chs 1
threadDelay 1000
setMultipleDigOuts chs 0
setMultipleDigOuts :: [Chan] -> Int -> IO ()
setMultipleDigOuts chs@((DIOChan subD _ _ ):_) val
= dio_set_bits (fI subD) (fI writeMask) (fI bitField)
where powersOf2 = iterate (*2) 1
writeMask = sum $ map (powersOf2 !!) pinlist
bitField = writeMask * val
pinlist = map chanNum chs
setMultipleDigOuts chs@((DigitalChannel _ _ ):_) val
= do achs <- actualizeChannels chs []
setMultipleDigOuts achs val