home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / DEMO / X_SCHEDU.LF < prev    next >
Text File  |  1996-06-04  |  11KB  |  434 lines
  1. % Simple PERT scheduler written in Life.
  2. % With graphical interface
  3.  
  4. module("x_schedule") ?
  5. public(sch_1, sch_2)?
  6.  
  7. persistent(problem) ?
  8.  
  9. global(infinity <- 1e10)?
  10. global(end <- 0) ?
  11. global(square_size <- 40) ?
  12. global(unit_length <- 10) ?
  13. global(bar_height <- 20) ?
  14. global(problem_size) ?
  15.  
  16. import("xtools")?
  17. import("xtools_utils")?
  18.  
  19. :: A:task(duration => real,
  20.       earlyStart => earlyCalc(R),
  21.       lateStart  => 1e10, 
  22.       prerequisites => R:{[];list},
  23.       succ => false)
  24.     |
  25.     !,
  26.     cond(end < A.earlyStart + A.duration,
  27.          end <- A.earlyStart + A.duration).
  28.  
  29. earlyCalc([]) -> 0.
  30. earlyCalc([T | Ts]) ->
  31.     max(earlyCalc(Ts), T.earlyStart + T.duration).
  32.  
  33. schedule_tasks(Ts) :-
  34.     comp_succ(Ts),
  35.     update(Ts).
  36.  
  37. comp_succ([T | Ts]) :- !,
  38.     mark_succ(T.prerequisites),
  39.     comp_succ(Ts).
  40. comp_succ([]).
  41.  
  42. mark_succ([T|Ts]) :- !,
  43.     T.succ <- true,
  44.     mark_succ(Ts).
  45. mark_succ([]).
  46.  
  47. update([T|Ts]) :- !,
  48.     (
  49.         T.succ :== false, !,
  50.         T.lateStart <- end - T.duration,
  51.         update_late(T.prerequisites, T)
  52.     ;
  53.         succeed
  54.     ),
  55.     update(Ts).
  56. update([]).
  57.  
  58. update_late([T | Ts], Succ) :- !,
  59.     update_late(Ts, Succ),
  60.     (
  61.         Succ.lateStart - T.duration < T.lateStart,
  62.         !,
  63.         T.lateStart <- Succ.lateStart - T.duration,
  64.         update_late(T.prerequisites, T)
  65.     ;
  66.         succeed
  67.     ).
  68. update_late([]).
  69.  
  70. %%%% Create an X-window for the output %%%%
  71.  
  72. tx_box := text_box(font_id => title_font).
  73.  
  74. tx_field_button := text_field_button(font_id => title_font).
  75.  
  76. ps_button := push_button(font_id => title_font).
  77.  
  78. xvisAllTasks(L) :-
  79.     Done = get_choice,
  80.     mark(L),
  81.     Problem_panel = panel(50, 50, border => 20,
  82.                   title => "PERT Scheduling"),
  83.  
  84.     Grid = grid_c(width => S:(problem_size * square_size),
  85.               height => S,
  86.               action => show_me(Grid),
  87.               border => 0,
  88.               color_id => d_field),
  89.     
  90.     create_fields(L, Legend, Tasks, Durations, Grid.window),
  91.  
  92.     same_height(Legend),
  93.     
  94.     TasksT     = tx_box(text => "Task"),
  95.     PredsT     = tx_box(text => "Prerequisites",
  96.                 width => S,
  97.                 h_space => 0),
  98.     DurationsT = tx_box(text => "Duration"),
  99.  
  100.     same_width([TasksT | Tasks]),
  101.     same_width([DurationsT | Durations]),
  102.  
  103.     Push    = ps_button(text => "Quit",
  104.                 action => (set_choice(Done), fail)),
  105.     Solve   = ps_button(text => "Solve",
  106.                 action => solve),
  107.     
  108.     TitleBar = ht_list [TasksT,
  109.                 PredsT,
  110.                 DurationsT],
  111.  
  112.     Block = hb_list [vl_list Tasks,
  113.              vl_list [hc_list Legend, v_box(5), Grid],
  114.              vl_list Durations],
  115.     Buttons = hc_list [Solve, h_box(50), Push],
  116.     
  117.     A = vc_list [TitleBar, v_box(10), 
  118.              Block,    v_box(30),
  119.              Buttons],
  120.     
  121.     Problem_panel contains A,
  122.     create_box(Problem_panel),
  123.     draw_grid(Grid)
  124.     ;
  125.     succeed.
  126.  
  127. show_me(Grid) :-
  128.     OX = Grid.old_x_pos,
  129.     OY = Grid.old_y_pos,
  130.     X = Grid.x_pos,
  131.     Y = Grid.y_pos,
  132.     find_field(OX, OY, OT, OP),
  133.     find_field(X, Y, T, P),
  134.     (
  135.         OT =:= T,
  136.         OP =:= P,
  137.         !,
  138.         swap_color(Grid.window, T, P)
  139.     ;
  140.         succeed
  141.     ).
  142.  
  143.  
  144. draw_grid(Grid) :-
  145.     GW = Grid.window,
  146.     Cid = Grid.color_id,
  147.     draw_s_lines(GW, shade_colors.Cid, 0),
  148.     draw_h_lines(GW, highlight_colors.Cid, 0),
  149.     fill_diagonal(GW, main_colors.blocked, 0).
  150.  
  151. draw_s_lines(3 => problem_size) :- !.
  152. draw_s_lines(GW, C, N) :-
  153.     xDrawLine(GW, 0, Y:(N*square_size),
  154.           Max:(problem_size*square_size - 1), Y,
  155.           color => C, line_width => 1),
  156.     xDrawLine(GW, Y, 0,
  157.           Y, Max,
  158.           color => C, line_width => 1),
  159.     draw_s_lines(GW, C, N+1).
  160.  
  161. draw_h_lines(3 => problem_size) :- !.
  162. draw_h_lines(GW, C, N) :-
  163.     xDrawLine(GW, 0, Y:((N+1)*square_size-1),
  164.           Max:(problem_size*square_size - 1), Y,
  165.           color => C, line_width => 1),
  166.     xDrawLine(GW, Y, 0,
  167.           Y, Max,
  168.           color => C, line_width => 1),
  169.     draw_h_lines(GW, C, N+1).
  170.  
  171.  
  172. fill_diagonal(3 => problem_size) :- !.
  173. fill_diagonal(GW, C, N) :-
  174.     fill_square(GW, N+1, N+1, C),
  175.     fill_diagonal(GW, C, N+1).
  176.  
  177. fill_square(GW, X, Y, C) :-
  178.     xFillRectangle(GW,
  179.                (X-1) * square_size + 1,
  180.                (Y-1) * square_size + 1,
  181.                square_size - 2,
  182.                square_size - 2,
  183.                color => C).
  184.  
  185.  
  186. find_field(X, Y, T, P) :-
  187.     T = floor(Y / square_size) + 1,
  188.     P = floor(X / square_size) + 1.
  189.  
  190. mark([T | Ts], N:{1;real}) :- !,
  191.     T.id <- N,
  192.     problem.N.duration <<- copy_term(T.duration),
  193.     problem.N.pl <<- [],
  194.     mark(Ts, N+1).
  195. mark([], N) :- problem_size <<- N-1.
  196.  
  197. show_solution(L) :-
  198.     (
  199.         Done = get_choice,
  200.         Solution_panel = panel(500, 50, border => 25,
  201.                    title => "Solution"),
  202.         
  203.         create_solution(L, Bars, Tasks),
  204.         ST     = tx_box(text => "Schedule"),
  205.         TasksT = tx_box(text => "Task"),
  206.  
  207.         same_size(Bars),
  208.         same_width([ST, Bars.1]),
  209.         same_width([TasksT | Tasks]),
  210.         
  211.         Push = ps_button(text => "Done",
  212.                  action => (set_choice(Done), fail)),
  213.  
  214.         Title_bar = ht_list [TasksT, ST],
  215.         
  216.         A = vc_list [Title_bar, v_box(10), 
  217.              ht_list [vl_list Tasks,
  218.                   vl_list Bars],
  219.              v_box(30),
  220.              Push
  221.             ],
  222.         Solution_panel contains A,
  223.         create_box(Solution_panel)
  224.     ;
  225.         succeed
  226.     ).
  227.  
  228. create_fields([Task | Tasks], [L | Ls], [T | Ts], [D | Ds], GW) :- !,
  229.     N = psi2str(Task.id),
  230.     L = tx_box(text => N,
  231.            width => square_size,
  232.            h_space => 0,
  233.            v_space => 0
  234.           ),
  235.     T = tx_box(text => strcat("Task ", N, ": "),
  236.            height => square_size,
  237.            offset => 1),
  238.     make_fields(Task.prerequisites, Task.id, GW),
  239.     D = tx_field_button(height => square_size,
  240.                 offset => 0,
  241.                 text => psi2str(Task.duration),
  242.                 action => give_val(Task.id, D.text)),
  243.     create_fields(Tasks, Ls, Ts, Ds, GW).
  244.  
  245. create_fields([], [], [], []).
  246.  
  247. create_solution([Task | Tasks], [B | Bs], [T | Ts], N:{1;int}) :- !,
  248.     T = tx_box(text => strcat("Task ", psi2str(N), ": "),
  249.            height => square_size,
  250.            offset => 1),
  251.     B = make_bar(Task),
  252.     create_solution(Tasks, Bs, Ts, N+1).
  253. create_solution([], [], []).
  254.  
  255. make_task(Task) -> tx_box(text => strcat("Task ",
  256.                      psi2str(Task.id),
  257.                      ": "),
  258.               height => square_size,
  259.               offset => 1).
  260.  
  261. make_fields([T|Ts], Task, GW) :- !,
  262.     fill_square(GW, T.id, Task, 'navy blue'),
  263.     problem.Task.pl <<- [T.id | copy_pointer(problem.Task.pl)],
  264.     make_fields(Ts, Task, GW).
  265. make_fields([]).
  266.  
  267. give_val(N, Text) :-
  268.     problem.N.duration <<- parse(Text).
  269.  
  270. swap_color(GW, T, N) :-
  271.     (
  272.         T :\== N,
  273.         PL = copy_term(problem.T.pl),
  274.         
  275.         decomp(N, PL, Is_pre, NPL),
  276.         cond(not(Is_pre), no_loop(T, N)),
  277.         !,
  278.         problem.T.pl <<- NPL,
  279.         
  280.         C = cond(Is_pre, d_field, on_col),
  281.         fill_square(GW, N, T, main_colors.C)
  282.     ;
  283.         write("")
  284. %%%        play("fastbusy", 60)
  285.     ).
  286.  
  287. no_loop(T, N) :-
  288.     not_depends_on(problem.N.pl, T, @).
  289.  
  290. not_depends_on([X | R], T, Term) :- !,
  291.     X =\= T,
  292.     B = has_feature(X, Term),
  293.     Term.X = @,
  294.     cond(not(B),
  295.          not_depends_on( problem.X.pl,
  296.                  T,
  297.                  Term)),
  298.     not_depends_on(R, T, Term).
  299.  
  300. not_depends_on([]).
  301.  
  302. decomp(A, [A|B], true, B) :- !.
  303. decomp(A, [], false, [A]) :- !.
  304. decomp(A, [H|T], B, [H|R]) :- decomp(A, T, B, R).
  305.  
  306. solve :-
  307.     end <- 0,
  308.     FV = feature_values(copy_term(problem)),
  309.     L = map(root_sort, FV),
  310.     L = map(translate(2 => L), FV),
  311.     schedule_tasks(L),
  312.     show_solution(L).
  313.     
  314. translate(Task, L) ->
  315.     task(duration => Task.duration,
  316.          prerequisites => map(nth(2 => L), Task.pl)
  317.         ).
  318.  
  319. make_bar(A) -> F |
  320.     D = A.duration,
  321.     E = A.earlyStart,
  322.     L = A.lateStart,
  323.     T = bar(E, D, 1)
  324.       l_above
  325.       bar(L, D, 2),
  326.     F = frame(frame_state => true,
  327.           height => square_size,
  328.           border => (square_size - 2 * bar_height) / 2),
  329.     F contains T.
  330.  
  331. bar(Offset, Length, Color) ->
  332.     h_box(Offset * unit_length)
  333.       c_left_of field(@, @, Length * unit_length, bar_height,
  334.               color_id => Color).
  335.  
  336. %%% Settings
  337.  
  338. def_color(hilight_colors, 1, blue) ?
  339. def_color(main_colors, 1, blue) ?
  340. def_color(shade_colors, 1, blue) ?
  341. def_color(hilight_colors, 2, red) ?
  342. def_color(main_colors, 2, red) ?
  343. def_color(shade_colors, 2, red) ?
  344. def_color(shade_colors,on_col, 'dim grey') ?
  345. def_color(highlight_colors,on_col, white) ?
  346. def_color(main_colors,on_col, 'navy blue') ?
  347. def_color(main_colors, blocked, 'dim grey')?
  348. def_color(shade_colors,blocked,'dim grey') ?
  349. def_color(highlight_colors,blocked,white) ?
  350.  
  351. % Sample inputs for the PERT scheduler:
  352.  
  353. sch_1 :-
  354.     square_size <- 40, 
  355.     unit_length <- 10, 
  356.     bar_height <- 20,
  357.     problem <<- @,
  358.     def_font(title_font,
  359.          new_font(cond(life_demo#using_demo_fonts,
  360.                    "terminal_bold_narrow18",
  361.                    "-adobe-helvetica-bold-r-narrow--17-120-100-100-p-72-*"))),
  362.     A1=task(duration=>10),
  363.     A2=task(duration=>20),
  364.     A3=task(duration=>30),
  365.     A4=task(duration=>18,prerequisites=>[A1,A2]),
  366.     A5=task(duration=>8 ,prerequisites=>[A2,A3]),
  367.     A6=task(duration=>3 ,prerequisites=>[A1,A4]),
  368.     A7=task(duration=>4 ,prerequisites=>[A5,A6]),
  369.     xvisAllTasks([A1,A2,A3,A4,A5,A6,A7]).
  370.  
  371. sch_2 :-
  372.     square_size <- 16,
  373.     unit_length <- 10, 
  374.     bar_height <- 8,
  375.     problem <<- @,
  376.     def_font(title_font,
  377.          new_font(cond(life_demo#using_demo_fonts,
  378.                    "terminal_bold_narrow14",
  379.                    "-adobe-helvetica-bold-r-narrow--14-100-100-100-p-70-*"))),
  380.     A1=task(duration=>2, prerequisites=>[B1,C1]),
  381.     B1=task(duration=>2, prerequisites=>[A2]),
  382.     C1=task(duration=>2, prerequisites=>[A2]),
  383.     
  384.     A2=task(duration=>2, prerequisites=>[B2,C2]),
  385.     B2=task(duration=>2, prerequisites=>[A3]),
  386.     C2=task(duration=>2, prerequisites=>[A3]),
  387.     
  388.     A3=task(duration=>2, prerequisites=>[B3,C3]),
  389.     B3=task(duration=>2, prerequisites=>[A4]),
  390.     C3=task(duration=>2, prerequisites=>[A4]),
  391.     
  392.     A4=task(duration=>2, prerequisites=>[B4,C4]),
  393.     B4=task(duration=>2, prerequisites=>[A5]),
  394.     C4=task(duration=>2, prerequisites=>[A5]),
  395.     
  396.     A5=task(duration=>2, prerequisites=>[B5,C5]),
  397.     B5=task(duration=>2, prerequisites=>[A6]),
  398.     C5=task(duration=>2, prerequisites=>[A6]),
  399.     
  400.     A6=task(duration=>2, prerequisites=>[B6,C6]),
  401.     B6=task(duration=>2, prerequisites=>[A7]),
  402.     C6=task(duration=>2, prerequisites=>[A7]),
  403.     
  404.     A7=task(duration=>2, prerequisites=>[B7,C7]),
  405.     B7=task(duration=>2, prerequisites=>[A8]),
  406.     C7=task(duration=>2, prerequisites=>[A8]),
  407.     
  408.     A8=task(duration=>2, prerequisites=>[B8,C8]),
  409.     B8=task(duration=>2, prerequisites=>[A9]),
  410.     C8=task(duration=>2, prerequisites=>[A9]),
  411.     
  412.     A9=task(duration=>2, prerequisites=>[B9,C9]),
  413.     B9=task(duration=>2, prerequisites=>[A10]),
  414.     C9=task(duration=>2, prerequisites=>[A10]),
  415.     
  416.     A10=task(duration=>2, prerequisites=>[B10,C10]),
  417.     B10=task(duration=>2, prerequisites=>[A11]),
  418.     C10=task(duration=>2, prerequisites=>[A11]),
  419.     
  420.     A11=task(duration=>2, prerequisites=>[B11,C11]),
  421.     B11=task(duration=>2, prerequisites=>[A12]),
  422.     C11=task(duration=>2, prerequisites=>[A12]),
  423.     
  424.     A12=task(duration=>2),
  425.     
  426.     L = [A1,B1,C1,A2,B2,C2,A3,B3,C3,A4,B4,C4,A5,B5,C5,
  427.          A6,B6,C6,A7,B7,C7,A8,B8,C8,A9,B9,C9,A10,B10,C10,
  428.          A11,B11,C11,A12],
  429.     xvisAllTasks(L).
  430.  
  431. nth(1, [H|@]) -> H.
  432. nth(N, [@|T]) -> nth(N-1, T).
  433.  
  434.