X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Devices%2FmTaskDevice.icl;h=6a8c3699d3384b9a450a9b4da123260a61f049cf;hb=547eb2278f48ab8b94e70ef4a1fc2bf5093bdfb2;hp=9a936349b09e7f18b2cc66fd2f9134e0d9bea1a2;hpb=1e4c58b59800c21747181bb0c437c6cc47c47dec;p=mTask.git diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 9a93634..6a8c369 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -1,5 +1,6 @@ implementation module Devices.mTaskDevice +from StdFunc import flip import Generics.gCons import mTaskInterpret import iTasks @@ -15,10 +16,13 @@ import iTasks._Framework.Store 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) @@ -60,7 +64,7 @@ manageDevices processFun ds = anyTask [ <<@ ArrangeWithTabs @! () viewDevice :: MTaskDevice -> Task () -viewDevice d = anyTask +viewDevice d = forever $ anyTask [viewInformation "Device settings" [] d @! () ,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! () ,forever $ @@ -68,39 +72,45 @@ viewDevice d = anyTask >>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)] @! () ] <<@ ArrangeHorizontal + >>* [OnAction (Action "Delete Device") (always $ deleteDevice d)] where dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) -sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, Int) -> Task () +deleteDevice :: MTaskDevice -> Task () +deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d) + >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask + >>| upd (filter ((==)d)) deviceStore + @! () + +sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () sendToDevice wta mTask (device, timeout) = - get bcStateStore - >>= \st->treturn (toMessages timeout (toRealByteCode (unMain mTask) st)) - >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords - >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare + get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask) + >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords + >>= \sdss->set sdss sdsStore//MTaskShareaddToSDSShare >>| makeShares sdss >>| sendMessage device msgs >>| makeTask wta -1 - >>= \task->withDevices device (addTask timeout task) + >>= withDevices device o addTask @! () where sharename i = device.deviceChannels +++ "-" +++ toString i toSDSRecords st = [{MTaskShare | - initValue=toInt d1*265 + toInt d2, + initValue=toInt (sdsval!!0)*265 + toInt (sdsval!!1), withTask=wta, - identifier=i, - realShare="mTaskSDS-" +++ toString i} - \\(i,[d1,d2])<-st.sdss] + identifier=sdsi, + //We skip the only/local shares + realShare="mTaskSDS-" +++ toString sdsi} + \\{sdsi,sdspub,sdsval}<-st.sdss | sdspub] makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ()) - addTask :: Int MTaskTask MTaskDevice -> MTaskDevice - addTask timeout task device = {device & deviceTasks=[task:device.deviceTasks]} + 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) @! () withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task () -withDevices a trans = upd (map withDevice) deviceStore @! () - where withDevice b = if (a.deviceChannels == b.deviceChannels) (trans b) b +withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! () deviceTaskAcked :: MTaskDevice Int -> Task () deviceTaskAcked dev i