1:-module(sciff_options,
    2     [get_option/2,
    3      set_option/2,
    4      sciff_option/2,
    5      set_options/1,
    6      show_options/0]).    7
    8
    9:- dynamic(sciff_option/2).   10
   11
   12
   13
   14%----------------------------------------------------------
   15% ALL OPTIONS
   16%----------------------------------------------------------
   17sciff_option(fulfiller,off).
   18
   19sciff_option(fdet,off).
   20%sciff_option(fdet,on).
   21
   22sciff_option(seq_act,off).
   23
   24sciff_option(factoring,off).
   25
   26sciff_option(sciff_debug, on).
   27
   28sciff_option(violation_causes_failure, yes).
   29
   30sciff_option(graphviz, off).
   31
   32sciff_option(allow_events_not_expected, yes).
   33
   34
   35
   36get_option(O,V):-
   37    sciff_option(O,V).
   38
   39set_option(Option,Value):-
   40    retract(sciff_option(Option,_)),
   41    assert(sciff_option(Option,Value)).
   42
   43show_options :-
   44	findall(sciff_option(Option, Value), sciff_option(Option, Value), ListOption),
   45	print_options(ListOption).
   46print_options([]) :- nl, nl.
   47print_options([sciff_option(Option, Value)| T]) :-
   48	write(Option),
   49	write(' is '),
   50	write(Value),
   51	write('.'), nl,
   52	print_options(T).
   53
   54set_options([]).
   55set_options([[O,V]|T]):-
   56    set_option(O,V),
   57    set_options(T)