home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
lifeos2.zip
/
LIFE-1.02
/
EXAMPLES
/
BOXES.LF
< prev
next >
Wrap
Text File
|
1996-06-04
|
6KB
|
248 lines
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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 -> @.