X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=metaeditor%2FEditorExt.icl;fp=metaeditor%2FEditorExt.icl;h=4512ae076bf90485004ba2d28673ba4bb1cca4ce;hb=ec0704b3b8d380f05f93076ca16da6c5701fe4bc;hp=0000000000000000000000000000000000000000;hpb=1eb7ba9a34eacb68c762bd9f7f81865cf37ecb0b;p=clean-tests.git

diff --git a/metaeditor/EditorExt.icl b/metaeditor/EditorExt.icl
new file mode 100644
index 0000000..4512ae0
--- /dev/null
+++ b/metaeditor/EditorExt.icl
@@ -0,0 +1,150 @@
+implementation module EditorExt
+
+from Data.Func import $
+import Data.Tuple
+import qualified Data.Map as DM
+import StdTuple
+import Data.Maybe
+
+import iTasks
+import iTasks.UI.Editor.Common
+
+row :: String (Editor a) -> Editor a
+row l e = bijectEditorValue (tuple l) snd $
+	container2 label e <<@ directionAttr Horizontal
+
+import StdDebug, StdMisc
+
+// Choose combinators (Used for selecting constructors in ADTs)
+choose :: [(String, Editor a)] -> Editor (Int, a)
+choose [] = emptyEditor
+choose [(k,v)] = bijectEditorValue snd (tuple 0) $ row k v
+choose cs = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
+where
+	numConses = length cs
+	conses = map fst cs
+
+	genUI dp (consindex, value) vst=:{VSt|taskId,mode,optional,selectedConsIndex}
+		# cured = snd (cs !! consindex)
+		= case mode of
+			Enter
+				# (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses Nothing
+				= (Ok (UI UIVarCons 'DM'.newMap [consChooseUI],CompoundMask {fields=[consChooseMask],state=JSONNull}),{vst & selectedConsIndex = selectedConsIndex})
+			Update
+				= case cured.Editor.genUI dp value vst of
+					(Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
+						# (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses (Just vst.selectedConsIndex)
+						= (Ok (UI UIVarCons attr [consChooseUI:items],CompoundMask {fields=[consChooseMask:fields],state=JSONNull})
+							,{vst & selectedConsIndex = selectedConsIndex})
+					(Error e,vst) = (Error e,vst)
+			View
+				= case cured.Editor.genUI dp value vst of
+					(Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
+						# (consViewUI,consViewMask) = genConsViewUI conses vst.selectedConsIndex
+						= (Ok (UI UIVarCons attr [consViewUI:items],CompoundMask {fields=[consViewMask:fields],state=JSONNull})
+							,{vst & selectedConsIndex = selectedConsIndex})
+					(Error e,vst) = (Error e,vst)
+
+	genConsChooseUI taskId dp optional gtd_conses mbSelectedCons = (consChooseUI,consChooseMask)
+	where
+		consOptions = [JSONObject [("id",JSONInt i),("text",JSONString gdc)] \\ gdc <- gtd_conses & i <- [0..]]
+		consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) (maybeToList mbSelectedCons) consOptions)
+		consChooseMask = FieldMask {touched=False,valid=optional || isJust mbSelectedCons,state=maybe JSONNull JSONInt mbSelectedCons}
+
+	genConsViewUI gtd_conses selectedCons
+		= (uia UITextView (valueAttr (JSONString (gtd_conses !! selectedCons))), newFieldMask)
+
+	//Update is a constructor switch
+	onEdit dp ([],JSONArray [JSONInt consIdx]) (i, val) (CompoundMask {fields=[FieldMask {FieldMask|touched,valid,state}:masks]}) vst//=:{VSt|mode} 
+		| not (trace_tn ("cons switch from " +++ toString i +++ " to " +++ toString consIdx)) = undef
+		# cured = snd (cs !! consIdx)
+		| consIdx < 0 || consIdx >= numConses
+			= (Error "Constructor selection out of bounds", (i, val),vst)
+		//Create a default value for the selected constructor
+		//This is a rather ugly trick: We create a special target path that consists only of negative values that is
+		//decoded by the the onEdit instance of EITHER to create a value that consists of the correct nesting of LEFT's and RIGHT's
+		//										//TODO hier zit de bug
+    	# (_,val,vst)	= cured.Editor.onEdit dp (consCreatePath consIdx numConses,JSONNull) val newCompoundMask vst
+		//Create a UI for the new constructor 
+		= case cured.Editor.genUI dp val {vst & mode = Enter} of
+			(Ok (UI _ attr items, CompoundMask {fields=masks}),vst)
+				//Construct a UI change that does the following: 
+				//1: If necessary remove the fields of the previously selected constructor
+				# removals = case state of
+//					(JSONInt prevConsIdx) = repeatn (length (snd (cs !! prevConsIdx))) (1,RemoveChild)
+//					(JSONInt prevConsIdx) = repeatn (length items) (1,RemoveChild)
+					_                 = []
+				//2: Inserts the fields of the newly created ui
+				# inserts = [(i,InsertChild ui) \\ ui <- items & i <- [1..]]
+				# change = ChangeUI [] (removals ++ inserts)
+				//Create a new mask for the constructor selection
+				# consChooseMask = FieldMask {touched=True,valid=True,state=JSONInt consIdx}
+				= (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}), (consIdx, val), vst)
+			(Error e,vst) = (Error e, (i, val), vst)
+
+	//Other events targeted directly at the ADT 
+	onEdit dp ([],e) (i, val) (CompoundMask {fields=[consChooseMask=:(FieldMask {FieldMask|touched,valid,state}):masks]}) vst=:{VSt|optional}
+		| e =: JSONNull || e =: (JSONArray []) // A null or an empty array are accepted as a reset events
+			//If necessary remove the fields of the previously selected constructor
+			# change = case state of
+//				(JSONInt prevConsIdx) = ChangeUI [] (repeatn 32 /*(gtd_conses !! prevConsIdx).gcd_arity */(1,RemoveChild))
+				_                     = NoChange		
+			# consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull}
+			= (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}),(i, val), vst)	
+		= (Error "Unknown constructor select event ",(i, val),vst)
+
+	//Update is targeted somewhere inside this value
+	onEdit dp (tp,e) (i, val) mask=:(CompoundMask {fields,state}) vst 
+		# cured = snd (cs !! i)
+		//Adjust for the added constructor switch UI
+		# consChooseMask = hd fields
+		= case cured.Editor.onEdit dp (tp,e) val (CompoundMask {fields=tl fields,state=JSONNull}) vst of
+			(Ok (change,CompoundMask {fields}),val,vst)
+				# change = case change of
+					(ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges]
+					_                                  = NoChange
+				= (Ok (change,CompoundMask {fields=[consChooseMask:fields],state=JSONNull}),(i, val),vst)
+			(Error e,val,vst) = (Error e, (i, val), vst)
+
+	consCreatePath i n
+ 	| i >= n     = []
+	| n == 1     = []
+	| i < (n /2) = [ -1: consCreatePath i (n/2) ]
+	| otherwise  = [ -2: consCreatePath (i - (n/2)) (n - (n/2)) ]
+
+	onRefresh dp (i, new) (j, old) mask=:(CompoundMask {fields}) vst=:{VSt|mode,taskId,optional,selectedConsIndex=curSelectedConsIndex}
+		# cured = snd (cs !! i)
+		| numConses == 1
+			# (change,val,vst) = cured.Editor.onRefresh dp new old mask vst
+			= (change,(j, val),vst)
+		| otherwise
+			//Adjust for the added constructor view/choose UI
+			# consChooseMask = hd fields
+			//Don't recursively refresh if no constructor has been chosen
+			| (not mode =: View) && consChooseMask =: (FieldMask {FieldMask|state=JSONNull})
+				= (Ok (NoChange,mask),(i, old),vst)
+			= case cured.Editor.onRefresh dp new old (CompoundMask {fields=tl fields,state=JSONNull}) {vst & selectedConsIndex = 0} of
+				(Ok (change,CompoundMask {fields}),val,vst=:{VSt|selectedConsIndex}) 
+					//If the cons was changed we need to update the selector
+					# consIndex = ~selectedConsIndex - 1
+					# consChange = if (selectedConsIndex < 0)
+						[(0, ChangeChild (ChangeUI [SetAttribute "value" (JSONArray [JSONInt consIndex,JSONBool True])] []))]
+						[]
+					//Adjust the changes
+					# change = case change of
+						NoChange						     = if (consChange =: []) NoChange (ChangeUI [] consChange)
+						(ChangeUI attrChanges itemChanges)   = ChangeUI attrChanges (consChange ++ [(i + 1,c) \\ (i,c) <- itemChanges])
+						(ReplaceUI ui=:(UI type attr items))
+							//Add the constructor selection/view ui
+							# (consUI,_) = if (mode =: View) 
+												(genConsViewUI conses consIndex)
+												(genConsChooseUI taskId dp optional conses (Just consIndex))
+							= ReplaceUI (UI type attr [consUI:items])
+					| otherwise
+						= (Ok (change, CompoundMask {fields=[consChooseMask:fields],state=JSONNull}), (j, val),{vst & selectedConsIndex = curSelectedConsIndex})
+
+				(Ok (change,mask),val,vst=:{VSt|selectedConsIndex}) 
+					= (Error "Corrupt mask in generic choose editor",(i, old), vst)
+				(Error e,val,vst) = (Error e,(i, val),vst)
+	onRefresh dp (i, new) (j, old) mask vst
+		= (Error "Corrupt mask in generic choose editor",(j, old), vst)