repositories
/
mTask.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
f0f7587
)
shares are updated now and visible
author
Mart Lubbers
<mart@martlubbers.net>
Mon, 13 Mar 2017 18:39:19 +0000
(19:39 +0100)
committer
Mart Lubbers
<mart@martlubbers.net>
Mon, 13 Mar 2017 18:39:19 +0000
(19:39 +0100)
Shares/mTaskShare.dcl
patch
|
blob
|
history
Shares/mTaskShare.icl
patch
|
blob
|
history
client/interpret.c
patch
|
blob
|
history
client/sds.c
patch
|
blob
|
history
client/sds.h
patch
|
blob
|
history
mTaskInterpret.icl
patch
|
blob
|
history
miTask.icl
patch
|
blob
|
history
diff --git
a/Shares/mTaskShare.dcl
b/Shares/mTaskShare.dcl
index
f97649e
..
aab56db
100644
(file)
--- a/
Shares/mTaskShare.dcl
+++ b/
Shares/mTaskShare.dcl
@@
-4,14
+4,7
@@
import iTasks
import iTasks._Framework.Serialization
import mTask
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 =
:: 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
///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
(file)
--- a/
Shares/mTaskShare.icl
+++ b/
Shares/mTaskShare.icl
@@
-5,52
+5,65
@@
import Utils.SDS
import Utils.Devices
import iTasks
import mTask
import Utils.Devices
import iTasks
import mTask
+import Data.List
from Data.Func import $
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 :: [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
// >>* [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
//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
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 :: 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
{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
(file)
--- 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]);
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--;
break;
case BCPOP: trace("pop");
sp--;
diff --git
a/client/sds.c
b/client/sds.c
index
c2fdbde
..
66bcb16
100644
(file)
--- a/
client/sds.c
+++ b/
client/sds.c
@@
-32,6
+32,7
@@
void sds_register(void)
//Read identifier
sdss[cs].id = read16();
//Read value
//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);
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);
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;
write16(sdss[cs].value);
write_byte('\n');
return;
diff --git
a/client/sds.h
b/client/sds.h
index
ab67bc8
..
de83421
100644
(file)
--- a/
client/sds.h
+++ b/
client/sds.h
@@
-7,8
+7,9
@@
struct sds {
int id;
struct sds {
int id;
- int value;
bool used;
bool used;
+ char type;
+ int value;
};
void sds_init(void);
};
void sds_init(void);
diff --git
a/mTaskInterpret.icl
b/mTaskInterpret.icl
index
538a5a9
..
e603f82
100644
(file)
--- 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)))
'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")
'\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
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 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 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 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 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 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
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
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
//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
(file)
--- a/
miTask.icl
+++ b/
miTask.icl
@@
-59,14
+59,14
@@
mTaskManager = startupDevices >>| anyTask
where
proc :: [MTaskMSGRecv] -> Task ()
proc [] = treturn ()
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) @! ()
// 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 @! ()
MTTaskAck i = deviceTaskAcked device i
MTTaskDelAck i = deviceTaskDeleteAcked device i @! ()
- MTEmpty = treturn ()
- _ = traceValue (toString m) @! ()
+ _ = treturn ()
) >>| proc ms
mapPar :: (a -> Task a) [a] -> Task ()
) >>| proc ms
mapPar :: (a -> Task a) [a] -> Task ()