- let r = EU.list_nth m st.ET.r in
- r.ET.o <- EU.list_toggle_all r.ET.o
- | [0;m;1;n] ->
- let r = EU.list_nth m st.ET.r in
- r.ET.o <- EU.list_toggle n r.ET.o
- | [0;m;2] ->
- let r = EU.list_nth m st.ET.r in
- r.ET.n <- EU.list_toggle_all r.ET.n
- | [0;m;2;n] ->
- let r = EU.list_nth m st.ET.r in
- r.ET.n <- EU.list_toggle n r.ET.n
- | [1] -> st.ET.t <- EU.list_toggle_all st.ET.t
- | [1;m] -> st.ET.t <- EU.list_toggle m st.ET.t
- | [2] -> st.ET.w <- EU.list_toggle_all st.ET.w
- | [2;m] -> st.ET.w <- EU.list_toggle m st.ET.w
- | _ -> EU.raise_error ET.ENoEntry
+ let pred r = List.iter EU.oobj_select r.ET.ro in
+ EU.list_nth pred m st.ET.sr
+ | [0;m;1;n] ->
+ let pred r = EU.list_nth EU.oobj_select n r.ET.ro in
+ EU.list_nth pred m st.ET.sr
+ | [0;m;2] ->
+ let pred r = List.iter EU.nobj_select r.ET.rn in
+ EU.list_nth pred m st.ET.sr
+ | [0;m;2;n] ->
+ let pred r = EU.list_nth EU.nobj_select n r.ET.rn in
+ EU.list_nth pred m st.ET.sr
+ | [1] -> List.iter EU.oobj_select st.ET.so
+ | [1;n] -> EU.list_nth EU.oobj_select n st.ET.so
+ | [2] -> List.iter EU.nobj_select st.ET.sn
+ | [2;n] -> EU.list_nth EU.nobj_select n st.ET.sn
+ | _ -> EU.raise_error ET.ENoEntry
+
+let select_entry p =
+ EU.pointer_visit select_entry [] p
+
+let expand_entry = function
+ | [0] -> List.iter EU.robj_expand st.ET.sr
+ | [0;m] -> EU.list_nth EU.robj_expand m st.ET.sr
+ | _ -> EU.raise_error ET.ENoEntry
+
+let expand_entry p =
+ EU.pointer_visit expand_entry [] p
+
+let make_tops () =
+ if EU.stage_compare st.ET.ss [] = 0 then EU.raise_error ET.ENoStage else
+ if st.ET.so <> [] then EU.raise_error ET.ETops else
+ if st.ET.sn <> [] then begin
+ st.ET.so <- List.map (EU.oobj_of_nobj st.ET.ss) st.ET.sn;
+ st.ET.sm <- true
+ end
+
+let add_role () =
+ let ts, os = EU.list_split EU.oobj_selected EU.oobj_select st.ET.so in
+ let ws, ns = EU.list_split EU.nobj_selected EU.nobj_select st.ET.sn in
+ if os = [] && ns = [] then () else
+ let add r =
+ r.ET.ro <- EU.oobj_union os r.ET.ro;
+ r.ET.rn <- EU.nobj_union ns r.ET.rn;
+ r.ET.rb <- false
+ in
+ let is_selected _ r = r.ET.rb && EU.stage_compare r.ET.rs st.ET.ss = 0 in
+ let is_new _ r = r.ET.ro = [] && EU.stage_compare r.ET.rs st.ET.ss = 0 in
+ let is_deleted _ r = r.ET.rn = [] && EU.stage_compare r.ET.rs st.ET.ss = 0 in
+ begin
+ if EU.list_apply is_selected add 0 st.ET.sr then () else
+ if os = [] && EU.list_apply is_new add 0 st.ET.sr then () else
+ if ns = [] && EU.list_apply is_deleted add 0 st.ET.sr then () else
+ let r = {ET.rb = false; ET.rx = false; ET.rs = st.ET.ss; ET.ro = os; ET.rn = ns} in
+ st.ET.sr <- EU.robj_union st.ET.sr [r]
+ end;
+ st.ET.so <- ts; st.ET.sn <- ws; st.ET.sm <- true
+
+let add_tops v =
+ let prop _ r = EU.stage_compare r.ET.rs v = 0 && r.ET.rn = [] in
+ if EU.list_apply prop ignore 0 st.ET.sr || st.ET.so <> []
+ then EU.raise_error ET.ETops else
+ let ds, ts = EU.robj_tops v st.ET.sr in
+ if ds <> [] then begin
+ let r = {ET.rb = false; ET.rx = false; ET.rs = st.ET.ss; ET.ro = ds; ET.rn = []} in
+ st.ET.sr <- EU.robj_union [r] st.ET.sr
+ end;
+ if ts <> [] then st.ET.so <- ts;
+ if ds <> [] || ts <> [] then st.ET.sm <- true
+
+let rec add_matching () =
+ match EU.oobj_match 0 0 st.ET.so st.ET.sn with
+ | None -> ()
+ | Some (ti,wi) ->
+ select_entry [ET.One 1; ET.One ti];
+ select_entry [ET.One 2; ET.One wi];
+ add_role ();
+ add_matching ()
+
+let remove_roles () =
+ let rs, os, ns = EU.robj_split st.ET.ss st.ET.sr in
+ if os = [] && ns = [] then () else begin
+ st.ET.so <- EU.oobj_union os st.ET.so;
+ st.ET.sn <- EU.nobj_union ns st.ET.sn;
+ st.ET.sr <- rs; st.ET.sm <- true
+ end