1:- module( gbn, [   gbn/0,  gbn/1,  
    2                    gbn_version/2, gbn_module/0,
    3                    gbn_family_gates/5,
    4                    gbn_fam_hmaps/1,
    5                    gbn_fisher_net/3, gbn_fisher_net/4, 
    6                    gbn_fisher_nets/0,gbn_fisher_nets/1,
    7                    gbn_mtx_dat/2,gbn_mtx_paired/4,gbn_mtx_subs/3,
    8                    gbn_mtx_mins/3,
    9                    gbn_term/3,
   10                    gbn_prefix_directed_constraints/4,
   11                    gbn_gates_nets/0, gbn_gates_nets/1,
   12                    gbn_gates_net/1,gbn_gates_net/2,
   13                    gbn_svg_legend/1
   14                    ]  ).   15
   16:- use_module(library(lib)).   17:- lib(source(gbn), homonyms(true)).   18
   19:- lib(mtx).   20:- lib(real).   21:- lib(os_lib).   22:- lib(by_unix).   23:- lib(disp_bn).   24:- lib(options).   25:- lib(debug_call).   26:- lib(stoics_lib).   27:- lib(suggests(svg)).   28
   29:- lib(gbn/1).   30:- lib(gbn_module/0).   31:- lib(gbn_term/3).   32:- lib(gbn_fisher_net/3).   33:- lib(gbn_fisher_net/4).   34:- lib(gbn_fisher_nets/0).   35:- lib(gbn_fisher_nets/1).   36:- lib(gbn_mtx_dat/2).   37:- lib(gbn_mtx_subs/3).   38:- lib(gbn_fam_hmaps/1).   39:- lib(gbn_mtx_paired/4).   40:- lib(gbn_family_gates/5).   41:- lib(gbn_prefix_directed_constraints/4).   42:- lib(gbn_gates_net/1).   43:- lib(gbn_gates_net/2).   44:- lib(gbn_gates_nets/0).   45:- lib(gbn_gates_nets/1).   46:- lib(gbn_svg_legend/1).   47:- lib(gbn_mtx_mins/3).   48:- lib(gbn_res_dir_dat_file/2).   49:- lib(dot_fix/1).   50:- lib(gg_muts_by_pnms/3).   51
   52:- lib(end(gbn)).   53
   54user:file_search_path( cancer, pack('gbn/run/gbns_in_cancer') ).
   55
   56
   57                 /*******************************
   58                 *            MESSAGES          *
   59                 *******************************/
   60% These print messages that are always on.
   61% Different colour to debugging is used by the system (when colour in terminal is enabled).
   62%
   63gbn_message( Mess ) :-
   64    print_message( informational, gbn(Mess) ).
   65    
   66:- multifile prolog:message//1.   67
   68prolog:message(gbn(Message)) -->
   69    message(Message).
   70
   71:- discontiguous
   72    message//1.   73
   74message( exec_miss(Exec,Facil,Target) ) -->
   75    ['The ~w executable is not installed, ~w for ~w'-[Exec,Facil,Target] ].
   76message( non_unique_dat([],Dir) ) -->
   77    ['Directory ~w does not contain the needed .dat file.'-[Dir] ].
   78message( non_unique_dat([_A,_B|_T]), Dir ) -->
   79    ['Directory ~w contains more than one .dat files.'-[Dir] ].
   80message( cow_plot_lbl(Tkn,Use) ) -->
   81    ['Wrong cow plot label: ~w, using: ~w.'-[Tkn,Use] ]