1:- module(plcal,[
    2              %calendar/0,
    3              start_events/0,
    4              end_events/0,
    5              (set_event)/1,
    6              (set_event)/2,
    7              (add_event)/1,
    8              %week/0,
    9              %days/1,
   10              reply_ical/2,
   11              ical/2,
   12              ical_stream/3,
   13              op(1150,fx,add_event),
   14              op(1150,fx,set_event)
   15          ]).   16
   17%:- use_module(library(ical/core)).
   18:- use_module(library(date_time)).   19%:- use_module(library(julian)).
   20
   21:- use_module(library(dcg/basics)).   22
   23:- dynamic event_data/2.   24:- dynamic event_type/1.   25:- dynamic event_day/2.   26
   27start_events:-
   28    abolish(event_data/2),
   29    abolish(event_type/1),
   30    abolish(event_day/2).
   31
   32end_events:-
   33    compile_predicates([event_data/2,event_type/1,event_day/2]).
   34
   35set_event(B):-
   36    just_added(W),
   37    set_event(W,B).
   38
   39:- meta_predicate set_event(:,+).   40
   41set_event(M:A/N,B):-
   42    functor(F,A,N),
   43    !,
   44    set_event(M:F,B).
   45set_event(W,date(D)):-
   46    !,
   47    assertz(event_day(W,D)).
   48set_event(W,days(D)):-
   49    !,
   50    assertz(event_day(W,D)).
   51set_event(W,K):-
   52    assertz(event_data(W,K)).
   53
   54:- dynamic just_added/1.   55:- volatile just_added/1.   56
   57:- meta_predicate add_event(:).   58
   59add_event(A):-
   60    assertz(event_type(A)),
   61    retractall(just_added/1),
   62    asserta(just_added(A)).
   63
   64event_format_summry(Summary,Event):-
   65    event_data(Event,summary(SS,R)),
   66    format(Summary,SS,R).
   67
   68/* useful: stamp_date_time/3, get_time/1 */
   69/*
   70calendar:-
   71    get_time(Time),
   72    stamp_date_time(Time,date(Y,M,D,_,_,_,_,_,_),local),
   73    succ(Y,YY),
   74    get_all_events(E,date(Y,M,D),date(YY,M,D)),
   75    nl,
   76    write_events(user_output,E).
   77
   78week:-
   79    days(8).
   80
   81days(N):-
   82    get_time(Time),
   83    stamp_date_time(Time,date(Y,M,D,_,_,_,_,_,_),local),
   84    days_(date(Y,M,D),N).
   85
   86days_(_,0):-!.
   87days_(Day,N):-
   88    write_data(user_output,Day),
   89    findall(Day-Event,
   90            (event_type(Type),
   91             event_day(Type,Day)
   92            ),
   93            Events),
   94    write_events(user_output,Events),
   95    succ(NN,N),
   96    date_add(Day, 1 days,Next),
   97    days_(Next,NN).
   98
   99
  100get_all_events(Events,Start,End):-
  101    findall(TEvents,
  102            (event_type(Type),
  103             get_events(TEvents,Type,Start,End)
  104            ),
  105            ToMerge),
  106    merge_events_list(ToMerge,Events).
  107
  108:- meta_predicate get_events(-,:,+,+).
  109
  110get_events(Events,M:A/N,Start,End):-
  111    !,
  112    functor(F,A,N),
  113    get_events(Events,M:F,Start,End).
  114get_events(Events,Term,Start,End):-
  115    findall(Day-Term,
  116            (Term,
  117             event_day(Term,Day),
  118             Start @=<Day,
  119             Day @=< End
  120            ),
  121            NSEvents),
  122    sort(1,@=<,NSEvents,Events).
  123*/
  124
  125%!  day_section(+Term,-Term)
  126
  127day_section(day(Y,M,D),section(date(Y,M,D),DD)):-
  128    !,
  129    date_add(date(Y,M,D),1 days, DD).
  130day_section(date(Y,M,D),section(datetime(Y,M,D,0,0,0),DD)):-
  131    !,
  132    datetime_add(datetime(Y,M,D,0,0,0),1 secs, DD).
  133day_section(section(A,B),W):-
  134    !,
  135    W = section(A,B).
  136day_section([A],B):-
  137    !,
  138    day_section(A,B).
  139day_section([A|_],K):-
  140    day_section(A,K).
  141day_section([_|A],K):-
  142    day_section(A,K).
 event_on_days(Event, Type, Section)
  146:- meta_predicate event_on_days(:,+,-,+,+).  147
  148event_on_days(M:A/N,P,L,Start,End):-
  149    !,
  150    functor(F,A,N),
  151    arg(P,F,Day),
  152    event_on_days(M:F,Day,L,Start,End).
  153
  154event_on_days(Event,Day,L,Start,End):-
  155    event_on_days_(Event,Day,L,[],Start,End,3).
  156
  157event_on_days_(_:true,D,[D|R],R,_,_,_):-!.
  158event_on_days_(M:(A,B),Day,L,R,Start,End,Miss):-
  159    !,
  160    % TODO (A,K,L)
  161    throw(error(not_impolemented([A,L,K]))),
  162    event_on_days_(M:B,Day,K,R,Start,End,Miss).
  163event_on_days_(Module:Event,Day,L,R,Start,End,M):-
  164    !,
  165    findall(p(Day,Module:Body),catch((clause(Module:Event,Body),Event\=Body),_,fail),Clauses),
  166    event_on_days_list(Clauses,L,R,Start,End,M).
  167event_on_days_(Event,Day,L,R,Start,End,M):-
  168    days_reads(Event,Day,L,R,Start,End,M).
  169
  170days_reads(Event,Day,List,R,Start,End,Miss):-
  171    setup_call_cleanup(
  172        engine_create(Day, Event, E),
  173        days_reads_(E, List,R,Start,End,Miss),
  174        engine_destroy(E)).
  175
  176event_on_days_list([p(D,B)],L,R,Start,End,M):-
  177    !,
  178    event_on_days_(B,D,L,R,Start,End,M).
  179event_on_days_list([p(D,B)|T],L,R,Start,End,M):-
  180    event_on_days_(B,D,L,E,Start,End,M),
  181    event_on_days_list(T,E,R,Start,End,M).
  182
  183days_reads_(_, R,R,_,_,0):-!.
  184days_reads_(E, [H|T],R,Start,End,Miss) :-
  185    engine_next(E, H), !,
  186    (   Start @=< H,
  187        H @=< End
  188    ->  M = Miss
  189    ;   succ(M,Miss)
  190    ),
  191    days_reads_(E,T,R,Start,End,M).
  192days_reads_(_,R,R,_,_,_).
 event_on_day(-Event, +Type, +Day)
  196:- meta_predicate event_on_date(-,:,+).  197
  198event_on_date(Event,M:A/N,Day):-
  199    !,
  200    functor(F,A,N),
  201    event_on_date(Event,M:F,Day).
  202
  203event_on_date(Event,Event,Day):-
  204    event_day(Event,Day),
  205    Event.
  206
  207merge_events_list([G|T],E):-
  208    merge_events_list_(G,T,E).
  209
  210merge_events_list_(G,[],G):-!.
  211merge_events_list_(G,[A|T],E):-
  212    merge_events(G,A,R),
  213    merge_events_list_(R,T,E).
  214
  215merge_events([],A,A):-!.
  216merge_events(A,[],A):-!.
  217merge_events([DA-EA|A],[DB-EB|B],[DA-EA|C]):-
  218    DA @< DB,
  219    !,
  220    merge_events(A,[DB-EB|B],C).
  221merge_events(A,[WB|B],[WB|C]):-
  222    merge_events(A,B,C).
  223
  224%---- Terminal writing ----
  225
  226write_data(S,date(Y,M,D)):-
  227    format_time(S,"(%a) %F:\n",date(Y,M,D,0,0,0,0,-,-)).
  228
  229write_events(_,[]):-!.
  230write_events(S,[Day-FF|T]):-
  231    write_color(S,FF),
  232    event_data(FF,terminal_format(SS,R)),
  233    !,
  234    write_data(S,Day),
  235    format(S,SS,R),
  236    write_picture(S,FF),
  237    format(S,"\e[0m",[]),
  238    write_events(S,T).
  239write_events(S,[date(Y,M,D)-E|T]):-
  240    format(S,"~d-~d-~d:\n~w\n\n",[Y,M,D,E]),
  241    write_events(S,T).
  242
  243
  244write_color(S,F):-
  245    event_data(F,terminal_color(K)),
  246    !,
  247    format(S,K,[]).
  248write_color(_,_).
  249
  250write_picture(S,F):-
  251    event_data(F,terminal_picture(K,_)),
  252    !,
  253    format(S,K,[]).
  254write_picture(_,_).
  255
  256
  257%---- ICal generator ----
  258
  259reply_ical(Day,N) :-
  260    format("Content-Type: text/html; charset=UTF-8\r\n",[]),
  261    format("\r\n",[]),
  262    ical_stream(current_output,Day,N).
  263
  264ical(Day,N):-
  265    ical_stream(current_output,Day,N).
  266
  267ical_stream(Stream,Day,N):-
  268    ical_stream_(Day,N,Events),
  269    phrase(ical_object(object(`VCALENDAR`,
  270                              Events))
  271          ,LL),
  272    string_codes(SS,LL),
  273    write(Stream,SS).
  274/*
  275ical_stream_(_,0,[]):-!.
  276ical_stream_(Date,N,Events):-
  277    date_add(Date,1 days,Next),
  278    findall(object(`VEVENT`,
  279                   [content_date(`DTSTART`,Date),
  280                    content_date(`DTEND`,Next),
  281                    content(`SUMMARY`,Codes)]),
  282            (event_type(Type),
  283             event_on_date(Event,Type,Date),
  284             event_format_summry(codes(Codes),Event)
  285            ),
  286            Events,
  287            Tail),
  288
  289    succ(NN,N),
  290    ical_stream_(Next,NN,Tail).
  291*/
  292
  293ical_stream_(_Date,_N,Events):-
  294    %date_add(Date,N days,Next),
  295    findall(object(`VEVENT`,
  296                   [content_date(`DTSTART`,Start),
  297                    content_date(`DTEND`,End),
  298                    content(`SUMMARY`,Codes)]),
  299            (event_type(Type),
  300             event_on_date(Event,Type,Days),
  301             day_section(Days,section(Start,End)),
  302             event_format_summry(codes(Codes),Event)
  303            ),
  304            Events).
  305
  306
  307contents([]) --> [].
  308contents([H|T]) -->
  309    content_line(H),
  310    !,
  311    contents(T).
  312contents([H|T]) -->
  313    ical_object(H),
  314    contents(T).
  315
  316ical_object(object(Type,Body)) -->
  317    "BEGIN:",string(Type),"\r\n",
  318    contents(Body),
  319    "END:",string(Type),"\r\n".
  320
  321content_line(content_date(Name,datetime(Y,L,D,H,M,S))) -->
  322    content_line(content_date(Name,date(Y,L,D,H,M,S,0,-,-))).
  323content_line(content_date(Name,Date)) -->
  324    {ical_date_format(codes(CC),Date)},
  325    string(Name), ":",string(CC),"\r\n".
  326content_line(content(Name,Val)) -->
  327    string(Name), ":", string(Val),"\r\n".
  328content_line(content(Name,Params,Val)) -->
  329    string(Name), ical_content_params(Params),":", string(Val),"\r\n".
  330
  331ical_content_params([]) --> "".
  332ical_content_params([V=A|T]) -->
  333    ";",string(V),"=",string(A),
  334    ical_content_params(T).
  335
  336ical_date_format(Output,date(Y,M,D)):-
  337    format_time(Output,"%Y%m%d",date(Y,M,D)).
  338
  339ical_date_format(Output,Date):-
  340    format_time(Output,"%Y%m%dT%H%m%SZ",Date)