X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskDevice.icl;h=661c701f87a106a2b85f7a6f6769281203f158c5;hb=497a31ebe6922b1b9f889450f5830f1ca1c4bb59;hp=58dd5eda515114cdb62a4610a005b5c3534a6f31;hpb=a2b8b2a0de173f92092bf6cbbed23551e674ca3c;p=mTask.git diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 58dd5ed..661c701 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -8,6 +8,7 @@ import iTasksTTY import TTY import qualified Data.Map as DM import Utils.SDS +import Utils.Devices import GenBimap import Devices.mTaskSerial @@ -17,16 +18,13 @@ import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks. from Data.Func import $ -derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend +derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings instance == MTaskDevice where (==) a b = a.deviceChannels == b.deviceChannels -channels :: MTaskDevice -> Shared Channels -channels d = memoryShare d.deviceChannels ([], [], False) - startupDevices :: Task [MTaskDevice] startupDevices = upd (map reset) deviceStore where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing} @@ -99,28 +97,30 @@ deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d) sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () sendToDevice wta mTask (device, timeout) = get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) - >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords + >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare >>| makeShares sdss - >>| sendMessage device msgs + >>| sendMessages msgs device >>| makeTask wta -1 >>= withDevices device o addTask @! () where sharename i = device.deviceChannels +++ "-" +++ toString i toSDSRecords st = [{MTaskShare | - initValue=toInt d1*265 + toInt d2, withTask=wta, - identifier=i, - realShare="mTaskSDS-" +++ toString i} - \\(i,[d1,d2])<-st.sdss] - makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ()) + identifier=sdsi, + //We skip the only/local shares + realShare="mTaskSDS-" +++ toString sdsi} + \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub] + + makeShares :: ([MTaskShare] -> Task ()) + makeShares = undef //foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ()) addTask :: MTaskTask MTaskDevice -> MTaskDevice addTask task device = {device & deviceTasks=[task:device.deviceTasks]} -sendMessage :: MTaskDevice [MTaskMSGSend] -> Task () -sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! () +sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels) +sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! () @@ -135,7 +135,7 @@ deviceTaskAcked dev i [{t & ident=i}:ts] [t:ackFirst ts] deviceTaskDelete :: MTaskDevice MTaskTask -> Task () -deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident] +deviceTaskDelete dev task = sendMessages [MTTaskDel task.ident] dev @! () deviceTaskDeleteAcked :: MTaskDevice Int -> Task () deviceTaskDeleteAcked d i = withDevices d $ deleteTask