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