comparison disp.pl @ 19:e1d3145cff7a lite-verifier

*** empty log message ***
author kono
date Thu, 30 Aug 2007 12:44:35 +0900
parents 1c57a78f1d98
children 07d6c4c5654b
comparison
equal deleted inserted replaced
18:a6adedccd5f6 19:e1d3145cff7a
28 next(X,Y) :- tk_do_one_event(0),!, 28 next(X,Y) :- tk_do_one_event(0),!,
29 next(X,Y). 29 next(X,Y).
30 30
31 display :- 31 display :-
32 init_display,!, 32 init_display,!,
33 event_loop(run). 33 event_loop(run),
34 tcl_exit.
35
36 tcl_exit :-
37 tcl(X),tcl_delete(X),retract(tcl(X)).
38
39 tcl_name(L,Name) :-
40 concatenate(L,L1),
41 name(Name,L1).
42
43 concatenate([],[]).
44 concatenate([H|T],X) :- atomic(H),!,
45 name(H,List),concatenate(T,X1),append(List,X1,X).
46 concatenate([H|T],X) :- H=[_|_],
47 concatenate(T,X1),append(H,X1,X).
48
49 tcl_eval(E) :- atomic(E),!,
50 tcl(Tcl),tcl_eval(Tcl,E,_).
51 tcl_eval(E) :- E=[_|_],tcl_name(E,N),
52 tcl(Tcl),tcl_eval(Tcl,N,_).
34 53
35 init_display :- 54 init_display :-
36 (retract(r_event(_,_)),fail;true), 55 (retract(r_event(_,_)),fail;true),
37 tk_init('lite',[]), 56 tk_new([name('Lite Verifier')], Tcl),
57 assert(tcl(Tcl)),
38 % tcl_eval('source disp.tcl'), 58 % tcl_eval('source disp.tcl'),
39 tcl_eval('source xf-disp'), 59 tcl_eval('source xf-disp'),
40 all_disable. 60 all_disable.
41 canvas_origin(20,20). 61 canvas_origin(20,20).
42 62
76 ex(X2),!, 96 ex(X2),!,
77 ttyflush, display_statistics, 97 ttyflush, display_statistics,
78 all_enable. 98 all_enable.
79 verify(_) :- 99 verify(_) :-
80 all_disable. 100 all_disable.
101
81 display_contents(X) :- 102 display_contents(X) :-
82 ttyflush,t2strings(X,XS0),easy_pp(XS0,XS), 103 ttyflush,t2string(X,XS0),easy_pp(XS0,XS),
83 tcl_eval('$symbolicName(entry) delete 0.0 end'), 104 tcl_eval('$symbolicName(entry) delete 0.0 end'),
84 tcl_eval(['$symbolicName(entry) insert 0.0 {',XS,'}']), 105 tcl_eval(['$symbolicName(entry) insert 0.0 {',XS,'}']),
85 display_update. 106 display_update.
86 107
87 all_disable :- 108 all_disable :-