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