From 7ab8606c3d22a2bc2743eae7a398407c84d502f2 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 13 Mar 2017 19:39:19 +0100 Subject: [PATCH] shares are updated now and visible --- Shares/mTaskShare.dcl | 11 +++----- Shares/mTaskShare.icl | 59 ++++++++++++++++++++++++++----------------- client/interpret.c | 17 +++++++++++-- client/sds.c | 2 ++ client/sds.h | 3 ++- mTaskInterpret.icl | 21 +++++++-------- miTask.icl | 8 +++--- 7 files changed, 73 insertions(+), 48 deletions(-) diff --git a/Shares/mTaskShare.dcl b/Shares/mTaskShare.dcl index f97649e..aab56db 100644 --- a/Shares/mTaskShare.dcl +++ b/Shares/mTaskShare.dcl @@ -4,14 +4,7 @@ import iTasks import iTasks._Framework.Serialization import mTask -derive class iTask MTaskShareType - -derive gEditor MTaskShare -derive gText MTaskShare -derive JSONEncode MTaskShare -derive JSONDecode MTaskShare -derive gDefault MTaskShare -derive gEq MTaskShare +derive class iTask MTaskShareType, MTaskShare :: MTaskShareType = MTaskWithShare String | MTaskLens String :: MTaskShare = @@ -25,3 +18,5 @@ manageShares :: [MTaskShare] -> Task () ///makeShare :: String Int Dynamic -> Task MTaskShare makeShare :: String Int BCValue -> Task MTaskShare + +updateShare :: Int String -> Task () diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index cddc903..76f676a 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -5,52 +5,65 @@ import Utils.SDS import Utils.Devices import iTasks import mTask +import Data.List from Data.Func import $ -derive class iTask MTaskShareType - -derive gEditor MTaskShare -derive gText MTaskShare -derive JSONEncode MTaskShare -derive JSONDecode MTaskShare -derive gDefault MTaskShare -gEq{|MTaskShare|} m1 m2 = m1.identifier == m2.identifier +derive class iTask MTaskShareType, MTaskShare manageShares :: [MTaskShare] -> Task () -manageShares shares = - forever (enterChoice "Choose share to update" [ChooseFromGrid id] shares - >&^ \st->whileUnchanged st $ \msh->case msh of - Nothing = viewShares shares - Just sh = forever ( - viewSharedInformation "View value" [] (getSDSShare sh) >>| treturn sh +manageShares shares = forever $ + /*viewSharesGrid shares -|| */viewShares shares @! () + +// >&^ \st->whileUnchanged st $ \msh->case msh of +// Nothing = viewShares shares +// Just sh = forever ( +// viewSharedInformation "View value" [] (getSDSShare sh) >>| treturn sh // >>* [OnAction (Action "Update") (withValue (Just o updateInformation "New value" []))] // >>= updateShare sh - ) - - ) @! () +// ) +// +// ) @! () + + +viewShares :: [MTaskShare] -> Task BCValue +viewShares shares = anyTask (map viewShare shares) + +viewAndDelete :: [MTaskShare] -> Task () +viewAndDelete shares + = enterChoice "Choose share to update" [ChooseFromGrid id] shares @! () //updateShare :: MTaskShare a -> Task MTaskShare | toByteCode, iTask a //updateShare sh=:{withTask,identifier} a = getDeviceByName withTask // >>= sendMessages [MTUpd identifier $ toString $ toByteCode a] // >>| treturn sh -viewShares :: [MTaskShare] -> Task MTaskShare -viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal - >>| return (hd sh) +//viewSharesGrid :: [MTaskShare] -> Task [MTaskShare] +//viewSharesGrid sh = allTasks [whileUnchanged (get $ getSDSShare m) (\s->treturn (m, s))\\m<-sh] +// @ map (\(s,v)->{MTaskShare|s&value=v}) +// >>= enterChoice "Choose share" [ChooseFromGrid id] +// >>= \s->treturn [s] +//{anyTask (map viewShare sh) <<@ ArrangeHorizontal +// >>| return (hd sh) viewShare :: MTaskShare -> Task BCValue viewShare m = viewSharedInformation "" [] (getSDSShare m) <<@ Title ("SDS: " +++ toString m.identifier) getSDSShare :: MTaskShare -> Shared BCValue -getSDSShare s=:{realShare=(MTaskWithShare id),value} - = memoryShare id value//s.MTaskShare.value +getSDSShare s=:{realShare=(MTaskWithShare id),value} = memoryShare id value makeShare :: String Int BCValue -> Task MTaskShare -makeShare withTask identifier value=:(BCValue v) = treturn +makeShare withTask identifier value = treturn {MTaskShare |withTask=withTask ,identifier=identifier ,value=value ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier } >>= \sh->set value (getSDSShare sh) >>| treturn sh + +updateShare :: Int String -> Task () +updateShare ident val = get sdsStore + >>= \sh->(case find (\s->s.identifier==ident) sh of + Nothing = abort "Help, no share found with this ident" + Just mts = set (fromByteCode val) (getSDSShare mts)) + >>| traceValue "Updated" @! () diff --git a/client/interpret.c b/client/interpret.c index ac0c0bc..51e2951 100644 --- a/client/interpret.c +++ b/client/interpret.c @@ -37,8 +37,21 @@ void run_task(struct task *t) pc++; break; case BCPUSH: trace("push %d", program[pc]*265+program[pc+1]); - stack[sp++] = f16(pc); - pc+=2; + switch(program[pc++]){ + //Long + case 'l': + //Int + case 'i': + stack[sp++] = f16(pc); + pc+=2; + break; + case 'b': //Bool + case 'c': //Character + case 'B': //Button + case 'L': //UserLED + stack[sp++] = program[pc++]; + break; + } break; case BCPOP: trace("pop"); sp--; diff --git a/client/sds.c b/client/sds.c index c2fdbde..66bcb16 100644 --- a/client/sds.c +++ b/client/sds.c @@ -32,6 +32,7 @@ void sds_register(void) //Read identifier sdss[cs].id = read16(); //Read value + sdss[cs].type = read_byte(); sdss[cs].value = read16(); debug("Received sds %d: %d", sdss[cs].id, sdss[cs].value); @@ -83,6 +84,7 @@ void sds_publish(int id) debug("Publish %d=%d", sdss[cs].id, sdss[cs].value); write_byte('p'); write16(sdss[cs].id); + write_byte(sdss[cs].type); write16(sdss[cs].value); write_byte('\n'); return; diff --git a/client/sds.h b/client/sds.h index ab67bc8..de83421 100644 --- a/client/sds.h +++ b/client/sds.h @@ -7,8 +7,9 @@ struct sds { int id; - int value; bool used; + char type; + int value; }; void sds_init(void); diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 538a5a9..e603f82 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -60,7 +60,7 @@ decode x 'm' = MTMessage x 's' = MTSDSAck (from16bit (x % (1,3))) 'a' = MTSDSDelAck (from16bit (x % (1,3))) - 'p' = MTPub (from16bit (x % (1,3))) (x % (3,5)) + 'p' = MTPub (from16bit (x % (1,3))) (x % (3,size x)) '\0' = MTEmpty '\n' = MTEmpty _ = MTMessage x//abort ("Didn't understand message: " +++ join " " [toString (toInt c)\\c<-: x] +++ "\n") @@ -120,22 +120,22 @@ parseBCValue c s = case c of castfbc :: a -> (String -> a) | mTaskType a castfbc _ = fromByteCode -instance toByteCode Bool where toByteCode b = {#'b','\0',if b '\x01' '\0'} +instance toByteCode Bool where toByteCode b = {#'b',if b '\x01' '\0'} instance toByteCode Int where toByteCode n = {'i',toChar $ n/256,toChar $ n rem 256} instance toByteCode Long where toByteCode (L n) = {'l',toChar $ n/256,toChar $ n rem 256} -instance toByteCode Char where toByteCode c = {'c','\0',c} +instance toByteCode Char where toByteCode c = {'c',c} instance toByteCode String where toByteCode s = abort $ "Undef on toBytecode String" +++ s -instance toByteCode Button where toByteCode s = {'B','\0',toChar $ consIndex{|*|} s} -instance toByteCode UserLED where toByteCode s = {'L','\0',toChar $ consIndex{|*|} s} +instance toByteCode Button where toByteCode s = {'B',toChar $ consIndex{|*|} s} +instance toByteCode UserLED where toByteCode s = {'L',toChar $ consIndex{|*|} s} instance toByteCode BCValue where toByteCode (BCValue v) = toByteCode v -instance fromByteCode Bool where fromByteCode s = fromByteCode s == 1 +instance fromByteCode Bool where fromByteCode s = s.[1] == '\x01' instance fromByteCode Int where fromByteCode s = (toInt s.[1])*256 + toInt s.[2] instance fromByteCode Long where fromByteCode s = L $ fromByteCode s -instance fromByteCode Char where fromByteCode s = fromInt $ fromByteCode s +instance fromByteCode Char where fromByteCode s = s.[1] instance fromByteCode String where fromByteCode s = abort $ "Undef on fromBytecode String" +++ s -instance fromByteCode Button where fromByteCode s = conses{|*|} !! fromByteCode s -instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! fromByteCode s +instance fromByteCode Button where fromByteCode s = conses{|*|} !! toInt s.[1] +instance fromByteCode UserLED where fromByteCode s = conses{|*|} !! toInt s.[1] instance fromByteCode BCValue where fromByteCode s = parseBCValue s.[0] s instance toByteCode MTaskInterval where @@ -329,7 +329,8 @@ toSDSUpdate :: Int Int -> [MTaskMSGSend] toSDSUpdate i v = [MTUpd i (to16bit v)] //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero -Start = fst $ toReadableByteCode (unMain $ blink LED1) zero +Start = fst $ toReadableByteCode (unMain $ countAndLed) zero +//Start = fst $ toReadableByteCode (unMain $ blink LED1) zero //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero // in (bcs, st.sdss) where diff --git a/miTask.icl b/miTask.icl index 5a65116..2b9d4e0 100644 --- a/miTask.icl +++ b/miTask.icl @@ -59,14 +59,14 @@ mTaskManager = startupDevices >>| anyTask where proc :: [MTaskMSGRecv] -> Task () proc [] = treturn () - proc [m:ms] = (case m of + proc [MTEmpty:ms] = proc ms + proc [m:ms] = traceValue (toString m) >>| (case m of // MTSDSAck i = traceValue (toString m) @! () // MTSDSDelAck i = traceValue (toString m) @! () -// MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! () + MTPub i val = updateShare i val MTTaskAck i = deviceTaskAcked device i MTTaskDelAck i = deviceTaskDeleteAcked device i @! () - MTEmpty = treturn () - _ = traceValue (toString m) @! () + _ = treturn () ) >>| proc ms mapPar :: (a -> Task a) [a] -> Task () -- 2.20.1