%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Copyright 1992 Digital Equipment Corporation
% All Rights Reserved
%
% A self-contained LIFE program for solving a 2D bin-packing problem
%    including an X interface for showing solutions.
%
%
% The problem:
%    given a large box of known dimensions and a number of smaller boxes,
%    also of known dimensions, pack the smaller boxes into the large box.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


%
% Notes:
%
% 1. Type "boxes?" to start the program.
%
% 2. The program will stop after drawing the panel before finding
%    the first solution. Use backtracking thereafter to get each solution.
%
% 3. Backtracking may be done either in the usual manner by typing ";"
%    at the Wild_LIFE prompt, or else by clicking any mouse button or
%    typing any key while the pointer is in the panel.
%
% 4. The program illustrates LIFE's residuation principle: the placement
%    constraints for the boxes are set up BEFORE any actual values are
%    tried for their positions. In other words, it employs a
%    "test-then-generate" strategy as opposed to "generate-then-test".
%

module("boxes") ?
public(boxes) ?

import("xtools") ?
import("lists")?

global(boxeswindow) ?
T = xExposureMask \/ xKeyPressMask \/ xButtonPressMask,
global(boxesmask <- T) ?

boxes :-
	(
	   C1 = get_choice,
	   Q = push_button(text => "quit",
			   action => (set_choice(C1),fail)),
	   Panel = panel(title => "BOXES")
		   containing Q t_left_of
	                h_box(5) t_left_of
			frame(X0,Y0,width => Width:(bigbox_width * S:scale),
				    height => Height:(bigbox_height * S)),
           create_box(Panel),
	   xCreateWindow (default_display,
		       	  X0,Y0,Width,Height,
			  boxeswindow,
		       	  color => white,
	                  border => 0,
		          parent => Panel.window,
			  eventmask => boxesmask),
	   make_boxes (Boxes),
	   constrain_boxes (Boxes),
	   event_handler,
	   (
	      succeed	%% stop before finding the first solution
	   ;
	      place_boxes (Boxes)
	   )
	;
	   succeed
	).


%    A box consists of an x coordinate, a y coordinate,
%    a width, a height, and a color.

:: bbox (X:posint, Y:posint, W:int, H:int, color => C).

posint := I:int | I >= 0.




%
%   Making the boxes: specify their widths, heights, and colors, but
%   NOT their x and y coordinates. The boxes are sorted by size
%   (a function of their width and height) so that the "largest"
%   boxes will be placed first.
%

make_boxes (Boxes) :-
	Boxes = sort_boxes
	  ([ bbox (_, _, 1, 3, color => aquamarine),
	     bbox (_, _, 2, 2, color => coral),
	     bbox (_, _, 3, 2, color => 'cornflower blue'),
	     bbox (_, _, 3, 1, color => gold),
	     bbox (_, _, 4, 1, color => goldenrod),
	     bbox (_, _, 4, 2, color => khaki),
	     bbox (_, _, 1, 4, color => magenta),
	     bbox (_, _, 2, 3, color => 'medium slate blue'),
	     bbox (_, _, 2, 4, color => 'medium spring green'),
	     bbox (_, _, 2, 1, color => 'orange red'),
	     bbox (_, _, 7, 1, color => plum),
	     bbox (_, _, 3, 3, color => salmon),
	     bbox (_, _, 1, 6, color => yellow)
	  ]).




%
%    These routines define the (placement) constraints between boxes.
%    A box must be disjoint from all other boxes: the values selected
%    for its x, y coordinates must not cause it to overlap another box.
%

constrain_boxes ([]) :- !. 
constrain_boxes ([Box|Boxes]) :- 
	disjoint_from (Box, Boxes),
	constrain_boxes (Boxes).


disjoint_from (_, []) :- !.
disjoint_from (Box1, [Box2 | Boxes]) :- 
	constrain_box (Box1, Box2), 
	disjoint_from (Box1, Boxes).


constrain_box (@(X1,Y1,W1,H1), @(X2,Y2,W2,H2))
	    -> (X1+W1 =< X2) or (X1 >= X2+W2) or
	       (Y1+H1 =< Y2) or (Y1 >= Y2+H2).




%
%   Placing the boxes: for each box, first choose an x and a y coordinate
%   that lies within the big box. If the choice is correct, the residuated
%   placement constraints on that box will be satisfied automatically.
%   If not, then, by backtracking, new x and y values will be chosen and
%   the process repeated.
%   

place_boxes ([]) :- !.
place_boxes ([Box|Boxes]) :-
	place_box (Box),
	place_boxes (Boxes).

place_box (Box : @(X,Y,W,H)) :-
	member (X+W, x_coords),
        member (Y+H, y_coords),
        draw_box (Box).




%
%    Draw a box: the first disjunction draws the box, the second
%    disjunction erases it.
%    

draw_box (@(X,Y,W,H,color => C)) :-
	(
	  xFillRectangle (Window : boxeswindow,
			  X1 : (X * S:scale + O:offset),
			  Y1 : (Y * S + O),
			  W1 : (W * S - D:(2*O)),
			  H1 : (H * S - D),
			  color => C),
	  xDrawRectangle (Window, X1, Y1, W1, H1, linewidth => 5),
	  xDrawRectangle (Window, X1, Y1, W1, H1, color => white)
	;
	  xFillRectangle (Window,
			  X1 - 3,
			  Y1 - 3,
			  W1 + 6,
			  H1 + 6,
			  color => white),
	  fail
	).




%
%    Global variables and auxiliary routines:
%	- the big box's width and height
%	- the size of a box as a function of its width and heigth
%	- a routine for sorting the boxes according to their size
%	  (this uses a generic quicksort routine)
%

scale -> 70.
offset -> 4.

bigbox_width  -> 10.
bigbox_height -> 7.


size (Width, Height) ->
	(2 + abs(Height-Width) + Width) * Width * Height.


interval (From, To) ->
	cond (From > To, [], [From | interval(From+1,To)]).


sort_boxes (Boxes) -> gen_quicksort (Boxes, order => bigger_box).

bigger_box (@(_,_,W1,H1), @(_,_,W2,H2)) ->
	size (W1,H1) >= size (W2,H2).


%
%    If a keyboard or mouse event arrives, the event_handler fails,
%    making the program backtrack.
%

event_handler -> 
	handle_event (xGetEvent (boxeswindow,
			         eventmask => boxesmask)).

handle_event (expose_event) -> true |
	xRefreshWindow (boxeswindow),
	handle_event (xGetEvent (boxeswindow,
			         eventmask => boxesmask)).



%
%    Actions executed when the file is loaded:
%       - calculate the range of x and y coordinates for the smaller boxes
%       - when the program is first run, colors for the small boxes must
%         be "requested" from the X interface. On subsequent runs, these
%         requests are not necessary as the colors already exist. So, set
%         a flag upon loading indicating that the colors have not yet been
%         requested.
%

X = interval(1, bigbox_width),
global (x_coords <- X)?
Y = interval(1, bigbox_height),
global (y_coords <- Y)?

where -> @.
