1% BEGIN LICENSE BLOCK
2% Version: CMPL 1.1
3%
4% The contents of this file are subject to the Cisco-style Mozilla Public
5% License Version 1.1 (the "License"); you may not use this file except
6% in compliance with the License.  You may obtain a copy of the License
7% at www.eclipse-clp.org/license.
8%
9% Software distributed under the License is distributed on an "AS IS"
10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11% the License for the specific language governing rights and limitations
12% under the License.
13%
14% The Original Code is  The ECLiPSe Constraint Logic Programming System.
15% The Initial Developer of the Original Code is  Cisco Systems, Inc.
16% Portions created by the Initial Developer are
17% Copyright (C) 1994-2006 Cisco Systems, Inc.  All Rights Reserved.
18%
19% Contributor(s): ECRC GmbH.
20%
21% END LICENSE BLOCK
22
23%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
24%
25% Options handling
26%
27%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28
29:- begin_module(grace).
30
31:- import
32	export_body/2,
33	get_flag_body/4,
34	is_predicate_/2
35    from sepia_kernel.
36
37% Initialization, done on first Grace invocation
38init_options(Module) :-
39    (exists('.gracerc') ->
40    	compile('.gracerc', Module)
41    ;
42    exists('~/.gracerc') ->
43    	compile('~/.gracerc', Module)
44    ;
45    	true
46    ).
47
48erase_old_arrays :-
49    m_option_number(N),
50    current_array(Array, L),
51    functor(Array, Name, Arity),
52    (Arity = 1,
53    arg(1, Array, N) ->
54    	true
55    ;
56    grace_window(Name) ->
57    	true
58    ;
59    	valid_option(_, Name, I),
60    	var(I),
61    	not(matrix_option(Name, _))
62    ),
63    memberchk(local, L),
64    erase_array(Name/Arity),
65    fail.
66erase_old_arrays.
67
68% Options setting, called each time Grace is invoked
69process_options :-
70    option(varstack, font, F),
71    tcl('set vs_font ##', F),
72    option(control, font, CF),
73    tcl('set ct_font ##', CF),
74    option(menu, font, MF),
75    tcl('set menu_font ##', MF),
76    (option(elements, font, EF) ->
77	tcl('set elc_font ##', EF)
78    ;
79	tcl('set elc_font [m_make_font 18]')
80    ).
81
82%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
83%
84% Getting the options
85%
86%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
87
88% Short form, if we know that the array already exists (not the first call)
89matrix_option(W, N, V) :-
90    matrix_option(N, I),
91    AI =.. [W, I],
92    getval(AI, V).
93
94% General form, may be slow
95option(W, N, V) :-
96    matrix_option(N, I),
97    !,
98    m_option_number(Arity),
99    AD =.. [W, Arity],
100    (current_array(AD, _) ->
101	true
102    ;
103	make_local_array(AD),
104	copy_matrix_defaults(W)
105    ),
106    AI =.. [W, I],
107    getval(AI, Term),
108    option_value(Term, W, N, V).
109option(W, N, V) :-
110    valid_option(W, N, I),
111    (integer(I) ->
112	AI =.. [W, I],
113	getval(AI, Term)
114    ;
115	getval(N, Term)
116    ),
117    option_value(Term, W, N, V).
118
119option_value(Term, W, N, V) :-
120    (Term = (W, N, G) ->
121	(G = Module:Goal ->
122	    true
123	;
124	    getval(module, Module),
125	    Goal = G
126	),
127	apply(Goal, [V], Module)
128    ;
129	Term = V
130    ).
131
132% A fast one which works only for local properties
133single_option(_W, N, V) :-
134    getval(N, V).
135
136%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
137%
138% Setting the options
139%
140%
141% matrix: 	MatrixName(Index)
142% font etc.:	Window(Index)
143% else:		OptionName
144%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
145grace_option(W, N, V) :-
146    var(V),
147    !,
148    option(W, N, V).
149grace_option(W, N, V) :-
150    nonvar(V),
151    matrix_option(N, I),
152    !,
153    (var(W) ->
154	AI = '.default'(I)
155    ;
156	m_option_number(Arity),
157	AD =.. [W, Ar],
158	(current_array(AD, _) ->
159	    (Ar = Arity ->
160		AI =.. [W, I]
161	    ;
162		error(6, grace_option(W, N, V))
163	    )
164	;
165	atom(W) ->
166	    Ar = Arity,
167	    make_local_array(AD),
168	    copy_matrix_defaults(W),
169	    AI =.. [W, I]
170	;
171	    error(5, grace_option(W, N, V))
172	)
173    ),
174    type_check(W, N, V, V1),
175    action(W, N, V1, NewV),
176    setval(AI, NewV).
177grace_option(W, N, V) :-
178    valid_option(W, N, I),
179    not(read_only(W, N)),
180    !,
181    type_check(W, N, V, V1),
182    action(W, N, V1, NewV),
183    (integer(I) ->
184	% multi-window options
185	AI =.. [W, I],
186	setval(AI, NewV)
187    ;
188	setval(N, NewV),
189	tcl_string(NewV, S),
190	(tcl('set cv_## ##', [N, S]) -> true; true)
191    ).
192grace_option(W, N, V) :-
193    error(6, grace_option(W, N, V)).
194
195copy_matrix_defaults(M) :-
196    m_option_number(Max),
197    copy_matrix_defaults(M, 0, Max).
198
199copy_matrix_defaults(_, Max, Max) :- !.
200copy_matrix_defaults(W, I, Max) :-
201    AI =.. [W, I],
202    getval('.default'(I), V),
203    setval(AI, V),
204    I1 is I + 1,
205    copy_matrix_defaults(W, I1, Max).
206
207:- mode matrix_option(+, ?).
208matrix_option(label_x, 0).
209matrix_option(label_y, 1).
210matrix_option(font_size, 2).
211matrix_option(show, 3).
212matrix_option(diagonal_color, 4).
213matrix_option(lookahead, 5).
214matrix_option(lookahead_var, 6).
215matrix_option(element_width, 7).
216matrix_option(matrix_geometry, 8).
217matrix_option(font_sizes, 9).
218matrix_option(label, 10).
219matrix_option(font(_), 11).
220m_option_number(12).
221
222% Rudimentary type test, should be improved
223type_check(W, N, V, _) :-
224    var(V),
225    !,
226    error(4, grace_option(W, N, V)).
227type_check(W, N, V, (W, N, V)) :-
228    compound(V),
229    V \= [_|_],
230    V \= +[_|_],
231    !.			% callable terms are executed on demand
232type_check(W, N, V, V) :-
233    list_option(W, N),
234    !,
235    (V = [_|_] ->
236	true
237    ;
238	V = +[_|_]
239    ).
240type_check(W, N, V, NewV) :-
241    boolean_option(W, N),
242    !,
243    (true(V) ->
244	NewV = 1
245    ;
246    false(V) ->
247	NewV = 0
248    ;
249	error(6, grace_option(W, N, V))
250    ).
251type_check(W, N, V, V) :-
252    integer_option(W, N),
253    !,
254    (integer(V) ->
255	true
256    ;
257	error(5, grace_option(W, N, V))
258    ).
259type_check(W, N, V, NewV) :-
260    string_arg_option(W, N),
261    !,
262    (V == "" ->
263	NewV = "{}"
264    ;
265    string(V) ->
266	NewV = V
267    ;
268    atom(V) ->
269	atom_string(V, NewV)
270    ;
271	error(5, grace_option(W, N, V))
272    ).
273type_check(W, N, V, NewV) :-
274    string_option(W, N),
275    !,
276    (string(V) ->
277	NewV = V
278    ;
279    atom(V) ->
280	atom_string(V, NewV)
281    ;
282	error(5, grace_option(W, N, V))
283    ).
284type_check(W, N, V, NewV) :-
285    enumerated_option(W, N, L),
286    !,
287    (string(V) ->
288    	NewV = V
289    ;
290    atom(V) ->
291    	atom_string(V, NewV)
292    ;
293	error(5, grace_option(W, N, V))
294    ),
295    (member(NewV, L) ->
296    	true
297    ;
298	error(6, grace_option(W, N, V))
299    ).
300type_check(W, N, V, _) :-
301    error(6, grace_option(W, N, V)).
302
303valid_option(W, N, Index) :-
304    common_option(W, N, Index),
305    !.
306valid_option(W, N, _) :-
307    compound_option(W, N),
308    !.
309valid_option(W, N, _) :-
310    list_option(W, N),
311    !.
312valid_option(W, N, _) :-
313    boolean_option(W, N),
314    !.
315valid_option(W, N, _) :-
316    string_arg_option(W, N),
317    !.
318valid_option(W, N, _) :-
319    string_option(W, N),
320    !.
321valid_option(W, N, _) :-
322    integer_option(W, N),
323    !.
324valid_option(W, N, _) :-
325    enumerated_option(W, N, _),
326    !.
327
328common_option(W, font, 0) :-
329    grace_window(W),
330    W \== matrix.
331common_option(W, geometry, 1) :-
332    grace_window(W),
333    W \== elements,
334    W \== menu.
335
336grace_window(control).
337grace_window(varstack).
338grace_window(elements).
339grace_window(matrix).
340grace_window(menu).
341grace_window(constraints).
342
343boolean_option(_, show).
344boolean_option(_, label).
345boolean_option(_, lookahead).
346boolean_option(_, lookahead_var).
347boolean_option(control, all_solutions).
348boolean_option(control, display_solutions).
349boolean_option(control, print_trace).
350boolean_option(varstack, flush).
351
352string_arg_option(control, title).
353string_arg_option(control, version).
354string_arg_option(control, display).
355string_arg_option(control, var_selection).
356string_arg_option(control, value_selection).
357string_arg_option(varstack, empty_color).
358string_arg_option(varstack, rest_color).
359string_arg_option(varstack, tried_color).
360string_arg_option(varstack, current_color).
361string_arg_option(varstack, partly_color).
362string_arg_option(matrix, selected_forward).
363string_arg_option(matrix, selected_backward).
364string_arg_option(matrix, top).
365string_arg_option(_, geometry).
366string_arg_option(_, matrix_geometry).
367string_arg_option(_, diagonal_color).
368string_arg_option(W, font) :-
369    grace_window(W),
370    W \== matrix.
371string_arg_option(W, geometry) :-
372    grace_window(W),
373    W \== elements,
374    W \== menu.
375
376string_option(tk, init).
377
378integer_option(varstack, rows).
379integer_option(varstack, box_width).
380integer_option(varstack, text_width).
381integer_option(control, percent).
382integer_option(_, font_size).
383integer_option(_, element_width).
384
385compound_option(_, font(_)).
386
387list_option(control, var_selections).
388list_option(control, value_selections).
389list_option(_, label_x).
390list_option(_, label_y).
391list_option(_, font_sizes).
392
393enumerated_option(control, branch_and_bound, ["restart", "continue"]).
394enumerated_option(control, display, ["all", "stack", "none"]).
395enumerated_option(control, restart, ["ask", "restart"]).
396
397read_only(control, title) :- getval(startup, 0).
398read_only(control, version) :- getval(startup, 0).
399
400% Options that require some other action than just setting a variable
401action(control, var_selection, S, S) :-
402    !,
403    (set_var_selection(S) ->
404	true
405    ;
406	error(6, grace_option(control, var_selection, S))
407    ).
408action(control, value_selection, S, S) :-
409    !,
410    (set_value_selection(S) ->
411	true
412    ;
413	error(6, grace_option(control, value_selection, S))
414    ).
415action(control, value_selections, Name, Value) :-
416    !,
417    (Name = +List,
418    convert_pred_list(List, NewList) ->
419	option(control, value_selections, OldList),
420	subtract(NewList, OldList, ReallyNew),
421	add_value_selections(ReallyNew),
422	append(OldList, ReallyNew, Value)
423    ;
424    Name = [_|_],
425    convert_pred_list(Name, Value) ->
426	(tcl('catch {.valsel.menu delete 0 last}') -> true; true),
427	add_value_selections(Value)
428    ;
429	error(5, grace_option(control, value_selections, Name))
430    ).
431action(control, var_selections, Name, Value) :-
432    !,
433    (Name = +List,
434    convert_pred_list(List, NewList) ->
435	option(control, var_selections, OldList),
436	subtract(NewList, OldList, ReallyNew),
437	add_var_selections(ReallyNew),
438	append(OldList, ReallyNew, Value)
439    ;
440    Name = [_|_],
441    convert_pred_list(Name, Value) ->
442	(tcl('catch {.varsel.menu delete 0 last}') -> true; true),
443	add_var_selections(Value)
444    ;
445	error(5, grace_option(control, var_selections, Name))
446    ).
447action(Matrix, label, Bool, Bool) :-
448    !,
449    (var(Matrix) ->
450	true		% could also iterate on all existing matrices
451    ;
452	tcl('catch {m_set_label .## ## ##}', [Matrix, Matrix, Bool])
453    ).
454action(_, _, V, V).
455
456
457convert_pred_list([], []).
458convert_pred_list([[P, N]|L], [[P, S]|L1]) :-
459    (string(N) ->
460	S = N
461    ;
462    atom(N) ->
463	atom_string(N, S)
464    ),
465    convert_pred_list(L, L1).
466
467true(1).
468true(yes).
469true(on).
470true(true).
471
472false(0).
473false(no).
474false(off).
475false(false).
476
477default_font(Size, Font) :-
478    concat_string(['-*-times-bold-r-normal-*-', Size, '-*-*-*-*-*-*-*'], Font).
479
480init_arrays :-
481    % Initialize the matrix default array
482    m_option_number(N), make_local_array('.default'(N)),
483    % Initialize the multiple-window arrays
484    (grace_window(W), AI =.. [W, 2], make_local_array(AI), fail; true),
485    % Initialize the single-window arrays
486    (valid_option(_, O, I), var(I), make_local_array(O), fail; true).
487%
488% Default option values
489%
490default_options(Title) :-
491    erase_old_arrays,
492    init_arrays,
493    setval(startup, 1),
494    grace_option(_, label_x, int_list(0, 9)),
495    grace_option(_, label_y, int_list(0, 30)),
496    grace_option(_, label, yes),
497    grace_option(_, font_size, 12),
498    grace_option(_, show, 1),
499    grace_option(_, diagonal_color, "#ffc0c0"),
500    grace_option(_, element_width, 9),
501    grace_option(_, lookahead, 0),
502    grace_option(_, lookahead_var, 0),
503    grace_option(_, font_sizes, [6, 8, 10, 12, 14, 18, 22, 24]),
504    grace_option(_, matrix_geometry, ""),
505    grace_option(control, geometry, ""),
506    grace_option(control, var_selections,
507	[[first_in_list/2, "List Order"],
508	[smallest_domain/2, "Smallest Domain"],
509	[largest_domain/2, "Largest Domain"],
510	[smallest_minimum/2, "Smallest Minimum"],
511	[largest_minimum/2, "Largest Minimum"],
512	[smallest_maximum/2, "Smallest Maximum"],
513	[largest_maximum/2, "Largest Maximum"],
514	[smallest_difference/2, "Smallest Difference"],
515	[largest_difference/2, "Largest Difference"],
516	[least_regret/2, "Least Regret"],
517	[most_constrained/2, "Most Constrained"]]),
518    grace_option(control, value_selections,
519	[[smallest_element/3, "Smallest Element"],
520	[largest_element/3, "Largest Element"],
521	[random_element/3, "Random Element"],
522	[halve_range_bottom/3, "Halve Range Bottom"],
523	[halve_range_top/3, "Halve Range Top"],
524	[halve_elements_bottom/3, "Halve Elements Bottom"],
525	[halve_elements_top/3, "Halve Elements Top"]]),
526    grace_option(control, title, Title),
527    grace_option(control, version, "1.0"),
528    grace_option(control, var_selection, "Smallest Domain"),
529    grace_option(control, value_selection, "Smallest Element"),
530    grace_option(control, font, "-*-helvetica-bold-r-normal-*-12-*"),
531    grace_option(control, display, "Stack"),
532    grace_option(control, print_trace, 0),
533    grace_option(control, all_solutions, 0),
534    grace_option(control, display_solutions, 1),
535    grace_option(control, percent, 0),
536    grace_option(control, branch_and_bound, "restart"),
537    grace_option(control, restart, restart),
538    grace_option(varstack, geometry, "-5+0"),
539    grace_option(varstack, flush, 1),
540    grace_option(tk, init, ""),
541    grace_option(varstack, box_width, 80),
542    grace_option(varstack, font, grace:default_font(14)),
543    grace_option(varstack, rows, 30),
544    grace_option(varstack, text_width, 110),
545    grace_option(varstack, empty_color, white),
546    grace_option(varstack, rest_color, steelblue2),
547    grace_option(varstack, tried_color, gray80),
548    grace_option(varstack, current_color, red),
549    grace_option(varstack, partly_color, "#ff8500"),
550    grace_option(menu, font, grace:default_font(14)),
551    grace_option(_, font(Size), grace:default_font(Size)),
552    grace_option(matrix, selected_forward, red),
553    grace_option(matrix, selected_backward, red),
554    grace_option(matrix, top, "+0+0"),
555    grace_option(constraints, geometry, "+300+300"),
556    grace_option(elements, font, grace:default_font(14)),
557    setval(startup, 0).
558
559:- init_arrays.
560