Commit eff870b7 authored by Bas Lijnse's avatar Bas Lijnse

Got edit events working again for the basic built-in editors

parent 025577d2
......@@ -100,12 +100,11 @@ where
//Refresh the editor with a view based on the share editor
= case refreshView_ taskId mode mbEditor taskTime (snd (initFun r)) v m ts iworld of
(Ok (v,cr,m,ts),iworld)
//Merge the UI changes : TODO
# change = ce
//Construct the result
# valid = not (containsInvalidFields m)
# value = if valid (Value (l,v) False) NoValue
# info = {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True}
# change = mergeUIChanges ce cr
# valid = not (containsInvalidFields m)
# value = if valid (Value (l,v) False) NoValue
# info = {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True}
= (ValueResult value info change (TCInteract taskId ts (toJSON l) (toJSON v) m), iworld)
eval event evalOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......
......@@ -256,8 +256,14 @@ instance encodeUI (Maybe a) | encodeUI a
instance encodeUI [a] | encodeUI a
instance encodeUI UI
//Combine two changes that would have to be applied one after the other into a single change
mergeUIChanges :: UIChange UIChange -> UIChange
//Apply a change to a ui
applyUIChange :: !UIChange !UI -> UI
//Remove all paths that lead to a NoChange node
compactChangeDef :: UIChange -> UIChange
compactUIChange :: UIChange -> UIChange
//Makes sure that all children ranging 0 to max(index) are in the list
completeChildChanges :: [(Int,UIChildChange)] -> [(Int,UIChildChange)]
......
......@@ -329,25 +329,44 @@ where
encodeUI ModalDialog = JSONString "modal"
encodeUI NotificationBubble = JSONString "bubble"
component :: String [JSONNode] -> JSONNode
component xtype opts = JSONObject [("xtype",JSONString xtype):optsfields]
where
optsfields = flatten [fields \\ JSONObject fields <- opts]
derive class iTask UIChange, UIAttributeChange, UIChildChange
mergeUIChanges :: UIChange UIChange -> UIChange
mergeUIChanges c1 NoChange = c1
mergeUIChanges NoChange c2 = c2
mergeUIChanges _ (ReplaceUI ui2) = ReplaceUI ui2 //Any previous change is void when it is followed by a replace
mergeUIChanges (ReplaceUI ui1) (ChangeUI ca2 ci2) = ReplaceUI (applyUIChange (ChangeUI ca2 ci2) ui1)
mergeUIChanges (ChangeUI ca1 ci1) (ChangeUI ca2 ci2) = ChangeUI (ca1 ++ ca2) (ci1 ++ ci2)
applyUIChange :: !UIChange !UI -> UI
applyUIChange NoChange ui = ui
applyUIChange (ReplaceUI ui) _ = ui
applyUIChange (ChangeUI ca ci) (UI type attr items)
//Change the attributes
# attr = foldl appAttributeChange attr ca
//Adjust the children
# items = foldl appChildChange items ci
= UI type attr items
where
appAttributeChange attr (SetAttribute n v) = 'DM'.put n v attr
derive class iTask UIChange, UIAttributeChange, UIChildChange
appChildChange items (i,RemoveChild) = removeAt i items
appChildChange items (i,InsertChild ui) = insertAt i ui items
appChildChange items (i,ChangeChild change) = updateAt i (applyUIChange change (items !! i)) items
//Remove unnessecary directives
compactChangeDef :: UIChange -> UIChange
compactChangeDef (ChangeUI localChanges children)
compactUIChange :: UIChange -> UIChange
compactUIChange (ChangeUI localChanges children)
= case ChangeUI localChanges [child \\ child=:(_,ChangeChild change) <- map compactChildDef children | not (change =: NoChange)] of
ChangeUI [] [] = NoChange
def = def
change = change
where
compactChildDef (idx,ChangeChild change) = (idx,ChangeChild change)
compactChildDef def = def
compactChangeDef def = def
compactUIChange def = def
completeChildChanges :: [(Int,UIChildChange)] -> [(Int,UIChildChange)]
completeChildChanges children = complete 0 (sortBy indexCmp children)
......
......@@ -56,7 +56,7 @@ where
JSONNull = (Ok (ChangeUI [SetAttribute "value" JSONNull] [],FieldMask {touched=True,valid=optional,state=JSONNull}),val,vst)
json = case fromJSON e of
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=e}),val,vst)
Just val = (Ok (ChangeUI [SetAttribute "value" (toValue val)] [],FieldMask {touched=True,valid=True,state=e}),val,vst)
Just val = (Ok (ChangeUI [SetAttribute "value" (toValue val)] [],FieldMask {touched=True,valid=True,state=toValue val}),val,vst)
onRefresh dp new old mask vst=:{VSt|mode,optional}
| old === new = (Ok (NoChange,mask),new,vst)
......
......@@ -15,15 +15,18 @@ where
= (Ok (UI type attr items,mask),vst)
(e,vst) = (e,vst)
onEdit dp e val mask ust = editor.Editor.onEdit dp e val mask ust
onEdit dp e oval omask vst=:{VSt|optional}
= addHintAttrChanges omask (editor.Editor.onEdit dp e oval omask vst)
onRefresh dp e oval omask vst=:{VSt|optional}
= addHintAttrChanges omask (editor.Editor.onRefresh dp e oval omask vst)
onRefresh dp new old mask vst=:{VSt|optional}
= case stdAttributeChanges typeDesc optional mask mask of
[] = editor.Editor.onRefresh dp new old mask vst //Nothing to add
hintChanges = case editor.Editor.onRefresh dp new old mask vst of
(Ok (NoChange,mask),new,vst) = (Ok (ChangeUI hintChanges [],mask),new,vst)
(Ok (ChangeUI attrChanges itemChanges,mask),new,vst) = (Ok (ChangeUI (attrChanges ++ hintChanges) itemChanges,mask),new,vst)
(e,val,vst) = (e,val,vst)
addHintAttrChanges omask (Ok (change,nmask),nval,vst=:{VSt|optional})
# attrChange = case stdAttributeChanges typeDesc optional omask nmask of
[] = NoChange
cs = ChangeUI cs []
# change = mergeUIChanges change attrChange
= (Ok (change,nmask),nval,vst)
addHintAttrChanges omask (e,val,vst) = (e,val,vst)
whenDisabled :: (Editor a) (Editor a) -> Editor a
whenDisabled disabledEditor enabledEditor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
......
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