21
30
31:- use_module(library(cgt/cge/swi_apeal)). 32term_expansion(HeadIn,IS,Head,OS):- current_prolog_flag(swi_apeal,true), gui_expansion(HeadIn,Head)->IS=OS.
33
34:- set_prolog_flag(swi_apeal,true). 35
36
37% 91/01/03 mw update_linear/1 now updates header too; added update_viewer/1
38% 91/02/19 mw cge_save_gr/1 now updates display
39
40cge :- shell widget cge(300, 5, 50, _).
41
42cge(DW, MF, LH, E) :- shell widget cge(DW, MF, LH, E).
43
44gen_graphical(type_def, Type, Editor) :-
45 concept_type(Type, Label, l/Id, _, _), l(l/Id, CIDs, GID),
46 mark, copy_graph(GID, Copy, outer), unmark,
47 map(copy_parameter(_, _, GID, Copy), CIDs, Params),
48 display_in(Editor, Label, Params, Copy, type_def, Type).
49gen_graphical(rel_def, Type, Editor) :-
50 relation_type(Type, Label, l/Id, _, _), l(l/Id, CIDs, GID),
51 mark, copy_graph(GID, Copy, outer), unmark,
52 map(copy_parameter(_, _, GID, Copy), CIDs, Params),
53 display_in(Editor, Label, Params, Copy, rel_def, Type).
54gen_graphical(schema, LID, Editor) :-
55 l(LID, [CID], GID), type(CID, Type),
56 concept_type(Type, Label, _, _, _),
57 mark, copy_graph(GID, Copy, outer), unmark,
58 copy_parameter(CID, Param, GID, Copy),
59 display_in(Editor, Label, [Param], Copy, schema, LID).
60gen_graphical(can_graph, Type, Editor) :-
61 ( relation_type(Type, Label, _, Can, _)
62 ; concept_type(Type, Label, _, Can, _)
63 ), mark, copy_graph(Can, Copy, outer), unmark,
64 display_in(Editor, Label, [], Copy, can_graph, Type).
65gen_graphical(graph, GID, Editor) :-
66 mark, copy_graph(GID, Copy, outer), unmark,
67 display_in(Editor, graph, [], Copy, graph, GID).
68
69display_in(Editor, Label, Parameters, GID, Kind, Obj) :-
70 ( description(Kind, Obj, Header), Marked = [], TmpVar = 0
71 ; gen_header(Kind, Label, Parameters, Marked, 0, TmpVar, Header, [])
72 ; Header = '', Marked = [], TmpVar = 0
73 ),
74 recorded(cg_editor, Editor-Title-Graph-_Linear-_, _),
75 Graph wproc unmap,
76 display_graph(GID, Graph, Marked, TmpVar, _),
77 Graph wproc map,
78 update_linear(Editor), replace_text(Title, Header).
79
80display_graph([], _Graph, _, VarIn, VarIn).
81display_graph([GID|List], Graph, Marked, VarIn, VarOut) :-
82 display_graph(GID, Graph, Marked, VarIn, TmpVar),
83 display_graph(List, Graph, Marked, TmpVar, VarOut).
84display_graph(GID, Graph, Marked, VarIn, VarOut) :-
85 g(GID, CL, RL), dir_reference(CL, RL),
86 display_concept(CL, Graph, Marked, VarIn, VarOut),
87 display_relation(RL, Graph),
88 recorda(corresponds, GID-Graph, _).
89
90display_concept([], _, _, VarIn, VarIn).
91display_concept([CID|List], Graph, Marked, VarIn, VarOut) :-
92 display_concept(CID, Graph, Marked, VarIn, TmpVar),
93 display_concept(List, Graph, Marked, TmpVar, VarOut).
94display_concept(p/Id-_, Graph, _Marked, VarIn, VarOut) :-
95 type(p/Id, Type), referent(p/Id, Ref), basic_ref(Ref, '*'),
96 Graph widget Context= context([]),
97 recorda(corresponds, p/Id-Context, _),
98 display_type(Type, Context, VarIn, VarOut).
99display_concept(p/Id-_, Graph, Marked, VarIn, VarOut) :-
100 type(p/Id, proposition), referent(p/Id, Ref),
101 basic_ref(Ref, Basic), % doesn't handle coreference links
102 Graph widget Context= context([]),
103 recorda(corresponds, p/Id-Context, _),
104 display_ref(Basic, Context, Marked, VarIn, VarOut).
105display_concept(CID-_, Graph, Marked, VarIn, VarOut) :-
106 type(CID, Type), referent(CID, Ref),
107 basic_ref(Ref, Basic), % doesn't handle coreference links
108 Graph widget Concept= concept([]),
109 recorda(corresponds, CID-Concept, _),
110 display_type(Type, Concept, VarIn, TmpVar),
111 display_ref(Basic, Concept, Marked, TmpVar, VarOut).
112
113display_type(l/Id, Concept, VarIn, VarOut) :-
114 l(l/Id, [CID], GIDs),
115 succ(VarIn, TmpVar), number2var(VarIn, Var),
116 Concept widget typeField(Var, Graph),
117 display_graph(GIDs, Graph, [CID+Var], TmpVar, VarOut).
118display_type(Type, Concept, VarIn, VarIn) :-
119 concept_type(Type, Label, _, _, _),
120 Concept widget typeField(Label).
121
122display_ref(Ref, Context, Marked, VarIn, VarOut) :-
123 recorded(corresponds, p/_-Context, _),
124 Context widget Graph= graphs,
125 display_graph(Ref, Graph, Marked, VarIn, VarOut).
126display_ref(Ref, Concept, Marked, VarIn, VarIn) :-
127 recorded(corresponds, CID-Concept, _),
128 member(CID+Var, Marked), reffield(Ref = '*'-Var, L, []),
129 Concept widget refField([:|L]).
130display_ref('*', _, _, VarIn, VarIn).
131display_ref(every, Concept, _Marked, VarIn, VarIn) :-
132 Concept widget Ref= refField([:, '"']),
133 Ref wset font(symbol).
134display_ref(Ref, Concept, _Marked, VarIn, VarIn) :-
135 referent(Ref, L, []),
136 Concept widget refField([:|L]).
137
138display_relation([], _).
139display_relation([Rel|List], Graph) :-
140 display_relation(Rel, Graph), display_relation(List, Graph).
141display_relation(Relation, Graph) :-
142 Relation =.. [RelType|Args], relation_type(RelType, Label, _, _, _),
143 Graph widget RelWID= relation(Label, []),
144 recorda(corresponds, Relation-RelWID, _),
145 drawArcs(RelWID, Args).
146
147drawArcs(RelWID, [CID]) :-
148 recorded(corresponds, CID-ConWID, _), cge_linkNode(RelWID, ConWID).
149drawArcs(RelWID, [CID|T]) :-
150 recorded(corresponds, CID-ConWID, _), cge_linkNode(ConWID, RelWID),
151 drawArcs(RelWID, T).
152
153cge_linkNode(WID1, WID2) <->
154 WID1 wget linkedNodes(L), WID1 wset linkedNodes([WID2|L]).
155
156add_graph(GID, Context) :-
157 recorded(cge_context, Context-_/_/Viewer+_Editor, _),
158 ( Viewer = none
159 -> display_ref(GID, Context, [], 0, _)
160 ; display_graph(GID, Viewer, [], 0, _)
161 ).
162
163change_type(Name, WID) :-
164 recorded(cge_concept, WID-Type/_+_, _),
165 recorded(cge_type, Type-_/Label/_+_, _),
166 Label wset label(Name).
167
168change_ref(Ref, WID) :-
169 recorded(cge_concept, WID-_/none+_, _),
170 display_ref(Ref, WID, [], 0, _).
171change_ref(Ref, WID) :-
172 recorded(cge_concept, WID-Type/OldRef+Editor, DbRef),
173 OldRef wproc destroy, erase(DbRef),
174 recorda(cge_concept, WID-Type/none+Editor, _),
175 display_ref(Ref, WID, [], 0, _).
176
177cge_move(Node) :-
178 Node wproc [drag(X, Y, false, true), move(X, Y)], % stay inside parent
179 Node wset [horizPos(X), vertPos(Y)].
180
181toggle_mode(Mode) :-
182 Mode wget label('Auto'),
183 recorded(cg_editor, Editor-_-Graph-_-Mode/_/_, _),
184 ( cge_selected(prim, Editor, viewer, multiple, WIDs)
185 ; WIDs = Graph
186 ),
187 WIDs wset layoutMode(manual), update_layout_param(Editor).
188toggle_mode(Mode) :-
189 Mode wget label('Manual'),
190 recorded(cg_editor, Editor-_-Graph-_-Mode/_/_, _),
191 ( cge_selected(prim, Editor, viewer, multiple, WIDs)
192 ; WIDs = Graph
193 ),
194 WIDs wset layoutMode(automatic), update_layout_param(Editor).
195
196toggle_shadow(Entry, Editor) :-
197 recorded(cge_shadow, Editor-Shadow, _), Entry wget label(L),
198 ( L = 'Show Miniature'
199 -> Shadow wproc map, Entry wset label('Hide Miniature')
200 ; Shadow wproc unmap, Entry wset label('Show Miniature')
201 ).
202
203cge_style(_Editor, Toggle, _Style) :-
204 Toggle wget state(false).
205cge_style(Editor, _Toggle, Style) :-
206 cge_style(Editor, Style).
207
208cge_style(Editor, Style) :-
209 ( cge_selected(prim, Editor, viewer, multiple, Selection)
210 ; recorded(cg_editor, Editor-_-Graph-_-_, _), Selection = Graph
211 ),
212 Selection wset layoutStyle(Style).
213
214cge_layout(Editor, Layout) :-
215 ( cge_selected(prim, Editor, viewer, multiple, Selection)
216 ; recorded(cg_editor, Editor-_-Graph-_-_, _), Selection = Graph
217 ),
218 Selection wset graphLayout(Layout).
219
220update_layout_param(Editor) :-
221 recorded(cg_editor, Editor-_-Graph-_-Mode/Function/Style, _),
222 ( cge_selected(prim, Editor, viewer, multiple, Selection)
223 ; Selection = [Graph]
224 ),
225 update_layout_mode(Mode, Selection),
226 ( Mode wget label('Auto') -> Sensitive = true ; Sensitive = false ),
227 Function wset sensitive(Sensitive),
228 update_layout_function(Function, Selection),
229 Style wset sensitive(Sensitive),
230 update_layout_style(Style, Selection).
231
232update_layout_mode(Mode, Graphs) :-
233 Graphs wgetl layoutMode(L), delete_dup(L, LayoutMode),
234 ( LayoutMode = [automatic], Mode wset [set(true), label('Auto')]
235 ; LayoutMode = [manual], Mode wset [set(true), label('Manual')]
236 ; Graphs = [LastSelected|_], LastSelected wget layoutMode(LastMode),
237 LastMode = automatic -> Mode wset [set(false), label('Auto')]
238 ; Mode wset [set(false), label('Manual')]
239 ).
240
241update_layout_function([Hier, Spring, Tree], Graphs) :-
242 [Hier, Spring, Tree] wset set(false),
243 Graphs wgetl graphLayout(F), delete_dup(F, Function),
244 ( Function = [hierarchical], Hier wset set(true)
245 ; Function = [spring], Spring wset set(true)
246 ; Function = [tree], Tree wset set(true)
247 ; true % multiple functions
248 ).
249
250update_layout_style([LR, RL, TD, BU], Graphs) :-
251 [LR, RL, TD, BU] wset state(false),
252 Graphs wgetl layoutStyle(S), delete_dup(S, Style),
253 ( Style = [left_right], LR wset state(true)
254 ; Style = [right_left], RL wset state(true)
255 ; Style = [top_down], TD wset state(true)
256 ; Style = [bottom_up], BU wset state(true)
257 ; true % multiple styles
258 ).
259
260replace_text(WID, Text) <->
261 WID wproc [get_last_pos(LP), replace(0, LP, Text)],
262 WID wset insertPosition(0)
263 <= atomic(Text).
264replace_text(WID, Text) <->
265 WID wproc [get_last_pos(LP), replace(0, LP, ''), stream(OS)],
266 current_output(COS), set_output(OS),
267 write_linear(0, Text, []), flush_output(OS),
268 set_output(COS), close(OS), WID wset insertPosition(0)
269 <= is_list(Text).
270replace_text(WID, Goal) <->
271 WID wproc [get_last_pos(LP), replace(0, LP, ''), stream(OS)],
272 current_output(COS), set_output(OS),
273 ( Goal ; true ), flush_output(OS),
274 set_output(COS), close(OS), WID wset insertPosition(0).
275
281
282toggle_sel(Sel, Kind, WID, Graph, Editor) :-
283 is_selected(Sel, WID),
284 unselect(Sel, Kind, WID, Graph, Editor),
285 ( Sel = prim -> update_viewer_sel(Graph, Editor) ; true ), !.
286toggle_sel(Sel, Kind, WID, Graph, Editor) :-
287 ( Sel = prim -> OtherSel = sec ; OtherSel = prim ),
288 unselect(OtherSel, Kind, WID, Graph, Editor),
289 select(Sel, Kind, WID, Graph, Editor),
290 ( Sel = prim -> update_viewer_sel(Graph, Editor) ; true ), !.
291
292is_selected(prim, WID) :-
293 recorded(cge_selection, _/_-_/WID, _), !.
294is_selected(sec, WID) :-
295 recorded(cge_sec_sel, _/_-_/WID, _), !.
296
297unselect(prim, Kind, WID, Graph, Editor) :-
298 recorded(cge_selection, Graph/Editor-Kind/WID, Ref),
299 erase(Ref), cge_turn_sel(prim, off, Kind, WID).
300unselect(sec, Kind, WID, Graph, Editor) :-
301 recorded(cge_sec_sel, Graph/Editor-Kind/WID, Ref),
302 erase(Ref), cge_turn_sel(sec, off, Kind, WID).
303unselect(_, _, _, _, _).
304
305select(prim, Kind, WID, Graph, Editor) :-
306 recorda(cge_selection, Graph/Editor-Kind/WID, _),
307 cge_turn_sel(prim, on, Kind, WID), !.
308select(sec, Kind, WID, Graph, Editor) :-
309 recorda(cge_sec_sel, Graph/Editor-Kind/WID, _),
310 cge_turn_sel(sec, on, Kind, WID), !.
311
312cge_turn_sel(prim, on, relation, _).
313cge_turn_sel(prim, on, _, WID) :- % concepts and contexts
314 WID wproc unmanage, WID wset borderWidth(2), WID wproc manage.
315cge_turn_sel(sec, on, _, WID) :- % same for all nodes
316 WID wproc unmanage, WID wset [borderWidth(2), borderColor(lightGray)],
317 WID wproc manage.
318
319cge_turn_sel(prim, off, relation, _).
320cge_turn_sel(prim, off, _, WID) :- % concepts and contexts
321 WID wproc unmanage, WID wset borderWidth(1), WID wproc manage.
322cge_turn_sel(sec, off, _, WID) :- % same for all nodes
323 WID wproc unmanage, WID wset [borderWidth(1), borderColor(black)],
324 WID wproc manage.
325
326update_viewer_sel(Viewer, Editor) :-
327 recorded(cge_selection, Viewer/Editor, _),
328 recorded(cge_selection, Viewer/Editor-_/_, _).
329update_viewer_sel(Viewer, Editor) :-
330 recorded(cge_selection, Viewer/Editor, Ref),
331 erase(Ref), update_layout_param(Editor).
332update_viewer_sel(Viewer, Editor) :-
333 recorded(cge_selection, Viewer/Editor-_/_, _),
334 recorda(cge_selection, Viewer/Editor, _),
335 update_layout_param(Editor).
336update_viewer_sel(_, _).
337
341
342cge_selected(Kind, Editor, Set, Card, Selection) :-
343 ( Kind = prim -> Key = cge_selection ; Key = cge_sec_sel ),
344 cge_selected(Key, Editor, Set, Selection), !,
345 ( Card = multiple -> Selection \= [] ; Selection = [_] ).
346
347cge_selected(Key, Editor, graph, Selection) :-
348 findall(GID,
349 ( recorded(Key, _/Editor-_/WID, _),
350 cge_which_obj(WID, _, GID, _)
351 ),
352 Tmp),
353 delete_dup(Tmp, Selection).
354cge_selected(Key, Editor, viewer, Selection) :-
355 findall(WID, recorded(Key, WID/Editor, _), Selection).
356cge_selected(Key, Editor, all, Selection) :-
357 findall(WID, recorded(Key, _/Editor-_/WID, _), Selection).
358cge_selected(Key, Editor, only-Kind, _) :-
359 recorded(Key, _/Editor-Other/_, _), Other \= Kind, !, fail.
360cge_selected(Key, Editor, only-Kind, Selection) :-
361 cge_selected(Key, Editor, Kind, Selection).
362cge_selected(Key, Editor, Kind, Selection) :-
363 findall(WID, recorded(Key, _/Editor-Kind/WID, _), Selection).
364
365unselect_all(Editor) :-
366 recorded(cge_selection, Viewer/Editor-Kind/WID, _),
367 toggle_sel(prim, Kind, WID, Viewer, Editor), fail.
368unselect_all(Editor) :-
369 recorded(cge_sec_sel, Viewer/Editor-Kind/WID, _),
370 toggle_sel(sec, Kind, WID, Viewer, Editor), fail.
371unselect_all(_).
372
378
379cge_open_db(_) :-
380 current_editors(Editors), apply(cge_clear_editor(_), Editors),
381 ( recorded(get_db_modif, true, _)
382 -> confirm('Save changes to current database?', Choice),
383 ( Choice = yes -> current_db(Canon), save_db(Canon),
384 all_modified(false)
385 ; true
386 )
387 ; true
388 ),
389 ask('Name of database:', Db), name(Canon, Db), !,
390 ( Canon = '' ; load_db(Canon), all_modified(false) ; true ).
391
392current_editors(Editors) :-
393 findall(Ed, recorded(cg_editor, Ed-_-_-_-_, _), Editors).
394
395cge_save_db(_) <->
396 current_db(Default),
397 ask('Name of database:', Db, Default), name(Canon, Db),
398 save_db(Canon), all_modified(false).
399
400all_modified(Modified) :-
401 ( Modified -> Action = map ; Action = unmap ),
402 recorded(cg_editor, Editor-_-_-_-_, _),
403 recorded(cge_modif, Editor-ModWID, _),
404 ModWID wproc Action, fail.
405all_modified(Modified) :-
406 recorded(get_db_modif, Yes, Ref),
407 ( Yes = Modified ; erase(Ref), recorda(get_db_modif, Modified, _) ).
408all_modified(Modified) :-
409 recorda(get_db_modif, Modified, _).
410
411cge_clear_editor(Editor) <->
412 recorded(cg_editor, Editor-_-Viewer-_-_, _),
413 Viewer wproc unmap, clear_graph(GIDs), Viewer wproc map,
414 apply(erasure(_), GIDs),
415 update_layout_param(Editor), update_linear(Editor)
416 <= cge_selected(prim, Editor, graph, multiple, GIDs), !,
417 recorded(cge_num, Editor-Number, _),
418 confirm(['Do you really want to delete the selected graph(s) ',
419 'in editor #', Number, '?']).
420cge_clear_editor(Editor) <->
421 recorded(cg_editor, Editor-Header-Viewer-Linear-_, _),
422 Viewer wproc unmap, clear_graph(TopGraphs), Viewer wproc map,
423 replace_text(Header, ''), replace_text(Linear, ''),
424 update_layout_param(Editor), delete_obj(TopGraphs)
425 <= top_graphs(Editor, TopGraphs), TopGraphs \= [], !,
426 recorded(cge_num, Editor-Number, _),
427 confirm(['Do you really want to delete the displayed graph(s) ',
428 'in editor #', Number, '?']).
429cge_clear_editor(_) <-> true.
430
431cge_help :- acknowledge('Sorry...').
432
433cge_quit(Editor) <->
434 cge_clear_editor(Editor),
435 ( recorded(get_db_modif, Modified, _) ; Modified = false ),
436 ( Modified
437 -> confirm('Save changes to current database?', Choice),
438 ( Choice = yes -> current_db(Canon), save_db(Canon),
439 all_modified(false)
440 ; true
441 )
442 ; true
443 ),
444 Editor wproc destroy.
445
446cge_save_gr(Editor) <->
447 recorded(cg_editor, Editor-_-Viewer-Linear-_, _),
448 Linear wproc [get_last_pos(LP), get(0, LP, Text)],
449 tokenise(Tokens, Text, []), mark, rec_linear(Kind, Obj, Tokens, ['.']),
450 unmark, cge_describe(Kind, Obj),
451 top_graphs(Editor, Top), Viewer wproc unmap,
452 clear_graph(Top), delete_obj(Top),
453 gen_graphical(Kind, Obj, Editor), Viewer wproc map, all_modified(true).
454
455cge_describe(Kind, Obj) <->
456 ( retract( description(Kind, Obj, Default) ) ; Default = '' ),
457 ask('Description:', Desc, Default), name(Description, Desc),
458 ( Description = '' ; assert( description(Kind, Obj, Description) ) ).
459
460cge_load(Editor) :-
461 choice('Load from:', [canonical, definition, description, linear], F),
462 ( F = linear, !, cge_load_linear(Editor)
463 ; calc_from(F, Items, Info),
464 shell widget graphLoader(Loader, List, Items),
465 ( F = description -> C = 1 ; C = 2 ),
466 List wset defaultColumns(C),
467 repeat, next_event(List-Command),
468 load_action(Info, Editor, List, Command, Goal),
469 Loader wproc destroy, !, Goal
470 ).
471
472calc_from(canonical, Items, Info) :-
473 calc_items([rel, con], can, [], Items, [], Info).
474calc_from(definition, Items, Info) :-
475 calc_items([rel, con], def, [], Items, [], Info).
476calc_from(description, Items, Info) :-
477 calc_items(gra, _, [], Items, [], Info).
478
479load_action(_, _, _, cancel, fail).
480load_action(Info, Editor, List, ok, true) :-
481 List wproc show_current(_:I),
482 succ(I, Index), % because it starts with 0
483 nth_member(Kind/Obj, Info, Index), gen_graphical(Kind, Obj, Editor).
484
485calc_items([H|T], K, InItems, OutItems, InInfo, OutInfo) :-
486 calc_items(H, K, InItems, TmpItems, InInfo, TmpInfo),
487 calc_items(T, K, TmpItems, OutItems, TmpInfo, OutInfo).
488calc_items([], _, InItems, InItems, InInfo, InInfo).
489calc_items(rel, can, InItems, OutItems, InInfo, OutInfo) :-
490 findall(Label/Args+can_graph/Type,
491 ( relation_type(Type, Label, _, Can, Args), Can \= none ),
492 RelCans),
493 split_info(RelCans, Items, Info),
494 conc(InItems, Items, OutItems), conc(InInfo, Info, OutInfo).
495calc_items(con, can, InItems, OutItems, InInfo, OutInfo) :-
496 findall(Label+can_graph/Type,
497 ( concept_type(Type, Label, _, Can, _), Can \= none ),
498 ConCans),
499 split_info(ConCans, Items, Info),
500 conc(InItems, Items, OutItems), conc(InInfo, Info, OutInfo).
501calc_items(rel, def, InItems, OutItems, InInfo, OutInfo) :-
502 findall(Label/Args+rel_def/Type,
503 ( relation_type(Type, Label, Def, _, Args), Def \= none ),
504 RelDefs),
505 split_info(RelDefs, Items, Info),
506 conc(InItems, Items, OutItems), conc(InInfo, Info, OutInfo).
507calc_items(con, def, InItems, OutItems, InInfo, OutInfo) :-
508 findall(Label+type_def/Type,
509 ( concept_type(Type, Label, Def, _, _), Def \= none ),
510 ConDefs),
511 split_info(ConDefs, Items, Info),
512 conc(InItems, Items, OutItems), conc(InInfo, Info, OutInfo).
513calc_items(con, sch, InItems, OutItems, InInfo, OutInfo) :-
514 findall(Desc+schema/Schema,
515 ( 516 description(schema, Schema, Desc) ),
517 ConSchemas),
518 split_info(ConSchemas, Items, Info),
519 conc(InItems, Items, OutItems), conc(InInfo, Info, OutInfo).
520calc_items(gra, _, InItems, OutItems, InInfo, OutInfo) :-
521 findall(Desc+graph/Graph,
522 description(graph, Graph, Desc),
523 Graphs),
524 split_info(Graphs, Items, Info),
525 conc(InItems, Items, OutItems), conc(InInfo, Info, OutInfo).
526
527split_info([], [], []).
528split_info([A+B|T], [A|T1], [B|T2]) :- split_info(T, T1, T2).
529
530cge_load_linear(Editor) :-
531 recorded(cg_editor, Editor-_-_-Linear-_, _),
532 Linear wproc [get_last_pos(LP), get(0, LP, Text)],
533 tokenise(Tokens, Text, []), mark, rec_linear(Kind, Obj, Tokens, ['.']),
534 unmark, gen_graphical(Kind, Obj, Editor).
535
536top_graphs(Editor, Graphs) :-
537 recorded(cg_editor, Editor-_-Viewer-_-_, _),
538 findall(GID, recorded(corresponds, GID-Viewer, _), Graphs).
539
540update_linear(Editor) :-
541 top_graphs(Editor, Graphs),
542 recorded(cg_editor, Editor-Header-_-Linear-_, _),
543 replace_text(Linear, write_linear(graph, Graphs)),
544 replace_text(Header, graph).
545
546cge_which_obj(WID, K/Id, GID, Viewer) :-
547 recorded(corresponds, K/Id-WID, _), WID wproc parent(Viewer),
548 recorded(corresponds, Graph-Viewer, _), which_graph(K/Id, [Graph], GID).
549cge_which_obj(WID, Rel, Graph, Viewer) :-
550 recorded(corresponds, Rel-WID, _), WID wproc parent(Viewer),
551 recorded(corresponds, Graph-Viewer, _), g(Graph, CL, RL),
552 dir_reference(CL, RL), member(Rel, RL).
553
559
560cge_restrict_type(WID) :-
561 recorded(corresponds, CID-WID, _), type(CID, Type),
562 findall(Label,
563 ( proper_supertype(Type, T), concept_type(T, Label, _, _, _) ),
564 DupNames),
565 delete_dup(DupNames, Names),
566 delete_one('ABSURD', Names, SubtypeNames), !,
567 ( SubtypeNames = [],
568 acknowledge('The chosen concept type has no subtype!'), !, fail
569 ; true
570 ),
571 choice('Subtypes:', SubtypeNames, Chosen),
572 concept_type(Subtype, Chosen, _, _, _), referent(CID, Ref),
573 ( conform(Subtype, Ref)
574 -> restrict(CID, Subtype, Ref), change_type(Chosen, WID)
575 ; acknowledge('Type and referent don''t conform!')
576 ).
577
578cge_restrict_ref(WID) :-
579 recorded(corresponds, CID-WID, _), referent(CID, '*'), type(CID, Type),
580 ask('New referent:', Chars), tokenise(Tokens, Chars, []),
581 ( referent(NewRef, Tokens, [])
582 -> ( conform(Type, NewRef)
583 -> restrict(CID, Type, NewRef),
584 change_ref(NewRef, WID)
585 ; acknowledge('Type and referent don''t conform!')
586 )
587 ; acknowledge('Invalid referent!')
588 ).
589cge_restrict_ref(_) :-
590 acknowledge('Referent must be generic!').
591
592cge_max_exp(WID) :-
593 cge_which_obj(WID, CID, GID, Viewer),
594 clear_graph(GID),
595 max_type_expansion(CID, GID, GIDs),
596 display_graph(GIDs, Viewer, [], 0, _).
597
598cge_min_exp(WID) :-
599 cge_which_obj(WID, CID, GID, Viewer),
600 clear_graph(GID),
601 min_type_expansion(CID, GID, GIDs),
602 display_graph(GIDs, Viewer, [], 0, _).
603
604cge_rel_exp(WID) :-
605 cge_which_obj(WID, Rel, GID, Viewer),
606 clear_graph(GID),
607 rel_expansion(Rel, GID, GIDs),
608 display_graph(GIDs, Viewer, [], 0, _).
609
610cge_meas_exp(WID) :-
611 cge_which_obj(WID, CID, GID, Viewer),
612 referent(CID, Ref), basic_ref(Ref, meas(_)),
613 clear_graph(GID), meas_expansion(CID, GID),
614 display_graph(GID, Viewer, [], 0, _).
615cge_meas_exp(_) :-
616 acknowledge('Referent does not denote a measure!').
617
618cge_meas_ctr(WID) :-
619 cge_which_obj(WID, meas(X, Y), GID, Viewer),
620 clear_graph(GID),
621 ( meas_contraction(meas(X, Y), GID)
622 ; acknowledge('Measure contraction failed!')
623 ),
624 display_graph(GID, Viewer, [], 0, _).
625cge_meas_ctr(_) :-
626 acknowledge('Relation is not MEAS/2!').
627
628cge_name_exp(WID) :-
629 cge_which_obj(WID, CID, GID, Viewer),
630 referent(CID, Ref), basic_ref(Ref, name(_)),
631 clear_graph(GID), name_expansion(CID, GID),
632 display_graph(GID, Viewer, [], 0, _).
633cge_name_exp(_) :-
634 acknowledge('Referent does not denote a name!').
635
636cge_name_ctr(WID) :-
637 cge_which_obj(WID, name(X, Y), GID, Viewer),
638 clear_graph(GID),
639 ( name_contraction(name(X, Y), GID)
640 ; acknowledge('Name contraction failed!')
641 ),
642 display_graph(GID, Viewer, [], 0, _).
643cge_name_ctr(_) :-
644 acknowledge('Relation is not NAME/2!').
645
646cge_qty_exp(WID) :-
647 cge_which_obj(WID, CID, GID, Viewer),
648 referent(CID, Ref), basic_ref(Ref, set(_, _, Card)), nonvar(Card),
649 clear_graph(GID), qty_expansion(CID, GID),
650 display_graph(GID, Viewer, [], 0, _).
651cge_qty_exp(_) :-
652 acknowledge('Referent is not a set or has not a number!').
653
654cge_qty_ctr(WID) :-
655 cge_which_obj(WID, qty(X, Y), GID, Viewer),
656 clear_graph(GID),
657 ( qty_contraction(qty(X, Y), GID)
658 ; acknowledge('Quantity contraction failed!')
659 ),
660 display_graph(GID, Viewer, [], 0, _).
661cge_qty_ctr(_) :-
662 acknowledge('Relation is not QTY/2!').
663
664cge_univ_exp(WID) :-
665 cge_which_obj(WID, CID, GID, Viewer),
666 referent(CID, Ref), basic_ref(Ref, every),
667 clear_graph(GID),
668 del_univ_quant(CID, GID, _NewCID, _NewGID, NewGraph),
669 display_graph(NewGraph, Viewer, [], 0, _).
670cge_univ_exp(_) :-
671 acknowledge('Referent is not universally quantified!').
672
678
679cge_compare(GID) :-
680 which_viewer(GID, Viewer), recorded(cge_graph, Viewer-_+Editor, _),
681 check_selection(sec, Editor, graph, single, [GID2]),
682 ( is_copy(GID, GID2)
683 -> Msg = 'a copy of '
684 ; ( is_generalization(GID, GID2)
685 -> Msg = 'a generalization of '
686 ; ( is_specialization(GID, GID2)
687 -> Msg = 'a specialization of '
688 ; Msg = 'not related to '
689 )
690 )
691 ),
692 acknowledge(['First graph is ', Msg, 'the second graph.']).
693
694cge_depth(GID) :-
695 depth(GID, Depth),
696 acknowledge(['Depth of selected graph is ', Depth, '!']).
697
698cge_copy(GID) :-
699 which_viewer(GID, Viewer), which_context(GID, Env),
700 iteration(GID, Env, NewGID),
display_graph(NewGID, Viewer, [], 0, _).
704
705cge_join_on([WID1, WID2]) :-
706 cge_which_obj(WID1, CID1, GID1, Viewer),
707 cge_which_obj(WID2, CID2, GID2, Viewer),
708 ( join_concept(CID1, CID2),
709 clear_graph([GID1, GID2]), join_on(GID1, GID2, [CID1-X], [CID2-X]),
710 711 display_graph(GID1, Viewer, [], 0, _)
712 ; acknowledge('Concepts do not match!')
713 ).
714cge_join_on([_, _]) :-
715 acknowledge('Selected concepts must be in the same context!').
716cge_join_on(_) :-
717 acknowledge('Exactly two concepts must be selected!').
718
719cge_join([GID1, GID2]) :-
720 same_context([GID1, GID2], _), which_viewer(GID1, Viewer),
721 clear_graph([GID1, GID2]),
722 ( join_graph(GID1, GID2, NewGID) ; acknowledge('Join failed!') ),
723 display_graph(NewGID, Viewer, [], 0, _).
724cge_join([_, _]) :-
725 acknowledge('Selected graphs must be in the same context!').
726cge_join(_) :-
727 acknowledge('Exactly two graphs must be selected!').
728
729cge_max_join([GID1, GID2]) :-
730 same_context([GID1, GID2], _), which_viewer(GID1, Viewer),
731 clear_graph([GID1, GID2]),
732 ( max_join(GID1, GID2, NewGID) ; acknowledge('Maximal join failed!') ),
733 display_graph(NewGID, Viewer, [], 0, _).
734cge_max_join([_, _]) :-
735 acknowledge('Selected graphs must be in the same context!').
736cge_max_join(_) :-
737 acknowledge('Exactly two graphs must be selected!').
738
739cge_simplify(GID) :-
740 which_viewer(GID, Viewer), clear_graph(GID),
741 simplify(GID), display_graph(GID, Viewer, [], 0, _).
742
743cge_erasure(GID) :-
744 evenly_enclosed(GID), clear_graph(GID), erasure(GID).
745cge_erasure(_) :-
746 acknowledge('Selected graph must be evenly enclosed!').
747
748cge_insertion(GID) :-
749 which_viewer(GID, Viewer), recorded(cge_graph, Viewer-_+Editor, _),
750 check_selection(sec, Editor, context, single, [Context]),
751 recorded(corresponds, Env-Context, _),
752 ( oddly_enclosed(Env),
753 copy_graph(GID, Copy, outer), insertion(Copy, Env),
754 add_graph(Copy, Context)
755 ; acknowledge('Context is not oddly enclosed!')
756 ).
757
758cge_iteration(GID) :-
759 which_viewer(GID, Viewer), recorded(cge_graph, Viewer-_+Editor, _),
760 check_selection(sec, Editor, context, single, [Context]),
761 recorded(corresponds, Env-Context, _),
762 ( check_iteration(GID, Env), iteration(GID, Env, Copy),
763 add_graph(Copy, Context)
764 ; acknowledge('Context is not dominated by the selected graph!')
765 ).
766
767cge_deiteration(GID) :-
768 check_deiteration(GID, _, _), which_viewer(GID, Viewer),
769 clear_graph(GID), update_viewer(Viewer), deiteration(GID).
770cge_deiteration(_) :-
771 acknowledge('Selected graph has not a copy in a dominating context!').
772
773%:- style_check(-singleton).
774
775cge_draw_dn(Editor) :-
776 cge_selected(prim, Editor, graph, multiple, GIDs),
777 same_context(GIDs, Env), which_viewer(GIDs, Viewer),
778 recorded(cg_editor, Editor-_-TopViewer-_-_, _),
779 TopViewer wproc unmap, clear_graph(GIDs),
780 double_negation(GIDs, Env, NewGraph),
781 display_graph(NewGraph, Viewer, [], 0, _),
782 unselect_all(Editor), TopViewer wproc map, update_linear(Editor).
783cge_draw_dn(Editor) :-
784 cge_selected(prim, Editor, graph, multiple, _),
785 acknowledge('Selected graphs must be in the same context!').
786cge_draw_dn(Editor) :-
787 cge_selected(sec, Editor, only-context, single, [Context]),
788 cge_which_obj(Context, Env, _, _Viewer),
789 double_negation([], Env, NewGraph),
790 recorded(cg_editor, Editor-_-TopViewer-_-_, _),
791 TopViewer wproc unmap,
792 add_graph(NewGraph, Context),
793 unselect_all(Editor), TopViewer wproc map, update_linear(Editor).
794cge_draw_dn(Editor) :-
795 recorded(cg_editor, Editor-_-TopViewer-_-_, _),
796 double_negation([], outer, Graph),
797 TopViewer wproc unmap,
798 display_graph(Graph, TopViewer, [], 0, _),
799 TopViewer wproc map, update_linear(Editor).
800
801cge_erase_dn(GID) :-
802 is_double_neg(GID), which_context(GID, Env), which_viewer(GID, Viewer),
803 clear_graph(GID), double_negation(GID, Env, NewGraphs),
804 display_graph(NewGraphs, Viewer, [], 0, _), update_viewer(Viewer).
805cge_erase_dn(_) :-
806 acknowledge('Selected graph must be a double negation!').
807
808which_viewer([GID|_], Viewer) :-
809 which_viewer(GID, Viewer).
810which_viewer(GID, Viewer) :-
811 recorded(corresponds, GID-Viewer, _).
812
813top_viewer(g/Id, TopViewer) :-
814 recorded(corresponds, g/Id-Viewer, _),
815 top_viewer(Viewer, TopViewer), !.
816top_viewer(Viewer, TopViewer) :-
817 recorded(cge_graph, Viewer-_+Editor, _),
818 recorded(cg_editor, Editor-_-TopViewer-_-_, _), !.
819top_viewer(WID, TopViewer) :-
820 WID wproc parent(Viewer),
821 top_viewer(Viewer, TopViewer), !.
822
823cge_destroy(Editor) :-
824 recorded(cg_editor, Editor-_-_-_-_, Ref1), erase(Ref1),
825 recorded(cge_shadow, Editor-_, Ref2), erase(Ref2),
826 recorded(cge_modif, Editor-_, Ref3), erase(Ref3)
830
831clear_graph([]).
832clear_graph([GID|List]) :-
833 clear_graph(GID), clear_graph(List).
834clear_graph(GID) :-
835 g(GID, CL, RL), dir_reference(CL, RL),
836 recorded(corresponds, GID-Viewer, Ref), erase(Ref),
837 apply(clear_concept(_), CL), apply(clear_relation(_), RL).
838 839clear_graph(_).
840
841clear_relation(Rel) :-
842 recorded(corresponds, Rel-WID, Ref1), erase(Ref1),
843 recorded(cge_relation, WID-_+_, Ref2), erase(Ref2),
844 ( recorded(cge_selection, _-_/WID, Ref3) -> erase(Ref3) ; true ),
845 WID wproc destroy.
846
847clear_concept(c/Id-_) :-
848 recorded(corresponds, c/Id-WID, Ref1), erase(Ref1),
849 recorded(cge_concept, WID-Type/_+_, Ref2), erase(Ref2),
850 ( recorded(cge_selection, _-_/WID, Ref3) -> erase(Ref3) ; true ),
851 clear_type(Type), WID wproc destroy.
852clear_concept(p/Id-_) :-
853 recorded(corresponds, p/Id-WID, Ref1), erase(Ref1),
854 recorded(cge_context, WID-Type/_/Viewer+_, Ref2), erase(Ref2),
855 ( recorded(cge_selection, _-_/WID, Ref3) -> erase(Ref3) ; true ),
856 clear_type(Type), clear_viewer(Viewer), WID wproc destroy.
857
858clear_type(Type) :- 859 recorded(cge_type, Type-_/_/Viewer+_, Ref), erase(Ref),
860 clear_viewer(Viewer).
861clear_type(_).
862
863clear_viewer(Viewer) :- 864 recorded(cge_graph, Viewer-_+_, Ref), erase(Ref),
865 findall(GID, recorded(corresponds, GID-Viewer, _), GIDs),
866 clear_graph(GIDs).
867clear_viewer(_).
868
869update_viewer(Viewer) :-
870 recorded(cg_editor, _-_-Viewer-_-_, _), !.
871update_viewer(Viewer) :-
872 Viewer wproc children([]), clear_viewer(Viewer), Viewer wproc destroy.
873update_viewer(_).
874
875cge_action(Apply, Action, Editor, Set, Card) :-
876 check_selection(prim, Editor, Set, Card, Selection),
877 % cursor wait
878 recorded(cg_editor, Editor-_-Viewer-_Linear-_, _), Viewer wproc unmap,
879 ( Apply = indiv -> Goal =.. [Action, _], (apply(Goal, Selection) ; true)
880 ; Goal =.. [Action, Selection], ( call(Goal) ; true )
881 ),
882 unselect_all(Editor), Viewer wproc map,
883 update_linear(Editor).
884
885check_selection(Kind, Editor, Set, Card, Selection) :-
886 cge_selected(Kind, Editor, Set, Card, Selection), !.
887check_selection(Kind, _, Set, Card, _) :-
888 ( Kind = prim -> Sel = 'Primary ' ; Sel = 'Secondary ' ),
889 ( Set = only-Obj -> Exclusive = 'only ' ; Set = Obj, Exclusive = '' ),
890 ( Card = single -> Number = 'exactly ' ; Number = 'at least '),
891 acknowledge([Sel, 'selection must consist ', Exclusive, 'of ', Number,
892 'one ', Obj, '!']),
893 !, fail.
894
895cge_clear_db :-
896 recorded(cge_selection, _, R), erase(R), fail.
897cge_clear_db :-
898 recorded(cge_sec_sel, _, R), erase(R), fail.
899cge_clear_db :-
900 recorded(cge_concept, _, R), erase(R), fail.
901cge_clear_db :-
902 recorded(cge_context, _, R), erase(R), fail.
903cge_clear_db :-
904 recorded(cge_relation, _, R), erase(R), fail.
905cge_clear_db :-
906 recorded(corresponds, _, R), erase(R), fail.
907
908% used by sem_int.pl
909cge_replace(Editor, Kind, Obj) <->
910 recorded(cg_editor, Editor-Header-Viewer-Linear-_, _),
911 Viewer wproc unmap,
912 top_graphs(Editor, TopGraphs), clear_graph(TopGraphs),
913 replace_text(Header, ''), replace_text(Linear, ''),
914 update_layout_param(Editor), gen_graphical(Kind, Obj, Editor),
915 Viewer wproc map.
916
917:- set_prolog_flag(swi_apeal,false).