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 =
///makeShare :: String Int Dynamic -> Task MTaskShare
makeShare :: String Int BCValue -> Task MTaskShare
+
+updateShare :: Int String -> Task ()
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" @! ()
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--;
//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);
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;
struct sds {
int id;
- int value;
bool used;
+ char type;
+ int value;
};
void sds_init(void);
'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")
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
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
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 ()