X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Shares%2FmTaskShare.icl;h=8c0ae61355ffb78e257597dbd5b386a01858b0c4;hb=ee38806680e1706a4aea577d1ed699860f1fb0e8;hp=0999cc247c8c35d94785f4e365f5f3e2e60ecff0;hpb=da0d3362b957a1b9e0ef7eefb023d5817ec10ac6;p=mTask.git diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index 0999cc2..8c0ae61 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -5,53 +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 - -viewShares :: [MTaskShare] -> Task MTaskShare -viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal - >>| return (hd sh) +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 viewShare :: MTaskShare -> Task BCValue viewShare m = viewSharedInformation "" [] (getSDSShare m) <<@ Title ("SDS: " +++ toString m.identifier) getSDSShare :: MTaskShare -> Shared BCValue -getSDSShare s=:{realShare=(MTaskWithShare id)} - = memoryShare id s.MTaskShare.value +getSDSShare s=:{realShare=(MTaskWithShare id),value} = memoryShare id value makeShare :: String Int BCValue -> Task MTaskShare makeShare withTask identifier value = treturn {MTaskShare - |withTask=withTask + |withTask=[withTask] ,identifier=identifier ,value=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" @! ()