X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskDevice.icl;h=0304e7ee20993e4396aa0c03051c0d288604d19b;hb=7ab8606c3d22a2bc2743eae7a398407c84d502f2;hp=58dd5eda515114cdb62a4610a005b5c3534a6f31;hpb=a2b8b2a0de173f92092bf6cbbed23551e674ca3c;p=mTask.git diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 58dd5ed..0304e7e 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} @@ -76,7 +74,7 @@ manageDevices processFun ds = anyTask [ <<@ ArrangeWithTabs @! () viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task () -viewDevice pf d = forever $ anyTask +viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask [viewInformation "Device settings" [] d @! () ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! () ,forever $ @@ -98,29 +96,31 @@ 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 - >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare - >>| makeShares sdss - >>| sendMessage device msgs + traceValue "starting to send" + >>| get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) + >>= \(msgs, st1)->traceValue "messages generated" + >>| set st1 bcStateStore + >>| traceValue "bcstate store updated" + >>| toSDSRecords st1 + >>= \sdss->traceValue "Shares created" + >>| set sdss sdsStore//MTaskShareaddToSDSShare + >>| traceValue "Shares store updated" + >>| sendMessages msgs device + >>| traceValue "Messages sent" >>| makeTask wta -1 - >>= withDevices device o addTask + >>= \t->traceValue "Task made" + >>| withDevices device (addTask t) + >>| traceValue "Tasks share updated" @! () 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 ()) + toSDSRecords st = sequence "" [makeShare wta sdsi sdsval\\{sdsi,sdspub,sdsval}<-st.sdss]// | sdspub] 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