home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / LIB / DISPLAY_.LF < prev    next >
Text File  |  1996-06-04  |  5KB  |  235 lines
  1. %    $Id: display_terms.lf,v 1.2 1994/12/08 23:57:07 duchier Exp $    
  2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3. %
  4. % A little program to display psi_terms, using the X toolkit
  5. %
  6. % input: display_terms ?
  7. %        To have an example psi-term displayed: display_example ?
  8. %        To display a term from the prompt: show_term(Term) ?
  9. %
  10. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  11.  
  12. module("display_terms") ?
  13.  
  14. public(display_terms,show_term,display_example) ?
  15.  
  16. import("xtools") ?
  17.  
  18.  
  19. :: txt(h_space => 0,v_space => 0).
  20. txt <| text_box.
  21.  
  22.  
  23. %%% main call
  24.  
  25. setq(begin,1) ?
  26. display_terms :-
  27.     (
  28.         catch(begin),
  29.         same_size([ B1:text_field_button(text => 
  30.            T:"Just enter a Psi Term and type return to have it displayed",
  31.                                     action => show_psi(T)),
  32.             B2:push_button(action => throw(begin),text => "Quit")]),
  33.           create_box(panel(title => "ShowPsi") containing 
  34.                        vc_list([B1,v_box(5),B2]))
  35.     ;
  36.         succeed
  37.     ).
  38.  
  39. show_psi(T) :-
  40.     Y = parse(T),
  41.     Z = evalin(Y),
  42.     show_term(Z).
  43.  
  44.  
  45. %%% show_term creates a panel displaying a psi term
  46.  
  47. show_term(Term) :-
  48.     TermBox = build_psi(Term),
  49.     create_box(P:panel(title => "Psi",color_id => psi4) 
  50.                    containing TermBox).        
  51.     
  52. build_psi(X) ->
  53.     B
  54.     |
  55.         mark_corefs(Y:copy_term(X)),
  56.     B = build_psi2(Y).
  57.  
  58.  
  59. %%% first pass: marking coreferences
  60.  
  61. mark_corefs(X) :-
  62.     cond( has_feature(coref,X,C),
  63.         cond( C :== false,
  64.             C <- true(genint)
  65.         ),
  66.         (
  67.         X.coref = false,
  68.         mark_new_coref(X)
  69.         )
  70.     ).
  71.  
  72. mark_new_coref(X) :-
  73.     mark_corefs_features(features(X),X).
  74.  
  75. mark_corefs_features([coref|B],X) :-
  76.     !,
  77.     mark_corefs_features(B,X).
  78. mark_corefs_features([A|B],X) :-
  79.     !,
  80.     mark_corefs(X.A),
  81.     mark_corefs_features(B,X).
  82. mark_corefs_features([]).
  83.         
  84.  
  85. %%% second pass: displaying the term
  86.  
  87. build_psi2(X) -> 
  88.     frame containing 
  89.     cond( C:(X.coref),
  90.  
  91.         txt(text=> strcon("C",int2str(C.1)),
  92.                  text_color_id => psi3)
  93.  
  94.             t_left_of
  95.         cond(has_feature(displayed,X),
  96.              null_box,
  97.          h_box(5) c_left_of 
  98.                 display_coreferred(X&@(displayed => true))
  99.             ),
  100.  
  101.         display_coreferred(X&@(displayed => true))
  102.     ).
  103.  
  104.  
  105. feature_boxes([displayed|T],SB) -> feature_boxes(T,SB).
  106. feature_boxes([coref|T],SB) -> feature_boxes(T,SB).
  107. feature_boxes([H|T],SB) -> 
  108.     [ssize( box
  109.                 containing txt(text=>psi2str(H),font_id => medium)
  110.                        c_left_of
  111.                    txt(text => " => ",font_id => medium),
  112.             SB)| feature_boxes(T,SB)].
  113. feature_boxes([]) -> [].
  114.  
  115. ssize(A,B) -> A | same_size([A,B]).
  116.  
  117.  
  118. display_coreferred(X) -> B |
  119.         (
  120.         is_legal_cons(X), 
  121.         !,
  122.         L = build_list(X),
  123.         B = txt(text => "list",text_color_id=>psi2)
  124.             l_above
  125.             v_box(5)
  126.             l_above
  127.             array(L,
  128.               cond(F:sqrt(length(L)) :< int,
  129.                   F,
  130.               floor(F)+1)
  131.               )
  132.     ;
  133.         B=build_root(X)
  134.     ).
  135.  
  136. private_marker(X) -> X:==coref or X:==displayed.
  137.  
  138. purge([]) -> [].
  139. purge([H|T]) -> cond(private_marker(H),purge(T),[H|purge(T)]).
  140.  
  141. is_legal_cons(X) :-
  142.      X :== cons,
  143.     F=purge(features(X)),
  144.     (F=[1,2];F=[2,1]),
  145.     ! .
  146.  
  147.     
  148. build_list(X) -> B |
  149.     B=[build_psi2(X.1) | Rest ],
  150.     T=X.2,
  151.     (
  152.         T.coref,
  153.         !,
  154.         Rest=[h_box(5) c_left_of frame(width => 5,height => H)
  155.             c_left_of h_box(5) c_left_of
  156.               build_psi2(T) & @(height => H)]
  157.     ;
  158.         T:==[],
  159.         purge(features(T))=[],
  160.         !,
  161.         Rest=[]
  162.     ;
  163.         is_legal_cons(T),
  164.         !,
  165.         Rest=build_list(T)
  166.     ;
  167.         Rest=[h_box(5) c_left_of frame(width => 5,height => H)
  168.             c_left_of h_box(5) c_left_of
  169.               build_psi2(T) & @(height => H)]
  170.     ).
  171.  
  172. build_root(X) ->
  173.         txt(text=>psi2str(root_sort(X)),
  174.         text_color_id => psi2)
  175.     l_above
  176.         v_box(5)
  177.         l_above
  178.         vl_list build_features(X,F:features(X),feature_boxes(F,null_box)).
  179.  
  180.  
  181.  
  182. build_features(X,[displayed|T],FB) ->
  183.     build_features(X,T,FB).
  184. build_features(X,[coref|T],FB) ->
  185.     build_features(X,T,FB).
  186. build_features(X,[H|T],[Box|FB]) ->
  187.         [ h_box(-d_border) c_left_of
  188.           Box
  189.           t_left_of
  190.       build_psi2(project(H,X))
  191.     | build_features(X,T,FB)].
  192.        
  193. build_features(X,[]) -> [].
  194.  
  195. %%% colors used
  196.  
  197. def_color(main_colors,psi2,red) ?
  198. def_color(main_colors,psi3,blue) ?
  199. def_color(main_colors,psi4,'light grey') ?
  200. def_color(shade_colors,psi4,'dim grey') ?
  201. def_color(highlight_colors,psi4,white) ?
  202.  
  203.  
  204. %%% utility
  205.  
  206. public(catch) ?
  207. non_strict(catch) ?
  208. catch(A) :- C = get_choice, setq(A,C).
  209.  
  210. public(throw) ?
  211. throw(A) :- set_choice(A), fail.
  212.  
  213.  
  214. %%% examples
  215.  
  216. display_example :- 
  217.     show_term(`big(T:tom(hair => knotted,
  218.                              hands => clumsy,
  219.                  brain => slow_witted,
  220.                  friend => {jeremy(skin => black_and_blue,
  221.                            known_letters => 
  222.                                [a,b,c,y,t,w,i,o],
  223.                                brain => hurts);
  224.                         martha(brain => plank(number => 2,
  225.                                           length => short),
  226.                            beauty => gorgon_like)
  227.                        },
  228.                      nose => long(warts => red,
  229.                                           spots => ugly),
  230.                  mother => W:witch(son => T,husband => F),
  231.                  father => F:tax_collector(wife => W,son => T)
  232.                   )
  233.               )
  234.          ).
  235.