1%  This is the elevator that appears in the IJCAI-97 paper on ConGolog
    2%  It uses exogenous actions for temperature, smoke, and call buttons 
    3%  run: ?- indigolog(control).
    4%
    5%  Respond to "Exogenous action:" with either "nil." or with one of the
    6%    exogenous actions below, such as "on(5)." or "heat."
    7%  The elevator stops when it is parked and all lights are off.
    8
    9% Interface to the outside world via read and write
   10execute(A,Sr) :- ask_execute(A,Sr).
   11exog_occurs(A) :- ask_exog_occurs(A).
   12
   13fl(N) :- N=1; N=2; N=3; N=4; N=5; N=6.      % the elevator floors
   14
   15% Actions 
   16prim_action(down).               % elevator down one floor
   17prim_action(up).                 % elevator up one floor
   18prim_action(toggle).             % toggle the fan 
   19prim_action(ring).               % ring the smoke alarm 
   20prim_action(off(N)) :- fl(N).    % turn off call button on floor n
   21
   22exog_action(heat).               % increase temperature by 1
   23exog_action(cold).               % decrease temperature by 1
   24exog_action(smoke).              % smoke enters elevator 
   25exog_action(reset).              % smoke detector alarm is reset
   26exog_action(on(N)) :- fl(N).     % turn on call button on floor n 
   27
   28% Fluents 
   29prim_fluent(floor).              % the floor the elevator is on (1 to 6)
   30prim_fluent(temp).               % the temperature in the elevator (number)
   31prim_fluent(fan).                % the fan (on or off)
   32prim_fluent(alarm).              % the smoke alarm (on or off)
   33prim_fluent(light(N)) :- fl(N).  % call button of floor n (on or off)
   34
   35
   36% Causal laws 
   37causes_val(up,   floor, N, N is floor+1).
   38causes_val(down, floor, N, N is floor-1).
   39
   40causes_val(heat, temp, X, X is temp+1).
   41causes_val(cold, temp, X, X is temp-1).
   42
   43causes_val(toggle, fan, on,  fan=off).
   44causes_val(toggle, fan, off, fan=on).
   45
   46causes_val(on(N),  light(N), on,  true).
   47causes_val(off(N), light(N), off, true).
   48
   49causes_val(smoke, alarm, on,  true).
   50causes_val(reset, alarm, off, true).
   51
   52% Preconditions of prim actions 
   53poss(down,   neg(floor=1)).
   54poss(up,     neg(floor=6)).
   55poss(off(N), and(floor=N,light(N)=on)).
   56poss(toggle, true).
   57poss(ring,   true).
   58
   59% Initial state  
   60initially(floor,3).	
   61initially(temp,2).
   62initially(fan,off).
   63initially(light(_),off).   % all lights off initially
   64initially(alarm,off).
   65
   66% Definitions of complex conditions
   67proc(too_hot, temp>2).
   68proc(too_cold, -2>temp).
   69proc(below_floor(N), floor<N).
   70proc(above_floor(N), floor>N).
   71proc(next_floor_to_serve(N), light(N)=on).
   72
   73% Definitions of complex actions
   74proc(go_floor(N), while(neg(floor=N), if(below_floor(N),up,down))).
   75proc(serve_floor(N), [go_floor(N), off(N)]).
   76proc(control, prioritized_interrupts(
   77        [interrupt(and(too_hot,fan=off), toggle),
   78         interrupt(and(too_cold,fan=on), toggle),
   79         interrupt(alarm=on, ring),
   80         interrupt(n, next_floor_to_serve(n), serve_floor(n)),
   81         interrupt(above_floor(1), down)]))