:- dynamic fact/3 .
% display The programs displaying some actions relativ to a given action type.
% picture for donothin
make_picture(donothin) :-
VV1 = 'Picture-', concat(VV1,donothin,Vd1),
new(@donothin, picture(Vd1)), send(@donothin, open),
asserta(object_list(donothin,[])), height(donothin,H),
send(@donothin, display, new(AXISUP, line(5,5,5,175,first))),
send(@donothin, display, new(AXISRIGHT, line(5,175,350,175,second))),
periods(TT),
make_objects(donothin,TT),
make_other_objects(donothin),
activate_picture(donothin,R,H). /* NM = 1, MOD = donothin, R a run */
make_objects(donothin,TT) :- height(donothin,H),
( between(1,TT,A), make_dots(donothin,A,H), fail; true),!.
make_dots(donothin,A,H) :- A1 is 5+5*A,
send(@donothin, display, new(BT, circle(4)), point(A1,50)),
object_list(donothin,OL), append(OL,[BT],OL1), retract(object_list(donothin,OL)),
asserta(object_list(donothin,OL1)),!.
make_other_objects(donothin) :-
send(@donothin, display, new(@W11, text('actor')), point(20,175)),
send(@W11, flush),
send(@donothin, display, new(@W12, text('number')), point(60,175)),
asserta(obj(donothin,@W12)),
send(@W12, flush),!.
activate_picture(donothin,R,H) :- object_list(donothin,OL),
actors(AS),
( between(1,AS,A), display_run(donothin,A,OL,R,H), sleep(1), fail; true),!.
br>
display_run(donothin,A,OL,R,H) :- update(donothin,A),
periods(TT),
( between(1,TT,T), make_wealth_dono(R,T,A,OL,H), fail
; true
),!.
make_wealth_dono(R,T,A,OL,H) :-
fact(R,T,wealth_dono(A,WA)), magnify_by(MAG), W is MAG*WA, Y1 is H-W,
nth1(T,OL,OT), X1 is 5+5*T,
get(OT, position, point(X,Y)),
send(OT, position, point(X1,Y1)),
send(OT, fill_pattern, colour(red)),
send(OT,flush),!.
% ------------------------------------------------------------
% schellin
make_picture(schellin) :-
VV2 = 'Picture-', concat(VV2,schellin,Vd2),
new(@schellin, picture(Vd2)), send(@schellin, open),
periods(TT),
make_objects(schellin,TT),!,
make_other_objects(schellin),
choose_run(R),
activate_picture(schellin,R),!.
make_objects(schellin,TT) :- height(schellin,H),
/* 2 = NM , in para */
gridwidth(G), size_of_boxes(S), GG is G*G,
asserta(object_list(schellin,[])),
( between(1,G,I), make_row(I,G,S), fail; true),!.
make_row(I,G,S) :- ( between(1,G,J), make_column(I,J,S), fail ; true),!.
J1 is (J-1)*S,
send(@schellin, display, new(E, box(S,S)), point(I1,J1)),
object_list(schellin,L), append(L,[E],L1), asserta(object_list(schellin,L1)),
retract(object_list(schellin,L)),!.
make_other_objects(schellin) :-
send(@schellin, display, new(@W21, text('period')), point(20,162)),
send(@W21, flush),
send(@schellin, display, new(@W22, text('number')), point(60,162)),
asserta(obj(schellin,@W22)),
send(@W22, flush),!.
activate_picture(schellin,R) :-
gridwidth(G),
actors(AS), periods(TT), object_list(schellin,L),
( between(1,TT,T), display_period(schellin,R,T,AS,G,L), sleep(1), fail ; true),
retract(object_list(schellin,L)),!.
display_period(schellin,R,T,AS,G,L) :- G1 is G*G,
update(schellin,T),
( between(1,G1,X), nth1(X,L,OB), send(OB, fill_pattern, colour(white)),
send(OB, flush), fail
; true
),!,
( between(1,AS,A), display(schellin,R,T,G,L,A), fail ; true),!.
display(schellin,R,T,G,L,A) :-
fact(R,T,colour(A,C)),
fact(R,T,location(A,I,J)), N is (I-1)*G+J, nth1(N,L,OB),
( C = black, X = colour(black)
;
C = white, X = colour(blue)
),
send(OB, fill_pattern, X), send(OB, flush),!.
% -------------------------------------------------------------------------------
% picture for takeweak
make_picture(takeweak) :-
VV3 = 'Picture-', concat(VV3,takeweak,Vd3),
new(@takeweak, picture(Vd3)), send(@takeweak, open),
send(@takeweak, display, new(AXISUP, line(5,5,5,160,first))),
send(@takeweak, display, new(AXISRIGHT, line(5,160,400,160,second))),
asserta(object_list(takeweak,[])), height(takeweak,H),
periods(TT), choose_run(R),
make_objects(takeweak,TT,R),
make_other_objects(takeweak),
activate_picture(takeweak,R).
make_objects(takeweak,TT,R) :-
actors(AS), asserta(oblist(takeweak,[])),
( between(1,AS,B), make_cell(B,R), fail;true),
send(@takeweak,flush),
oblist(takeweak,L), asserta(oblist(takeweak,L)), !.
make_cell(B,R) :-
J is 140, I is 5 + (B-1)*20, I1 is I + 10,
send(@takeweak, display, new(E, box(10,20)), point(I,J)),
send(@takeweak, display, new(F, box(10,20)), point(I1,J)),
send(@takeweak, flush),
oblist(takeweak,L), append(L,[[E,F]],L1),
asserta(oblist(takeweak,L1)),
retract(oblist(takeweak,L)),!.
make_other_objects(takeweak) :-
send(@takeweak, display, new(@W1, text('period')), point(20,162)),
send(@W1, flush),
send(@takeweak, display, new(@W2, text('number')), point(60,162)),
asserta(obj(takeweak,@W2)),
send(@W2, flush),!.
activate_picture(takeweak,R) :-
choose_run(R), make_maxima(R),
/* R the run in para */
periods(TT), actors(AS),
( between(1,TT,T), depict_period(takeweak,T,AS,R), fail ; true),!,
ask_for_end, destroy(Answer),!.
depict_period(takeweak,T,AS,R) :-
update(takeweak,T),
( between(1,AS,A), update(takeweak,T,A,R), fail; true),!,
send(@takeweak,flush), sleep(1),!.
update(MOD,T) :- obj(MOD,O), send(O,string,T), send(O,flush),!.
update(takeweak,T,A,R) :-
oblist(takeweak,OBL1), nth1(A,OBL1,[OA1,OA2]),
fact(R,T,strength(A,SA)), SA1 is 5*SA,
get(OA1, position, point(X,Y)), Y1 is 160 - SA1,
send(OA1, position, point(X,Y1)), send(OA1,height,SA1),
send(OA1, fill_pattern, colour(green)),
send(OA1,flush),
fact(R,T,wealth_take(A,V1)), max_val(MAX),
get(OA2, position, point(X2,Y2)),
( V1 =< 0, V is 0; V is (V1/MAX)*20 ), Y3 is 160-V,
send(OA2, position, point(X2,Y3)),send(OA2,height,V),
send(OA2, fill_pattern, colour(blue)),
send(OA2,flush),!.
make_maxima(R) :-
findall(V,fact(R,T,wealth_take(A,V)),L1), sort(L1,L2),
length(L2,E2), nth1(E2,L2,MAX1), asserta(max_val(MAX1)),!.
ask_for_end :-
new(@d, dialog('Display')),
send(@d, append, new(TI, text_item(type_End, ''))),
send(@d, append, button(ok, message(@d,return,TI?selection))),
get(@d, confirm, Answer),
send(@d, destroy),!.
destroy(Answer) :- send(@takeweak, destroy).