X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Shares%2FmTaskShare.icl;h=8c0ae61355ffb78e257597dbd5b386a01858b0c4;hb=ee38806680e1706a4aea577d1ed699860f1fb0e8;hp=7f9a2f499dbdc3576039cf4a891f8296d701673a;hpb=18c1286739897b65578e87b17167c6cef1922a3b;p=mTask.git diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index 7f9a2f4..8c0ae61 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -5,54 +5,67 @@ 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 = withShared Nothing $ \cs->forever $ + viewSharesGrid cs shares /*||- (viewSharedInformation "" [] cs*/ @! ()//)//||- editCurrentShare cs + +// >&^ \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 +// +from StdFunc import flip +viewSharesGrid :: (Shared (Maybe MTaskShare)) [MTaskShare] -> Task [BCValue] +viewSharesGrid _ [] = viewInformation "No shares yet" [] [] +viewSharesGrid cs sh = (allTasks [watch (getSDSShare m)\\m<-sh] <<@ NoUserInterface) + >&^ \st->flip (<<@) NoUserInterface $ whileUnchanged st $ \mshs->enterChoice "" [ChooseFromGrid id] + [{MTaskShare|ss&value=s}\\s<-fromJust mshs & ss<-sh] +// >>* [OnValue (withValue $ \s->Just (set (Just s) cs))] + @! fromJust mshs -viewShares :: [MTaskShare] -> Task MTaskShare -viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal - >>| return (hd sh) - -viewShare :: MTaskShare -> Task String +viewShare :: MTaskShare -> Task BCValue viewShare m = viewSharedInformation "" [] (getSDSShare m) <<@ Title ("SDS: " +++ toString m.identifier) -getSDSShare :: MTaskShare -> Shared String -getSDSShare s=:{realShare=(MTaskWithShare id)} - = memoryShare id s.MTaskShare.value +getSDSShare :: MTaskShare -> Shared BCValue +getSDSShare s=:{realShare=(MTaskWithShare id),value} = memoryShare id value -makeShare :: String Int String -> Task MTaskShare +makeShare :: String Int BCValue -> Task MTaskShare makeShare withTask identifier value = treturn {MTaskShare - |withTask=withTask + |withTask=[withTask] ,identifier=identifier ,value=value - ,dynvalue=dynamic value ,realShare=MTaskWithShare $ "mTaskSDS-" +++ toString identifier } >>= \sh->set value (getSDSShare sh) >>| treturn sh + +updateShare :: Int BCValue -> 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 val (getSDSShare mts)) + >>| traceValue "Updated" @! ()