/* ***************************************************************************

    PROGRAM NAME : 'cg_print'                AUTHOR : Chris Mitchell
    VERSION      : 1.0                       LAST REVISED : 30-JUL-87
    FRIL VERSION : 3.0

**************************************************************************** */

/* default width of display */

((right_margin 80))

/* 'set_width' allows the right margin to be altered, which enables
   the display to be fitted to any width of screen/paper */

((set_width _New_right)
        (kill right_margin)
        (addcl ((right_margin _New_right)) ))

((print G|X)  (resume) (get_gname G G2) (print2 G2|X))
((print2 G |X) (abstr prototype P L G) (pp2) (p2 prototype for P) 
               (gprint2 L G X))
((print2 G |X) (abstr schema S L G) (pp2) (p2 schema for S) (gprint2 L G X))
((print2 G |X) (abstr individual T ('#' N) G) (pp2) (p2 individual T)
                       (gprint2 ('#' N) G X))
((print2 G |X) (abstr individual T (I) G) (pp2) (p2 individual T)
                       (gprint2 (I) G X))
((print2 G |X) (abstr actor A (L1 L2) G) (pp2) (p2 actor A) (p2 '(in ')
               (pplist L1) (p2 ';out ') (pplist L2) (p2 ') is') (cgprint G X))
((print2 G |X) (abstr _Type T L G) (pp2) (p2 _Type T) (gprint2 L G X))
((print2 _Type) (sub _Type _) (type _Type))

((gprint2 () G X)  (p2 ' is') (cgprint G X))
((gprint2 L G X)   (p2 '(') (pplist L) (p2 ')' is) (cgprint G X))

((pplist (_Param)) (p2 _Param) (!))
((pplist ('#' L))  (p2 '#') (p2 L) (!))
((pplist (H|T))    (p2 H) (p2 ',') (pplist T))

/* 'cgprint' displays a conceptual graph in Sowa's linear form
   (ref Sowa, J.F. (1984) "Conceptual Structures", Addison Wesley).
   A head concept type can be optionally specified */

((cgprint G ())
        (cgprint2 G _ _))
((cgprint G (conc T R))
        (conc G N T R _ _)
        (cgprint2 G conc N))
((cgprint G (reln T R))
        (reln G N T R _ _)
        (cgprint2 G reln N))

((cgprint2 G T N)
        (pp2)
        (errm n)
        (kill indent_values)
        (addcl ((indent_values 4 4)))
        (kill max_indent)
        (addcl ((max_indent 0 0)))
        (kill depth_count)
        (addcl ((depth_count 0)))
        (kill max_depth)
        (addcl ((max_depth 0)))
        (kill ascii_value)
        (addcl ((ascii_value 96)))
        (kill xref)
        (kill printed)
        (kill pstr)
        (kill tabv)
        (kb_garbage)
        (pc '    ' 0)
        (pcgraph G T N)
        (pc '.' 1)
        (right_margin _Max_width)
        (max_indent _Width _Last_indent)
        (display_graph _Max_width _Width _Last_indent)
        (kill printed)
        (kb_garbage)
        (!))

((pcgraph G reln N)  (reln G N _ _ () (R) ) (prelnode G N _ _) (!)
                     (pconlink G () () () (R) ))
((pcgraph G conc 1)  (conc G 1 _ _ _ _) (pconcept G 1 () () P) (!)
                     (prlink G 1 P))
((pcgraph G conc N)  (conc G N _ _ _ _) (pconcept G N () () P) (!)
                     (prlink G N P))
((pcgraph G reln N)  (reln G N _ _ L R) (prelnode G N _ _) (!)
                     (pconlink G () () L R))

((prlink G N E)           (kb_garbage) (conc G N _ _ L R)
                          (prfilter G L () L2) (prfilter G R () R2) (!)
                                                  (prlink2 G N E L2 R2))
((prlink2 _ _ _ () () )   (!) (update_max_indents))
((prlink2 G C E () (N) )  (prelarc right G C N L) (prelnode G N _ R) (!)
                          (pconlink G E () L R))
((prlink2 G C E (N) () )  (prelarc left G C N R) (prelnode G N L _) (!)
                          (pconlink G E () L R))
((prlink2 G C E L R)      (pc ' -' 2) (pupdated D T) (prlist G C E L R D T)
                          (!) (pcommadot G))

((pconlink _ _ _ () () )   (!) (update_max_indents) (kb_garbage))
((pconlink G E F () (N) )  (pconarc right N N2) (pconcept G N2 E F P)
                           (pconlink2 G N2 P))
((pconlink G E F (N) () )  (pconarc left N N2) (pconcept G N2 E F P)
                           (pconlink2 G N2 P))
((pconlink G E F L R)      (pc ' -' 2) (pupdated D T) (pconlist G E F L R D T)
                           (!) (pcommadot G))
((pconlink2 _ _ leaf)      (!) (update_max_indents))
((pconlink2 G N P)         (prlink G N P))

((prlist G C E L R D T)       (pfindcons G C L R () F)
                              (prlist2 right G C E F R D T)
                              (prlist2 left G C E F L D T))
((prlist2 _ _ _ _ _  ()   _ _))
((prlist2 A G C E F (N|M) D T)  (reln G N K | _) (negg printed G N)
                                (pnewline D T) (prlist3 K A G C N)
                                (prelnode G N L R) (!)
                                (pcfilter _ C L L2) (pcfilter _ C R R2) (!)
                                (pconlink G E F L2 R2) (!) 
                                (prlist2 A G C E F M D T) (!))
((prlist2 A G C E F (_|M) D T)  (prlist2 A G C E F M D T))
((prlist3 rel _ _ _ _))
((prlist3 act A G C N)          (prelarc A G C N _))

((pconlist G E F L R D T)       (appendcons 0 L F F1)(appendcons 0 R F1 F2)
                                (pconlist2 right G E F2 R D T)
                                (pconlist2 left G E F2 L D T))
((pconlist2 _ _ _ _  ()   _ _))
((pconlist2 A G E F (N|M) D T)  (pnewline D T) (pconarc A N N2)
                                (pconcept G N2 E F P) (!) (pconlist3 G N2 P)
                                (pconlist2 A G E F M D T))
((pconlist3 _ _ leaf)           (!))
((pconlist3 G N P)              (prlink G N P))

((prelarc left G C N R)   (reln G N _ _ _ R2) (pcfilter A C R2 R)
                          (parc left A) (!))
((prelarc right G C N L)  (reln G N _ _ L2 _) (pcfilter A C L2 L)
                          (parc right A) (!))

((pconarc D (A N) N)  (parc D A) (!))
((pconarc D N N)      (parc D 0))

((parc left 0)   (pleftarrow) (pc ' ' 1)(!))
((parc left A)   (pleftarrow) (pc '{' 1) (pc A) (pc '}- ' 3))
((parc right 0)  (pc ' ' 1) (prightarrow) (!))
((parc right A)  (pc ' -{' 3) (pc A) (pc '}' 1) (prightarrow))

((pleftarrow)  (pc ' <-' 3))
((prightarrow) (pc '-> ' 3))

((pcommadot G)  (reln G N _ _ _ _) (negg printed G N) (pc ',' 1) (!))
((pcommadot _))

/* 'pconcept' is the top level predicate for displaying concepts */

/* first pconcept rule is temporary fix to improve readability */

((pconcept G N _ _ leaf)
        (conc G N T (?|R) _ _)		/* ================*/
        (conc G N2 _ ('%') _ _)
        (negg printed G N2)
        (!)
        (pconcept2 G N))

((pconcept G N (_|_) _ leaf)
        (conc G N T (M|R) _ _)
        (member ('*' _Param) R)
        (!)
        (addcl ((xref G N _Param)) )
        (pc_type T)
        (pc_ref (M|R)))
((pconcept G N E _ leaf)
        (member N E)
        (pconcept2 G N)
        (!))
((pconcept G N E F P)
        (pconcept3 G N)
        (append (N|E) F P))

((pconcept2 G N)
        (xref G N _Param)
        (!)
        (pconcept4 G N _Param))
((pconcept2 G N)
        (gen_xref G _Param)
        (addcl ((xref G N _Param)) )
        (pconcept4 G N _Param))

((pconcept3 G N)
        (xref G N _Param)
        (pconcept4 G N _Param))
((pconcept3 G N)
        (conc G N _Type _Ref L R)
        (pconcept5 _Type _Ref L R))

((pconcept4 G N _Param)
        (conc G N _Type _Ref _ _)
        (append _Ref (('*' _Param)) _New_ref)
        (pc_type _Type)
        (pc_ref _New_ref))

((pconcept5 '+' L () () )        (!) (pgraphlist L))
((pconcept5 '+' L _ _)           (!) (pc '[ ' 2) (pgraphlist L) (pc ' ]' 2))
((pconcept5 '-' L _ _)           (!) (pc 'NOT' 3)
                                 (pc '[ ' 2) (pgraphlist L) (pc ' ]' 2))
((pconcept5 (name) (M|R) _ _)    (!) (pc '[' 1) (pindref R) (pc_mark M)
                                 (pc ']' 1))
((pconcept5 _Type _Ref _ _)      (pc_type _Type) (pc_ref _Ref))

((pgraphlist (G) )    (pcgraph G _ _))
((pgraphlist (G|T) )  (pcgraph G _ _) (pc '  ' 2) (pgraphlist T))

((pc_type _Type)            (pc '[' 1) (pc_type2 _Type))

((pc_type2 (_Type_label) )       (pc _Type_label))
((pc_type2 (lambda L G) )        (pc 'lambda ' 7) (pc L) (pc ' ' 1)
                                 (pcgraph G _ _) (pc ' ' 1))
((pc_type2 _Subrange)            (pc_flat _Subrange))

/* 'pc_ref' displays the referent when a single name, or a set of
   names */

((pc_ref ('%'))            (pc ']' 1))
((pc_ref (_Mark | _Ref) )  (pc ':' 1) (pindref _Ref) (pc_mark _Mark) (pc ']' 1))

((pindref () )     (!))
((pindref (R) )    (pc_flat R) (!))
((pindref (H|T) )  (pc_flat H) (pc '=' 1) (pindref T))

((pc_flat (cgr G) )  (pc ' ' 1) (pcgraph G _ _) (pc ' ' 1) )
((pc_flat () ))
((pc_flat (H|T) )    (pc_flat H) (pc_flat T) (!))
((pc_flat R)         (pc R))

((pc_mark '%'))
((pc_mark _Mark)  (pc _Mark 1))

/* 'prelnode' displays a relation or actor */

((prelnode G N L R)         (reln G N A B L R) (addcl ((printed G N)) )
                            (prelnode2 A B))
((prelnode2 rel _Relation)  (pc '(' 1) (pc _Relation) (pc ')' 1) (!))
((prelnode2 act _Actor)     (pc '<<' 1) (pc _Actor) (pc '>>' 1) (!))

((greater A B) (less B A))

((prfilter _ () L1 L2)     (revlist L1 () L2))
((prfilter G (N|T) L1 L2)  (printed G N) (!) (prfilter G T L1 L2))
((prfilter G (N|T) L1 L2)  (prfilter G T (N|L1) L2))

((pcfilter A C L L2) (delete (A C) L L2) (!))
((pcfilter 0 C L L2) (delete C L L2) (!))
((pcfilter nil _ L L))

((pupdated D T)
        (depth_count _Old_depth)
        (sum _Old_depth 1 D)
        (update_max_depth D)
        (indent_values T _))

/* 'pfindcons' constructs a list of all concepts in graph G which are one
   relation link away from the current concept. To allow for relations/actors
   with multiple inputs, [] -> () <- [] links are considered. Duplicates
   are removed */


((pfindcons G N L R () F)  (pfindcons2 G N L () F2) (pfindcons2 G N R F2 F))

((pfindcons2 _ N () F F))
((pfindcons2 G N (H|T) F1 F)  (reln G H _ _ L R) (appendcons N L F1 F2) 
                              (appendcons N R F2 F3) (pfindcons2 G N T F3 F))

((appendcons _ () F F))
((appendcons N ((_ N)|T) F F2)  (appendcons N T F F2) (!))
((appendcons N ((_ C)|T) F F2)  (member C F) (appendcons N T F F2) (!))
((appendcons N ((_ C)|T) F F2)  (appendcons N T (C|F) F2) (!))
((appendcons N (N|T) F F2)      (appendcons N T F F2))
((appendcons N (C|T) F F2)      (member C F) (appendcons N T F F2))
((appendcons N (C|T) F F2)      (appendcons N T (C|F) F2))

/* 'gen_xref' returns the next suitable cross referent from the 
   sequence '*a', '*b' etc */

((gen_xref G _Char)
        (repeat)
        (delcl ((ascii_value _Old)))
        (sum _Old 1 _Ascii)
        (addcl ((ascii_value _Ascii)))
        (charof _Char _Ascii)
        (check_xref G _Char))

((check_xref G C)
        (conc G _ _ (_|R) _ _)
        (member ('*' C) R)
        (!)
        (fail))
((check_xref _ _))

/* 'update_max_indents' keeps track of the maximum width of the
   display to date, and the indent width of the last level -
   this information is used by 'redraw' above to determine
   whether to re-display the graph */

((update_max_indents)
        (indent_values _Width _Last_indent)
        (max_indent _Max_indent _)
        (less _Max_indent _Width)
        (kill max_indent)
        (addcl ((max_indent _Width _Last_indent)) )
        (!))
((update_max_indents))

/* 'update_max_depth' keeps track of the number of levels of depth
   used to display the graph (used by 'check_width' above) */

((update_max_depth _Depth)
        (max_depth _Max_depth)
        (less _Max_depth _Depth)
        (kill max_depth)
        (addcl ((max_depth _Depth)) ))
((update_max_depth _))

((pnewline _Depth _Tab_value)
        (kill depth_count)
        (addcl ((depth_count _Depth)) )
        (kill indent_values)
        (addcl ((indent_values _Tab_value 0)) )
        (addcl ((pstr '$')) )
        (addcl ((tabv _Depth _Tab_value)) ))

/* 'pc' and 'pc_list' perform a "print and count" function to keep track
   of the width of the display. 'pc' is used for a single token of known
   or unknown length, 'pc_list' for lists of tokens */

((pc (not X) )  (!) (pcnotsym) (addcl ((pstr X)) ) ("prlen" X L)
                (add_indent L))
((pc '<*')      (!) (addcl ((pstr '{')) ) (add_indent 1))
((pc '*>')      (!) (addcl ((pstr '}')) ) (add_indent 1))
((pc X)         (addcl ((pstr X)) ) ("prlen" X2 L) (add_indent L))
((pc X L)       (addcl ((pstr X)) ) (add_indent L))

((pcnotsym)  (pc 'NOT' 3))

/* 'add_indent' adds the length of the printed string to the indent
   values */

((add_indent L)
        (delcl ((indent_values N1 N2)) )
        (sum N1 L N3)
        (sum N2 L N4)
        (addcl ((indent_values N3 N4)) ))

((display_graph _Max_width _Width _)
        (less _Width _Max_width)
        (pstring 0)
        (!))
((display_graph _Max_width _ _Last_indent)
        (less _Last_indent _Max_width)
        (max_depth _Max_depth)
        (negg eq _Max_depth 0)
        (sum W2 5 _Max_width)
        (sum W3 _Last_indent W2)
        (division W3 _Max_depth _Tab_width)
        (negg eq _Tab_width 0)
        (pstring _Tab_width)
        (!))
((display_graph _ _ _)
        (pp2 'reformatting required here (eventually)...')(pp2)
        (pstring 0))

((pstring _Tab_width)
        (cl ((pstr|_)) )
        (delcl ((pstr|X)) )
        (tab_check X _Tab_width))
((pstring _)
        (pp2))

((tab_check ('$') _Tab_width)
        (!)
        (delcl ((tabv _Depth _Tab_value)) )
        (pp2)
        (tab_control _Tab_width _Depth _Tab_value))
((tab_check X _)
        (snips ptok X)
        (fail))

((ptok (X))       (p2 X))
((ptok (X1 X2) )  (palt X1 X2))

/* 'tab_control' controls the indentation of each level of the graph being
   displayed.  The first rule handles the case where proportional
   spacing is being used, the second rule handles the case where the
   indent value for each level is specified as '_Tab_width' */

((tab_control 0 _ _Tab_value)
        (pspaces2 _Tab_value)
        (!)
        (fail))
((tab_control _Tab_width _Depth _)
        (times _Depth _Tab_width T1)
        (sum T1 4 T2)
        (pspaces2 T2)
        (fail))

/* ************************************************************** */