1%
2% Author:      William Chia-Wei Cheng (bill.cheng@acm.org)
3%
4% Copyright (C) 2001-2009, William Chia-Wei Cheng.
5%
6% This file may be distributed under the terms of the Q Public License
7% as defined by Trolltech AS of Norway and appearing in the file
8% LICENSE.QPL included in the packaging of this file.
9%
10% THIS FILE IS PROVIDED AS IS WITH NO WARRANTY OF ANY KIND, INCLUDING
11% THE WARRANTY OF DESIGN, MERCHANTABILITY AND FITNESS FOR A PARTICULAR
12% PURPOSE.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL,
13% INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
14% FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
15% NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
16% WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17%
18% @(#)$Header: /mm2/home/cvs/bc-src/tgif/testdrive.pl,v 1.6 2011/05/16 16:26:57 william Exp $
19%
20
21% ?- compile(testdrive).
22% ?- tgif.
23%
24% This is an example of a Prolog driver, which list the IDs of the
25% objects in the current drawing (attributes are skipped).  The code
26% might be buggy, it is there to give some hints of how 'tgif.pl' can
27% be used.
28%
29% In order to use it, don't forget to uncomment the stuff related to
30% 'frontend11.o' in either the 'Imakefile' or the 'Makefile.noimake'.
31% It also expects 'tgif.pl' and 'frontend.pl' to be in the same directory
32% as itself.
33
34:- ensure_loaded(frontend).
35:- ensure_loaded(tgif).
36
37tgif :- interface(init,'',Cmd,Domain,File,_,_,_,_), tgif(Cmd,Domain,File).
38
39tgif(InitFile) :-
40	interface(init,InitFile,Cmd,Domain,File,_,_,_,_), tgif(Cmd,Domain,File).
41
42tgif('Solve',_Domain,File) :-
43	process_file(File),
44	interface('','',NewCmd,NewDomain,NewFile,_,_,_,_),
45	!, tgif(NewCmd,NewDomain,NewFile).
46tgif('Quit',_Domain,_File) :- interface(quit,'',_,_,_,_,_,_,_), !.
47
48% --------------------------------------------------------------------- %
49
50process_file(File) :-
51	tgif_real_clean,
52	my_consult(File),
53	tgif_state(_,_),
54	write('=============='), nl,
55	write('Listing IDs...'), nl,
56	write('=============='), nl,
57	( tgif_obj(Obj), print_id(Obj,0), fail ; ! ).
58
59% --------------------------------------------------------------------- %
60
61print_id(Obj,Level) :-
62	print_level(Level), NextLevel is Level+1,
63	get_id(Obj,Id),
64	functor(Obj,Name,_Arity),
65	write(Name), write(': '), write(Id), nl, !,
66	(	( Name==group | Name==sym | Name==icon ) ->
67		atom_chars(Name,NameStr), catlist(["tgif_",NameStr],FunctorStr),
68		atom_chars(Functor,FunctorStr), Goal =.. [Functor,Obj,Parms],
69		call(Goal), memberchk(=(objs,Objs),Parms),
70		( member(SubObj,Objs), print_id(SubObj,NextLevel), fail ; true )
71	;	true
72	),
73	!, get_attrs(Obj,Attrs),
74	(	Attrs \== [] ->
75		print_level(NextLevel), write('attrs:'), nl,
76		AttrLevel is NextLevel+1,
77		!, print_attr_id(Attrs,AttrLevel)
78	;	true
79	).
80
81print_attr_id([],_AttrLevel) :- !.
82print_attr_id([Attr|Attrs],AttrLevel) :-
83	tgif_attr(Attr,AttrParms),
84	memberchk(=(text_obj,TextObj),AttrParms),
85	print_id(TextObj,AttrLevel),
86	!, print_attr_id(Attrs,AttrLevel).
87
88print_level(0) :- !.
89print_level(N) :- write('   '), N1 is N-1, !, print_level(N1).
90
91get_id(Obj,Id) :-
92	functor(Obj,Name,_Arity),
93	atom_chars(Name,NameStr), catlist(["tgif_",NameStr],FunctorStr),
94	atom_chars(Functor,FunctorStr), Goal =.. [Functor,Obj,Parms],
95	call(Goal),
96	memberchk(=(id,Id),Parms), !.
97get_id(_Obj,none).
98
99get_attrs(Obj,Attrs) :-
100	functor(Obj,Name,_Arity),
101	atom_chars(Name,NameStr), catlist(["tgif_",NameStr],FunctorStr),
102	atom_chars(Functor,FunctorStr), Goal =.. [Functor,Obj,Parms],
103	call(Goal),
104	memberchk(=(attrs,Attrs),Parms), !.
105get_attrs(_Obj,[]).
106
107% --------------------------------------------------------------------- %
108
109my_consult(File) :- seeing(X), see(File), my_consult, seen, see(X).
110
111my_consult :-
112	repeat,
113	read(Term),
114	(	Term == end_of_file ->
115		!
116	;	Term = :-(_) ->			% ignore directives
117		fail
118	;	assertz(Term),
119		fail
120	).
121
122member(Element, [Element|_]).
123member(Element, [_|Rest]) :- member(Element, Rest).
124
125memberchk(Element, [Element|_]) :- !.
126memberchk(Element, [_|Rest]) :- memberchk(Element, Rest).
127
128catlist([X|[]], X) :- !.
129catlist([[]|X], Y) :- !, catlist(X, Y).
130catlist([[H|T]|X], [H|Y]) :- catlist([T|X], Y).
131