X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=Shares%2FmTaskShare.icl;h=8c0ae61355ffb78e257597dbd5b386a01858b0c4;hb=ee38806680e1706a4aea577d1ed699860f1fb0e8;hp=b0c4424e3f1c706c653407448a0e74dabaa90cab;hpb=28eafcb52cf6d0ce0778f90beec2e08c046c10a0;p=mTask.git diff --git a/Shares/mTaskShare.icl b/Shares/mTaskShare.icl index b0c4424..8c0ae61 100644 --- a/Shares/mTaskShare.icl +++ b/Shares/mTaskShare.icl @@ -1,32 +1,71 @@ implementation module Shares.mTaskShare +import dynamic_string import Utils.SDS +import Utils.Devices import iTasks +import mTask +import Data.List from Data.Func import $ +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 @! zero - Just sh = forever ( - viewSharedInformation "View value" [] (getSDSStore sh) - >>* [OnAction (Action "Update") (withValue $ Just $ updateInformation "New value" [])] - >>= updateShare 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 Int -> Task MTaskShare -updateShare sh=:{withTask} i = return sh +//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 () -viewShares sh = anyTask (map viewShare sh) <<@ ArrangeHorizontal @! () +viewShare :: MTaskShare -> Task BCValue +viewShare m = viewSharedInformation "" [] (getSDSShare m) + <<@ Title ("SDS: " +++ toString m.identifier) -viewShare :: MTaskShare -> Task () -viewShare m = viewSharedInformation "" [] (getSDSStore m) - <<@ Title ("SDS: " +++ toString m.identifier) @! () +getSDSShare :: MTaskShare -> Shared BCValue +getSDSShare s=:{realShare=(MTaskWithShare id),value} = memoryShare id value -instance zero MTaskShare where - zero = {initValue=0,withTask="",identifier=0,realShare=""} +makeShare :: String Int BCValue -> Task MTaskShare +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 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" @! ()