X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=miTask.icl;h=5df0450c3c6fc3f02903f7d19e04d8b44060af11;hb=8449be73c124cdccd37500c0d67d9404b94fc9c8;hp=1274601adda4c686925055e523dece2accbbeaf8;hpb=b55c1c423b6f00357b2ae2bbdd2abcf4456fd0cd;p=mTask.git diff --git a/miTask.icl b/miTask.icl index 1274601..5df0450 100644 --- a/miTask.icl +++ b/miTask.icl @@ -51,20 +51,19 @@ derive class iTask SerTCP :: SerTCP = Serial | TCP mTaskTask :: (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task () -mTaskTask 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 ||- + ) ||- ( - ( + 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" [] @@ -105,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 = @@ -131,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, sdsFocus (s i) (memoryStore (s i) (Just (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 () @@ -200,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))