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 >
Text File  |  1996-06-04  |  6KB  |  248 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %
  3. % Copyright 1992 Digital Equipment Corporation
  4. % All Rights Reserved
  5. %
  6. % A self-contained LIFE program for solving a 2D bin-packing problem
  7. %    including an X interface for showing solutions.
  8. %
  9. %
  10. % The problem:
  11. %    given a large box of known dimensions and a number of smaller boxes,
  12. %    also of known dimensions, pack the smaller boxes into the large box.
  13. %
  14. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  15.  
  16.  
  17. %
  18. % Notes:
  19. %
  20. % 1. Type "boxes?" to start the program.
  21. %
  22. % 2. The program will stop after drawing the panel before finding
  23. %    the first solution. Use backtracking thereafter to get each solution.
  24. %
  25. % 3. Backtracking may be done either in the usual manner by typing ";"
  26. %    at the Wild_LIFE prompt, or else by clicking any mouse button or
  27. %    typing any key while the pointer is in the panel.
  28. %
  29. % 4. The program illustrates LIFE's residuation principle: the placement
  30. %    constraints for the boxes are set up BEFORE any actual values are
  31. %    tried for their positions. In other words, it employs a
  32. %    "test-then-generate" strategy as opposed to "generate-then-test".
  33. %
  34.  
  35. module("boxes") ?
  36. public(boxes) ?
  37.  
  38. import("xtools") ?
  39. import("lists")?
  40.  
  41. global(boxeswindow) ?
  42. T = xExposureMask \/ xKeyPressMask \/ xButtonPressMask,
  43. global(boxesmask <- T) ?
  44.  
  45. boxes :-
  46.     (
  47.        C1 = get_choice,
  48.        Q = push_button(text => "quit",
  49.                action => (set_choice(C1),fail)),
  50.        Panel = panel(title => "BOXES")
  51.            containing Q t_left_of
  52.                     h_box(5) t_left_of
  53.             frame(X0,Y0,width => Width:(bigbox_width * S:scale),
  54.                     height => Height:(bigbox_height * S)),
  55.            create_box(Panel),
  56.        xCreateWindow (default_display,
  57.                      X0,Y0,Width,Height,
  58.               boxeswindow,
  59.                      color => white,
  60.                       border => 0,
  61.                   parent => Panel.window,
  62.               eventmask => boxesmask),
  63.        make_boxes (Boxes),
  64.        constrain_boxes (Boxes),
  65.        event_handler,
  66.        (
  67.           succeed    %% stop before finding the first solution
  68.        ;
  69.           place_boxes (Boxes)
  70.        )
  71.     ;
  72.        succeed
  73.     ).
  74.  
  75.  
  76. %    A box consists of an x coordinate, a y coordinate,
  77. %    a width, a height, and a color.
  78.  
  79. :: bbox (X:posint, Y:posint, W:int, H:int, color => C).
  80.  
  81. posint := I:int | I >= 0.
  82.  
  83.  
  84.  
  85.  
  86. %
  87. %   Making the boxes: specify their widths, heights, and colors, but
  88. %   NOT their x and y coordinates. The boxes are sorted by size
  89. %   (a function of their width and height) so that the "largest"
  90. %   boxes will be placed first.
  91. %
  92.  
  93. make_boxes (Boxes) :-
  94.     Boxes = sort_boxes
  95.       ([ bbox (_, _, 1, 3, color => aquamarine),
  96.          bbox (_, _, 2, 2, color => coral),
  97.          bbox (_, _, 3, 2, color => 'cornflower blue'),
  98.          bbox (_, _, 3, 1, color => gold),
  99.          bbox (_, _, 4, 1, color => goldenrod),
  100.          bbox (_, _, 4, 2, color => khaki),
  101.          bbox (_, _, 1, 4, color => magenta),
  102.          bbox (_, _, 2, 3, color => 'medium slate blue'),
  103.          bbox (_, _, 2, 4, color => 'medium spring green'),
  104.          bbox (_, _, 2, 1, color => 'orange red'),
  105.          bbox (_, _, 7, 1, color => plum),
  106.          bbox (_, _, 3, 3, color => salmon),
  107.          bbox (_, _, 1, 6, color => yellow)
  108.       ]).
  109.  
  110.  
  111.  
  112.  
  113. %
  114. %    These routines define the (placement) constraints between boxes.
  115. %    A box must be disjoint from all other boxes: the values selected
  116. %    for its x, y coordinates must not cause it to overlap another box.
  117. %
  118.  
  119. constrain_boxes ([]) :- !. 
  120. constrain_boxes ([Box|Boxes]) :- 
  121.     disjoint_from (Box, Boxes),
  122.     constrain_boxes (Boxes).
  123.  
  124.  
  125. disjoint_from (_, []) :- !.
  126. disjoint_from (Box1, [Box2 | Boxes]) :- 
  127.     constrain_box (Box1, Box2), 
  128.     disjoint_from (Box1, Boxes).
  129.  
  130.  
  131. constrain_box (@(X1,Y1,W1,H1), @(X2,Y2,W2,H2))
  132.         -> (X1+W1 =< X2) or (X1 >= X2+W2) or
  133.            (Y1+H1 =< Y2) or (Y1 >= Y2+H2).
  134.  
  135.  
  136.  
  137.  
  138. %
  139. %   Placing the boxes: for each box, first choose an x and a y coordinate
  140. %   that lies within the big box. If the choice is correct, the residuated
  141. %   placement constraints on that box will be satisfied automatically.
  142. %   If not, then, by backtracking, new x and y values will be chosen and
  143. %   the process repeated.
  144. %   
  145.  
  146. place_boxes ([]) :- !.
  147. place_boxes ([Box|Boxes]) :-
  148.     place_box (Box),
  149.     place_boxes (Boxes).
  150.  
  151. place_box (Box : @(X,Y,W,H)) :-
  152.     member (X+W, x_coords),
  153.         member (Y+H, y_coords),
  154.         draw_box (Box).
  155.  
  156.  
  157.  
  158.  
  159. %
  160. %    Draw a box: the first disjunction draws the box, the second
  161. %    disjunction erases it.
  162. %    
  163.  
  164. draw_box (@(X,Y,W,H,color => C)) :-
  165.     (
  166.       xFillRectangle (Window : boxeswindow,
  167.               X1 : (X * S:scale + O:offset),
  168.               Y1 : (Y * S + O),
  169.               W1 : (W * S - D:(2*O)),
  170.               H1 : (H * S - D),
  171.               color => C),
  172.       xDrawRectangle (Window, X1, Y1, W1, H1, linewidth => 5),
  173.       xDrawRectangle (Window, X1, Y1, W1, H1, color => white)
  174.     ;
  175.       xFillRectangle (Window,
  176.               X1 - 3,
  177.               Y1 - 3,
  178.               W1 + 6,
  179.               H1 + 6,
  180.               color => white),
  181.       fail
  182.     ).
  183.  
  184.  
  185.  
  186.  
  187. %
  188. %    Global variables and auxiliary routines:
  189. %    - the big box's width and height
  190. %    - the size of a box as a function of its width and heigth
  191. %    - a routine for sorting the boxes according to their size
  192. %      (this uses a generic quicksort routine)
  193. %
  194.  
  195. scale -> 70.
  196. offset -> 4.
  197.  
  198. bigbox_width  -> 10.
  199. bigbox_height -> 7.
  200.  
  201.  
  202. size (Width, Height) ->
  203.     (2 + abs(Height-Width) + Width) * Width * Height.
  204.  
  205.  
  206. interval (From, To) ->
  207.     cond (From > To, [], [From | interval(From+1,To)]).
  208.  
  209.  
  210. sort_boxes (Boxes) -> gen_quicksort (Boxes, order => bigger_box).
  211.  
  212. bigger_box (@(_,_,W1,H1), @(_,_,W2,H2)) ->
  213.     size (W1,H1) >= size (W2,H2).
  214.  
  215.  
  216. %
  217. %    If a keyboard or mouse event arrives, the event_handler fails,
  218. %    making the program backtrack.
  219. %
  220.  
  221. event_handler -> 
  222.     handle_event (xGetEvent (boxeswindow,
  223.                      eventmask => boxesmask)).
  224.  
  225. handle_event (expose_event) -> true |
  226.     xRefreshWindow (boxeswindow),
  227.     handle_event (xGetEvent (boxeswindow,
  228.                      eventmask => boxesmask)).
  229.  
  230.  
  231.  
  232. %
  233. %    Actions executed when the file is loaded:
  234. %       - calculate the range of x and y coordinates for the smaller boxes
  235. %       - when the program is first run, colors for the small boxes must
  236. %         be "requested" from the X interface. On subsequent runs, these
  237. %         requests are not necessary as the colors already exist. So, set
  238. %         a flag upon loading indicating that the colors have not yet been
  239. %         requested.
  240. %
  241.  
  242. X = interval(1, bigbox_width),
  243. global (x_coords <- X)?
  244. Y = interval(1, bigbox_height),
  245. global (y_coords <- Y)?
  246.  
  247. where -> @.
  248.