X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=miTask.icl;h=5df0450c3c6fc3f02903f7d19e04d8b44060af11;hb=e09afe083f9077d63a8bd6c27ed8fa5da60430a8;hp=46c2b990aee0b9f4763feefb3e305bd62ce673d0;hpb=385cba3194e613293fbb1b7ef092a78eb6337528;p=mTask.git diff --git a/miTask.icl b/miTask.icl index 46c2b99..5df0450 100644 --- a/miTask.icl +++ b/miTask.icl @@ -51,21 +51,19 @@ derive class iTask SerTCP :: SerTCP = Serial | TCP mTaskTask :: (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task () -mTaskTask ch = -// (enterInformation "Choose" [] >>= \st->case st of -// Serial = deviceSelectorSerial >>= \(s,set)->syncSerialChannel s set decode encode ch -// TCP = deviceSelectorNetwork >>= \(p,h)->syncNetworkChannel h p "\n" decode encode ch -// ) ||- - deviceSelectorNetwork >>= \(p,h)->syncNetworkChannel h p "\n" decode encode ch ||- -// deviceSelectorSerial >>= \(s,set)->syncSerialChannel s set decode encode ch ||- - (sendMsg msgs ch >>= \_-> ( - ( +mTaskTask ch = + (enterInformation "Choose" [] >>= \st->case st of + Serial = deviceSelectorSerial >>= \(s,set)->syncSerialChannel s set decode encode ch + TCP = deviceSelectorNetwork >>= \(p,h)->syncNetworkChannel h p "\n" decode encode ch + ) ||- + ( + sendMsg msgs ch >>= \_->( consumeNetworkStream (processSDSs sdsShares messageShare) ch ||- viewSharedInformation "channels" [ViewWith lens] ch ||- viewSharedInformation "messages" [] messageShare ||- viewSh sdsShares ch - ) >>* [OnAction ActionFinish (always shutDown)] - )) + ) + ) >>* [OnAction ActionFinish (always shutDown)] where messageShare :: Shared [String] messageShare = sharedStore "mTaskMessagesRecv" [] @@ -106,7 +104,8 @@ mTaskTask ch = ) ) ||- viewSh xs ch - (msgs, sdsShares) = makeBytecode 500 bc + sdsShares = makeShares st + (msgs, st) = toMessages 1000 (toRealByteCode (unMain bc)) bc :: Main (ByteCode () Stmt) bc = sds \x=1 In sds \pinnetje=1 In {main = @@ -132,14 +131,19 @@ mTaskTask ch = ) )} -makeBytecode :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)]) -makeBytecode timeout bc -# (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) -# shares = map (\(i,d)->(i, sharedStore (s i) (dd d))) st.sdss -= (msgs, shares) - where - s i = "mTaskSDS-" +++ toString i - dd [x,y] = (toInt x)*265+(toInt y) +makeShares :: BCState -> [(Int, Shared Int)] +makeShares {sdss=[]} = [] +makeShares s=:{sdss=[(i,d):xs]} = + [(i, sharedStore ("mTaskSDS-" +++ toString i) 1):makeShares {s & sdss=xs}] + +//makeBytecode :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)]) +//makeBytecode timeout bc +//# (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) +//# shares = map (\(i,d)->(i, sharedStore (s i) (dd d))) st.sdss +//= (msgs, shares) +// where +// s i = "mTaskSDS-" +++ toString i +// dd [x,y] = (toInt x)*265+(toInt y) sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task () @@ -201,8 +205,10 @@ syncNetworkChannel server port msgSeparator decodeFun encodeFun channel onConnect _ (received,receiveStopped,send,sendStopped) = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False) whileConnected Nothing acc (received,receiveStopped,send,sendStopped) + | not (trace_tn "whilec nothing") = undef = (Ok acc, Nothing, [], False) whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped) + | not (trace_tn "whilec just") = undef # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData])) # write = if (not (isEmpty msgs && isEmpty send)) (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped))