Commit 19c9a58e authored by Bas Lijnse's avatar Bas Lijnse

Added possibility to set ui attributes such as title based on task values.

This is used for a viewSharedTitle task that dynamically shows a title based on a shared value.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2383 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 53ced609
......@@ -326,7 +326,9 @@ appendTopLevelTask :: !ManagementMeta !(Task a) -> Task TaskId | iTask a
appendTopLevelTaskFor :: !worker !(Task a) -> Task TaskId | iTask a & toUserConstraint worker
// Additional tuning shortcuts
instance tune Window //Indicate that this task should be a window
instance tune InWindow //Indicate that this task is preferred to be placed in a window
instance tune InContainer //Indicate that this task is preferred to be placed in a borderless container
instance tune InPanel //Indicate that this task is preferred to be placed in a panel with a border
//Common derived task steps
Always :: Action (Task b) -> TaskStep a b
......
......@@ -218,8 +218,12 @@ appendTopLevelTask props task = appendTask (Detached props) (\_ -> task @ const
appendTopLevelTaskFor :: !worker !(Task a) -> Task TaskId | iTask a & toUserConstraint worker
appendTopLevelTaskFor worker task = appendTopLevelTask {defaultValue & worker = toUserConstraint worker} task
instance tune Window
where tune Window task = task <<@ AfterLayout (tweakAttr ('Map'.put FLOAT_ATTRIBUTE "window"))
instance tune InWindow
where tune InWindow task = task <<@ AfterLayout (tweakAttr ('Map'.put CONTAINER_ATTRIBUTE "window"))
instance tune InContainer
where tune InContainer task = task <<@ AfterLayout (tweakAttr ('Map'.put CONTAINER_ATTRIBUTE "container"))
instance tune InPanel
where tune InPanel task = task <<@ AfterLayout (tweakAttr ('Map'.put CONTAINER_ATTRIBUTE "panel"))
valToMaybe (Value v _) = Just v
valToMaybe NoValue = Nothing
......
......@@ -329,6 +329,13 @@ waitForTimer :: !Time -> Task Time
chooseAction :: ![(!Action,a)] -> Task a | iTask a
/**
* Visualizes data as a title and show it
* View data as a title
*/
viewTitle :: !a -> Task a | iTask a
viewTitle :: !a -> Task a | iTask a
/**
* View shared data as a title
*/
viewSharedTitle :: !(ReadWriteShared r w) -> Task r | iTask r
......@@ -5,8 +5,7 @@ from SystemData import null
from Tuple import appSnd
from List import isMemberGen, instance Functor []
from Time import :: Timestamp(..)
from Map import qualified put
from Util import kvSet
from Map import qualified get, put
import StdBool, StdList, StdMisc, StdTuple
import CoreTasks, CoreCombinators, CommonCombinators, LayoutCombinators, SystemData
......@@ -261,8 +260,18 @@ sharedMultiChoiceToUpdate options = case multiChoiceToUpdate options of
_ = []
viewTitle :: !a -> Task a | iTask a
viewTitle a = viewInformation Void [ViewWith view] a
viewTitle a = viewInformation (Title title) [ViewWith view] a <<@ InContainer <<@ AfterLayout (tweakAttr titleFromValue)
where
title = visualizeAsText AsLabel a
view a = DivTag [] [SpanTag [StyleAttr "font-size: 30px"] [Text title]]
addTitleAttr attr = 'Map'.put TITLE_ATTRIBUTE title attr
title = visualizeAsText AsLabel a
view a = DivTag [] [SpanTag [StyleAttr "font-size: 30px"] [Text title]]
viewSharedTitle :: !(ReadWriteShared r w) -> Task r | iTask r
viewSharedTitle s = viewSharedInformation Void [ViewWith view] s <<@ InContainer <<@ AfterLayout (tweakAttr titleFromValue)
where
view r = DivTag [] [SpanTag [StyleAttr "font-size: 30px"] [Text (visualizeAsText AsLabel r)]]
titleFromValue :: UIAttributes -> UIAttributes
titleFromValue attr = case 'Map'.get VALUE_ATTRIBUTE attr of
Just v = 'Map'.put TITLE_ATTRIBUTE v attr
_ = attr
......@@ -100,7 +100,7 @@ watch :: !(ReadWriteShared r w) -> Task r | iTask r
interact :: !d !(ReadOnlyShared r) (r -> (l,v,InteractionMask)) (l r v InteractionMask Bool -> (l,v,InteractionMask)) -> Task l | descr d & iTask l & iTask r & iTask v
interactNullEnter :: !d !v (v->l) -> Task l | descr d & iTask v
interactNullEnter :: !d !v (v->l) -> Task l | descr d & iTask v & iTask l
interactNullUpdate :: !d !(l -> v) (l v -> l) l -> Task l | descr d & iTask l & iTask v
interactNullView :: !d (l->v) l -> Task l | descr d & iTask l & iTask v
interactSharedChoice :: !d !(ReadOnlyShared r) (Maybe l) (r (Maybe l) -> t v l)
......
......@@ -91,7 +91,7 @@ where
(l,nv,nmask)
//Make visualization
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -133,7 +133,7 @@ where
(l,nv,nmask)
//Make visualization
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -172,7 +172,7 @@ where
# (nl,nv,nmask) = if changed (refresh_fun nr) (l,nv,mask)
//Make visualization
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -181,7 +181,7 @@ where
# v = toView r
= (r,v,Touched)
interactNullEnter :: !d !v (v->l) -> Task l | descr d & iTask v
interactNullEnter :: !d !v (v->l) -> Task l | descr d & iTask v & iTask l
interactNullEnter desc initFun fromf = Task eval
where
eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
......@@ -200,7 +200,7 @@ where
# (nl,nv,nmask) = if changed (refresh_fun l nv nmask valid) (l,nv,mask)
//Make visualization
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -230,7 +230,7 @@ where
# (nl,nv,nmask) = if changed (refresh_fun l nv nmask valid) (l,nv,mask)
//Make visualization
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -259,7 +259,7 @@ where
# nl = l
//Make visualization
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -291,7 +291,7 @@ where
# (nl,nv,nmask) = if changed (refreshFun l nr nv nmask valid) (l,nv,mask)
//Make visualization
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# (rep,iworld) = visualizeView taskId repOpts nv validity desc (visualizeAsText AsLabel nl) iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract taskId nts (toJSON nl) (toJSON nr) (toJSON nv) nmask), iworld)
......@@ -308,10 +308,10 @@ matchAndApplyEvent (FocusEvent taskId) matchId taskTime v mask ts iworld
matchAndApplyEvent _ matchId taskTime v mask ts iworld
= (v,mask,ts,iworld)
visualizeView taskId repOpts v validity desc iworld
visualizeView taskId repOpts v validity desc valueAttr iworld
# layout = repLayout repOpts
# (controls,iworld) = visualizeAsEditor v validity taskId layout iworld
# uidef = (afterLayout repOpts) (UIControlSequence (layout.Layout.interact (toPrompt desc) {UIControlSequence|attributes=newMap,controls=controls,direction=Vertical}))
# uidef = (afterLayout repOpts) (UIControlSequence (layout.Layout.interact (toPrompt desc) {UIControlSequence|attributes=put VALUE_ATTRIBUTE valueAttr newMap,controls=controls,direction=Vertical}))
= (TaskRep uidef [(toString taskId,toJSON v)], iworld)
could_not_read_shared_in_interact_exception iworld
......
......@@ -37,7 +37,7 @@ autoInteractionLayout prompt editor
autoStepLayout :: UIDef [UIAction]-> UIDef
autoStepLayout (UIControlSequence {UIControlSequence|attributes,controls,direction}) actions
//Recognize special case of a complete empty interaction wrapped in a step as an actionset
| isEmpty controls && isEmpty (toList attributes)
| isEmpty controls
= UIActionSet {UIActionSet|attributes = attributes,actions = actions}
//Promote the control sequence to a control group because they are grouped by the step combinator
= UIControlGroup {UIControlGroup|attributes = attributes, controls = controls, direction = direction, actions = actions}
......@@ -213,13 +213,19 @@ where
//This can be a container, a panel or just a single control such as a textarea, a grid or a tree
defToControl :: UIDef -> UIControl
defToControl def
| isJust (get TITLE_ATTRIBUTE (uiDefAttributes def))//If a title attribute is set, always make a panel
= defToPanel def
| otherwise
= case uiDefControls def of
[c=:(UIContainer _ _ _)] = c //Already a container, no need to double wrap
[c=:(UIPanel _ _ _)] = c //Idem...
_ = defToContainer def
= case (get CONTAINER_ATTRIBUTE attributes) of
(Just "panel") = defToPanel def
(Just "container") = makeContainer def
_ = case (get TITLE_ATTRIBUTE attributes) of
Just _ = defToPanel def //If a title attribute is set make a panel
Nothing = makeContainer def
where
attributes = uiDefAttributes def
makeContainer def = case uiDefControls def of
[c=:(UIContainer _ _ _)] = c //Already a container, no need to double wrap
[c=:(UIPanel _ _ _)] = c //Idem...
_ = defToContainer def
placePanelActions :: [UIAction] Bool UIControl -> ([UIAction],[UIKeyAction],UIControl)
placePanelActions actions placeMenus (UIPanel sOpts iOpts=:{UIItemsOpts|items} opts)
......@@ -792,7 +798,7 @@ actionToHotkey {taskId,action=Action actionId options,enabled=True}
actionToHotkey _ = Nothing
hasWindowAttr :: UIAttributes -> Bool
hasWindowAttr attributes = maybe False ((==) "window") (get FLOAT_ATTRIBUTE attributes)
hasWindowAttr attributes = maybe False ((==) "window") (get CONTAINER_ATTRIBUTE attributes)
singleControl :: UIDef -> Bool
singleControl def = case uiDefControls def of
......@@ -800,7 +806,7 @@ singleControl def = case uiDefControls def of
_ = False
mergeAttributes :: UIAttributes UIAttributes -> UIAttributes
mergeAttributes attr1 attr2 = foldr (\(k,v) attr -> put k v attr) attr1 (toList attr2)
mergeAttributes attr1 attr2 = foldl (\attr (k,v) -> put k v attr) attr1 (toList attr2)
appDeep :: [Int] (UIControl -> UIControl) UIControl -> UIControl
appDeep [] f ctrl = f ctrl
......
......@@ -657,6 +657,7 @@ derive class iTask TaskId, Config, ProcessStatus
//Define initial meta attributes
TASK_ATTRIBUTE :== "task"
VALUE_ATTRIBUTE :== "value"
TITLE_ATTRIBUTE :== "title"
HINT_ATTRIBUTE :== "hint"
VALID_ATTRIBUTE :== "valid"
......@@ -665,18 +666,25 @@ LABEL_ATTRIBUTE :== "label"
ICON_ATTRIBUTE :== "icon"
CREATED_AT_ATTRIBUTE :== "createdate"//Creation task time, used for ordering but not real time
LAST_EVENT_ATTRIBUTE :== "lastevent" //Last event task time, used for ordering but not real time
FLOAT_ATTRIBUTE :== "float" //Hint for layout functions. Currently only "window" has an effect
//Preferred container attribute for abstract containers. Does not have to be honoured by layouts
CONTAINER_ATTRIBUTE :== "container" //Container preference for layout functions. Possible preferences: "container", "panel", or "window"
:: Att = E.a: Att !a & descr a
:: Title = Title !String
:: Hint = Hint !String
:: Window = Window
:: InWindow = InWindow
:: InContainer = InContainer
:: InPanel = InPanel
:: Icon = Icon !String
| IconView
| IconEdit
Window :== InWindow
//Make the UI definition of the interaction prompt
class descr d
where
......
......@@ -1594,7 +1594,7 @@ where
instance descr [d] | descr d
where
toPrompt list = foldr merge {UIControlSequence| attributes = newMap, controls = [], direction = Vertical} (map toPrompt list)
toPrompt list = foldl merge {UIControlSequence| attributes = newMap, controls = [], direction = Vertical} (map toPrompt list)
where
merge p1 p2 = {UIControlSequence
|attributes = mergeAttributes p1.UIControlSequence.attributes p2.UIControlSequence.attributes
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment