(FILECREATED "23-Sep-84 18:38:56" {ERIS}<LISPUSERS>TREEDISPLAY.;15 11857
changes to: (VARS TREEDISPLAYCOMS)
(FNS ABOVE)
previous date: "21-AUG-83 04:35:59" {PHYLUM}<LISPUSERS>TREEDISPLAY.;13)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TREEDISPLAYCOMS)
(RPAQQ TREEDISPLAYCOMS [(FNS NODEPOSITION PARSE TREELAYOUT)
(FNS GRAPHNODE EDITTREE ABOVE)
(FNS DISPLAYTREENODE MAKETREE TREEDISPLAY TREEREGION)
(RECORDS LAYOUT NODE)
(VARS S1 S2 S3 SENTENCELIST)
(FILES (FROM <LISPUSERS>)
LATTICER)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA PARSE)
(NLAML)
(LAMA])
(DEFINEQ
(NODEPOSITION
[LAMBDA (N XORIGIN YTOP NTFONT) (* rmk: "24-JUN-81 18:18")
(DECLARE (USEDFREE NODELIST XSPACER YSPACER TERMY))
[PROG (XC RDL FDL XADJ DIFF SW SW/2 (NL (fetch LAYOUT of N)))
[COND
[NL (COND
([OR (NULL (fetch LABELPOS of NL))
(IGREATERP YTOP (fetch YCOORD of (fetch LABELPOS of NL]
(* Pick the lowest occurrence of a multiply-appearing
node)
(RETURN]
(T (SETQ NL (replace LAYOUT of N with (create LAYOUT]
(SETQ SW (STRINGWIDTH (fetch (NODE LABEL) of N)
NTFONT))
(SETQ SW/2 (LRSH SW 1))
(COND
[(fetch DAUGHTERS of N)
[for D (ORIG ← XORIGIN) in (fetch DAUGHTERS of N)
do (NODEPOSITION D ORIG (IDIFFERENCE YTOP YSPACER)
NTFONT)
(SETQ ORIG (IPLUS XSPACER (fetch RIGHTEDGE of (fetch LAYOUT of D]
(replace LABELPOS of NL
with (create POSITION
XCOORD ←(SETQ XC
(LRSH [IPLUS [fetch XCOORD
of (fetch LABELPOS
of (SETQ FDL
(fetch LAYOUT
of (CAR (fetch DAUGHTERS of N]
(fetch XCOORD
of (fetch LABELPOS
of (SETQ RDL
(fetch LAYOUT
of (CAR (LAST (fetch DAUGHTERS
of N]
1))
YCOORD ← YTOP))
(COND
[(IGREATERP (SETQ DIFF (IDIFFERENCE XORIGIN (IDIFFERENCE XC SW/2)))
(SETQ XADJ (fetch XADJUST of FDL)))
(replace XADJUST of NL with DIFF)
(replace RIGHTEDGE of NL with (IPLUS DIFF (IMAX (IPLUS XC SW/2)
(fetch RIGHTEDGE of RDL]
(T (replace XADJUST of NL with XADJ)
(replace RIGHTEDGE of NL with (IMAX (IPLUS XC SW/2)
(fetch RIGHTEDGE of RDL]
(T (create LAYOUT smashing NL LABELPOS ←(create POSITION
XCOORD ←(IPLUS XORIGIN SW/2)
YCOORD ← YTOP)
XADJUST ← 0 RIGHTEDGE ←(IPLUS XORIGIN SW]
(SETQ TERMY (IMIN TERMY YTOP])
(PARSE
[NLAMBDA SENTENCE (* lmm "25-JUN-81 01:37")
(SETQ SENTENCE (U-CASE SENTENCE))
(for X (MAX ← 0)
L TREE in SENTENCELIST when (IGREATERP [SETQ L (LENGTH (INTERSECTION SENTENCE (CAR X]
MAX)
do (SETQ MAX L)
(SETQ TREE (CDR X))
finally (COND
(TREE (RETURN TREE))
(T (printout T T "Sorry, couldn't parse that sentence." T T])
(TREELAYOUT
[LAMBDA (N NTFONT TFONT XSPACER YSPACER) (* rmk: "18-OCT-81 00:40")
(DECLARE (SPECVARS XSPACER YSPACER))
(OR TFONT (SETQ TFONT NTFONT))
(OR XSPACER (SETQ XSPACER (STRINGWIDTH " " TFONT)))
[OR YSPACER (SETQ YSPACER (ITIMES 3 (FONTPROP NTFONT (QUOTE HEIGHT]
(PROG (NODELIST (TERMY 0))
(DECLARE (SPECVARS TERMY NODELIST)) (* The Y coordinate of the lowest terminal)
(NODEPOSITION N 0 0 NTFONT) (* 0,0 is the upper left corner)
(RETURN (CONS TERMY NODELIST])
)
(DEFINEQ
(GRAPHNODE
[LAMBDA (N XADJ MOTHER) (* rrb "28-JAN-82 17:30")
(DECLARE (USEDFREE TERMY BOTTOM))
(PROG (LP (NL (fetch LAYOUT of N)))
(SETQ LP (fetch LABELPOS of NL))
(SETQ XADJ (IPLUS XADJ (fetch XADJUST of NL)))
(push GRAPHLIST (LNODECREATE N (fetch (NODE LABEL) of N)
(create POSITION
XCOORD ←(IPLUS XADJ (fetch XCOORD of LP))
YCOORD ←(COND
((fetch DAUGHTERS of N)
(IDIFFERENCE (fetch YCOORD of LP)
TERMY))
(T BOTTOM)))
(fetch DAUGHTERS of N)
MOTHER NTFONT)) (* This makes terminals line up on the bottom)
(SETQ MOTHER (CONS N))
(for D [DXA ←(IMAX 0 (IDIFFERENCE XADJ (OR [fetch XADJUST
of (fetch LAYOUT
of (CAR (fetch DAUGHTERS of N]
0]
in (fetch DAUGHTERS of N) do (GRAPHNODE D DXA MOTHER])
(EDITTREE
[LAMBDA (N NTFONT TFONT XSPACER YSPACER) (* hts: "21-AUG-83 04:32")
(DECLARE (SPECVARS XSPACER YSPACER))
(PROG ((LAYOUT (TREELAYOUT N [OR NTFONT (SETQ NTFONT (DEFAULTFONT (QUOTE DISPLAY]
TFONT XSPACER YSPACER))
TERMY BOTTOM LAYOUT NODELIST GRAPHLIST)
(DECLARE (SPECVARS TERMY NODELIST GRAPHLIST BOTTOM))
(* The Y coordinate of the lowest terminal)
(SETQ BOTTOM (FONTPROP (OR TFONT NTFONT)
(QUOTE HEIGHT)))
(SETQ TERMY (IDIFFERENCE (CAR LAYOUT)
BOTTOM))
(SETQ NODELIST (CDR LAYOUT))
(GRAPHNODE N 0)
(EDITLATTICE (DREVERSE GRAPHLIST))
(RETURN (QUOTE DONE])
(ABOVE
[LAMBDA (POSITION1 POSITION2) (* edited: "23-Sep-84 18:33")
(OR (type? POSITION POSITION1)
(\ILLEGAL.ARG POSITION1))
(OR (type? POSITION POSITION2)
(\ILLEGAL.ARG POSITION2))
(IGREATERP (fetch (POSITION YCOORD) of POSITION1)
(fetch (POSITION YCOORD) of POSITION2])
)
(DEFINEQ
(DISPLAYTREENODE
[LAMBDA (N DS XADJ) (* rmk: "18-OCT-81 00:40")
(DECLARE (USEDFREE TERMY ROOTY))
(PROG (LP (NL (fetch LAYOUT of N))
(FONT (DSPFONT NIL DS)))
(SETQ LP (fetch LABELPOS of NL))
(SETQ XADJ (IPLUS XADJ (fetch XADJUST of NL)))
(MOVETO (IPLUS XADJ (IDIFFERENCE (fetch XCOORD of LP)
(LRSH (STRINGWIDTH (fetch (NODE LABEL) of N)
FONT)
1)))
(COND
((fetch DAUGHTERS of N)
(IPLUS ROOTY (fetch YCOORD of LP)))
(T TERMY))
DS) (* This makes terminals line up on the bottom)
(PRIN3 (fetch (NODE LABEL) of N)
DS)
(for D DLP [DXA ←(IMAX 0 (IDIFFERENCE XADJ
(OR [fetch XADJUST
of (fetch LAYOUT
of (CAR (fetch DAUGHTERS of N]
0]
in (fetch DAUGHTERS of N)
do (SETQ DLP (fetch LABELPOS of (fetch LAYOUT of D)))
(DRAWLINE (IPLUS XADJ (fetch XCOORD of LP))
(IDIFFERENCE (IPLUS ROOTY (fetch YCOORD of LP))
(LLSH (FONTPROP FONT (QUOTE DESCENT))
1))
(IPLUS (IPLUS DXA (fetch XADJUST of (fetch LAYOUT of D)))
(fetch XCOORD of DLP))
(IPLUS (COND
((fetch DAUGHTERS of D)
(IPLUS ROOTY (fetch YCOORD of DLP)))
(T TERMY))
(FONTPROP FONT (QUOTE HEIGHT)))
NIL NIL DS)
(* Add an extra descent on the bottom, cause there is in fact an extra one on the top of captial letters for such
things as "|")
(DISPLAYTREENODE D DS DXA])
(MAKETREE
[LAMBDA (TREESPEC) (* rmk: "16-APR-81 19:14")
(create NODE
LABEL ←(COND
((ATOM TREESPEC)
TREESPEC)
(T (CAR TREESPEC)))
DAUGHTERS ←(for X in (CDR TREESPEC) collect (MAKETREE X])
(TREEDISPLAY
[LAMBDA (N DS XSPACER YSPACER) (* rmk: "18-OCT-81 00:40")
(DECLARE (SPECVARS XSPACER YSPACER)
(GLOBALVARS TREEDSP))
(OR DS (SETQ DS TREEDSP))
(PROG [TERMY LAYOUT NODELIST (LAYOUT (TREELAYOUT N (DSPFONT NIL DS)
NIL XSPACER YSPACER))
(ROOTY (IDIFFERENCE (fetch TOP of (DSPCLIPPINGREGION NIL DS))
(FONTPROP DS (QUOTE HEIGHT]
(DECLARE (SPECVARS TERMY NODELIST ROOTY)) (* The Y coordinate of the lowest terminal)
(SETQ TERMY (CAR LAYOUT))
(SETQ NODELIST (CDR LAYOUT))
(DSPRESET DS) (* ROOTY is so tree coordinates don't know about window
size.)
(SETQ TERMY (IPLUS TERMY ROOTY))
(DISPLAYTREENODE N DS 0)
NIL])
(TREEREGION
[LAMBDA NIL (* bvm: " 6-AUG-81 23:42")
(SETQ TREEDSP (WINDOWPROP (CREATEW)
(QUOTE DSP])
)
[DECLARE: EVAL@COMPILE
(RECORD LAYOUT (LABELPOS XADJUST . RIGHTEDGE)
(SYSTEM))
(RECORD NODE (LABEL . DAUGHTERS)
[ACCESSFNS NODE (LAYOUT (CDR (FASSOC DATUM NODELIST))
(CDAR (push NODELIST (CONS DATUM NEWVALUE]
(SYSTEM))
]
(RPAQQ S1 (S (NP (John))
(VP (left))))
(RPAQQ S2 [S (NP (DET (The))
(N (man)))
(AUX (has))
(VP (V (told))
(NP (PRO (us)))
(VPBAR (to)
(VP (V (leave])
(RPAQQ S3 [S [NP [DET (NP (DET (NP (PRO (My)))
(N (uncle's]
(N (story))
(PP (P (about))
(NP (DET (the))
(N (war]
(AUX (M (will)))
(VP (V (bore))
(NP (PRO (you)))
(PP (P (to))
(NP (N (tears])
(RPAQQ SENTENCELIST [[(PROGRAMMING AND PERFORMANCE TOOLS IN INTERLISP-D WILL AMAZE YOU)
S
[NP (N (N (ADJ (ADJ (Programming))
(CONJ (and))
(ADJ (performance)))
(N (tools)))
(PP (PREP (in))
(NP (NPROP (Interlisp-D]
(VP (V (AUX (will))
(VINF (amaze)))
(NP (PRON (you]
[(MY UNCLE'S STORY ABOUT THE WAR WILL BORE YOU TO TEARS)
S
[NP [DET (NP (DET (NP (PRO (My)))
(N (uncle's]
(N (story))
(PP (P (about))
(NP (DET (the))
(N (war]
(AUX (M (will)))
(VP (V (bore))
(NP (PRO (you)))
(PP (P (to))
(NP (N (tears]
((THE MAN HAS TOLD US TO LEAVE)
S
(NP (DET (The))
(N (man)))
(AUX (has))
(VP (V (told))
(NP (PRO (us)))
(VPBAR (to)
(VP (V (leave])
(FILESLOAD (FROM <LISPUSERS>)
LATTICER)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA PARSE)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS TREEDISPLAY COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (721 4303 (NODEPOSITION 731 . 3143) (PARSE 3145 . 3636) (TREELAYOUT 3638 . 4301)) (4304
6674 (GRAPHNODE 4314 . 5428) (EDITTREE 5430 . 6287) (ABOVE 6289 . 6672)) (6675 10004 (DISPLAYTREENODE
6685 . 8582) (MAKETREE 8584 . 8886) (TREEDISPLAY 8888 . 9815) (TREEREGION 9817 . 10002)))))
STOP