(FILECREATED "14-Aug-84 10:43:30" {ERIS}<SPEECH>LEXICON>DISPLAYENTITY.;2 28648
changes to: (FNS DTREEPRINT LAYOUTCONSTITUENT)
previous date: " 9-Aug-84 14:08:35" {PHYLUM}<LFG>PARSER>DISPLAYENTITY.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DISPLAYENTITYCOMS)
(RPAQQ DISPLAYENTITYCOMS ((* This file contains D-dependent facilities for displaying LFG entities,
trees, etc.)
(FNS GRNODEFROMCONST DTREEPRINT LAYOUTCONTINUATIONS)
(FNS ATTRIBUTEWIDTH ATTRIBUTEREGION CURLYBRACKETS DISPLAYENTITY
DISPLAYENTITY.FS DISPLAYENTITY.PH DISPLAYENTITY.SET DISPLAYENTITY.VARS
DRAWLOOP ENTITYSIZE VARCOLWIDTH SQUAREBRACKETS)
(FNS LAYOUTCONSTITUENT LAYOUTCONSTITUENT1)
(IGNOREDECL . T)))
(* This file contains D-dependent facilities for displaying LFG entities, trees, etc.)
(DEFINEQ
(GRNODEFROMCONST
[DLAMBDA ((C CONSTITUENT)
TREE)
(* rmk: "12-AUG-82 13:07")
(* Finds the graph node in TREE corresponding to the
constituent C.)
(find R in (fetch GRAPHNODES of TREE) suchthat (EQ (CAR (fetch NODEID of R))
C))])
(DTREEPRINT
[DLAMBDA ((C CONSTITUENT)
(CS# (ONEOF NIL FIXP))
(WINDOW))
(* edited: "13-Aug-84 23:04")
[PROG (WIDTH (NEWTREE (LAYOUTCONSTITUENT C CS#)))
(COND
[(WINDOWPROP WINDOW (QUOTE CONSTITUENTS)) (* Not the first tree)
(for N RIGHT (REG ←(WINDOWPROP WINDOW (QUOTE EXTENT)))
(OLDGRAPH ←(WINDOWPROP WINDOW (QUOTE GRAPH)))
first (SETQ RIGHT (IPLUS 10 (fetch (REGION RIGHT) of REG)))
(* Right is the right edge of the current graph and the
left edge of the new tree)
in (fetch GRAPHNODES of NEWTREE) do (add (fetch XCOORD of (fetch NODEPOSITION
of N))
RIGHT)
finally [WINDOWPROP WINDOW (QUOTE EXTENT)
(UNIONREGIONS REG (SETQ REG (GRAPHREGION NEWTREE]
[WINDOWPROP WINDOW (QUOTE GRAPH)
(create GRAPH using OLDGRAPH GRAPHNODES ←(NCONC (fetch
GRAPHNODES
of NEWTREE)
(fetch
GRAPHNODES
of OLDGRAPH]
(WINDOWADDPROP WINDOW (QUOTE CONSTITUENTS)
C)
(COND
((ILEQ RIGHT (fetch (REGION RIGHT) of (DSPCLIPPINGREGION NIL WINDOW)))
(REDISPLAYGRAPH WINDOW REG]
(T (OR (COMPLETEP C)
(LAYOUTCONTINUATIONS NEWTREE C))
(WINDOWADDPROP WINDOW (QUOTE CONSTITUENTS)
C)
[COND
((NULL CS#) (* A subconstituent from the chart)
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (LENGTH (GETPARSES CHART))
" foot structures"]
(SHOWGRAPH NEWTREE WINDOW (FUNCTION SHOWFDESC)
(FUNCTION SHOWFSTRUC)
T]])
(LAYOUTCONTINUATIONS
[DLAMBDA ((TREE)
(C CONSTITUENT (SATISFIES ~(COMPLETEP C))))
(* rmk: " 8-NOV-83 22:42")
[PROG (XPOS YPOS FINALINDICATOR CNODES (REG (GRAPHREGION TREE))
(LF (DSPLINEFEED NIL TREEFILE)))
(SETQ XPOS (IPLUS (fetch (REGION RIGHT) of REG)
(STRINGWIDTH " " CSTRUCTUREFONT)))
[SETQ YPOS (fetch YCOORD of (fetch NODEPOSITION
of (GRNODEFROMCONST [CAR (CAR (fetch TONODES
of (GRNODEFROMCONST C TREE]
TREE]
[COND
((fetch FINALP of (fetch STATE of C))
(SETQ FINALINDICATOR (LIST (create GRAPHNODE
NODEID ←(CONCAT "*")
NODELABEL ← "*"
NODEPOSITION ←(create POSITION
XCOORD ←(IPLUS
XPOS
(LRSH (STRINGWIDTH "*"
CSTRUCTUREFONT)
1))
YCOORD ←(PROG1 YPOS
(add YPOS LF)))
NODEFONT ← CSTRUCTUREFONT]
(SETQ CNODES (for ARC in (fetch ARCSET of (fetch STATE of C))
collect (create GRAPHNODE
NODEID ← ARC
NODELABEL ←(fetch (NETWORK NETWORKNAME)
of (fetch LABEL of ARC))
NODEPOSITION ←(create
POSITION
XCOORD ←(IPLUS XPOS
(LRSH (STRINGWIDTH (fetch (NETWORK
NETWORKNAME)
of (fetch LABEL
of ARC))
CSTRUCTUREFONT)
1))
YCOORD ←(PROG1 YPOS (add YPOS LF)))
NODEFONT ← CSTRUCTUREFONT)))
(replace GRAPHNODES of TREE with (NCONC FINALINDICATOR CNODES (fetch GRAPHNODES
of TREE]])
)
(DEFINEQ
(ATTRIBUTEWIDTH
[LAMBDA (ATTR FONT) (* rmk: "30-Jun-84 23:18")
(DECLARE (GLOBALVARS LFGSMALLFONT))
(COND
((type? PLACEHOLDER ATTR)
(IPLUS (STRINGWIDTH " " FONT)
(STRINGWIDTH (fetch P# of ATTR)
LFGSMALLFONT)))
(T (STRINGWIDTH ATTR FONT])
(ATTRIBUTEREGION
[DLAMBDA ((PAIR FSPAIR)
FONT
(LEFT FIXP)
(BOTTOM FIXP))
(* rmk: "30-Jul-84 18:38")
(* Decides if the f-name in PAIR is a placeholder or a simple symbol and returns a REGION record which specifies
the region in which the f-name is contained.)
(DECLARE (GLOBALVARS LFGSUBOFFSET))
[COND
[(type? PLACEHOLDER (fetch FNAME of PAIR)) (* for f-names which are placeholders)
(CREATEREGION LEFT [DIFFERENCE BOTTOM (PLUS LFGSUBOFFSET (FONTPROP FONT (QUOTE DESCENT]
(ATTRIBUTEWIDTH (GETGROUNDENTITY (fetch FNAME of PAIR)
FONT))
(PLUS LFGSUBOFFSET (ADD1 (FONTPROP FONT (QUOTE HEIGHT]
(T (* for f-names which are simple symbols)
(CREATEREGION LEFT (DIFFERENCE BOTTOM (FONTPROP FONT (QUOTE DESCENT)))
(ATTRIBUTEWIDTH (GETGROUNDENTITY (fetch FNAME of PAIR)
FONT))
(ADD1 (FONTPROP FONT (QUOTE HEIGHT]])
(CURLYBRACKETS
[DLAMBDA ((WIDTH FIXP)
(LEFT FIXP (* This and other dimensions specify the bounding box
that the brackets lie within))
(TOP FIXP)
(RIGHT FIXP)
(BOTTOM FIXP)
(STUBWIDTH FIXP (* The depth of the center stub)))
(* rmk: " 8-Feb-84 10:22")
(PROG ((HEIGHT (DIFFERENCE TOP BOTTOM))
(SHORTSTROKE (TIMES WIDTH 5))) (* Start the left bracket)
(BITBLT NIL NIL NIL NIL LEFT (DIFFERENCE TOP WIDTH)
SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL LEFT BOTTOM SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE) (* Start the right bracket)
(BITBLT NIL NIL NIL NIL (DIFFERENCE RIGHT SHORTSTROKE)
(DIFFERENCE TOP WIDTH)
SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL (DIFFERENCE RIGHT WIDTH)
BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL (DIFFERENCE RIGHT SHORTSTROKE)
BOTTOM SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE) (* Do the center strokes)
(BITBLT NIL NIL NIL NIL (DIFFERENCE LEFT STUBWIDTH)
(PLUS BOTTOM (QUOTIENT HEIGHT 2))
STUBWIDTH WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL RIGHT (PLUS BOTTOM (QUOTIENT HEIGHT 2))
STUBWIDTH WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE))])
(DISPLAYENTITY
[DLAMBDA ((E (ONEOF ENTITY MEANING LISTP ENTITYCELL))
(INDEXONLY BOOL)
(RETURNS FIXP (* The bottom of the bounding box occupied by E)))
(* rmk: "30-Jul-84 18:10")
(* Fix definition of ENTITY to include MEANING;
LISTP is to allow the QP values
(lists of "subscripts") NIL)
(* Displays an entity. On return, the Yposition of the stream is set at the baseline of characters that would be
vertically centered within the bounding box of E, and the Xposition is the right edge of the bounding box.)
(DECL (RESULT SOLVERESULT (BOUNDIN PPENTITY)))
(SETQ E (GETGROUNDENTITY E))
(PROG ((BOTTOM (DSPYPOSITION)))
(SELTYPEQ E
[FSTRUCTURE (COND
[INDEXONLY (printout NIL "[" (CAR (VARS.OF.VALUE E RESULT)))
[PROG [(PRED (EXISTP.AE E (QUOTE PRED]
(AND (type? SEMANTICFORM PRED)
(printout NIL ":" (fetch FN of PRED]
(PRIN1 "]")
(RETURN (DIFFERENCE BOTTOM (FONTPROP NIL (QUOTE DESCENT]
[(fetch PRINTED of E)
[COND
((type? POSITION (fetch PRINTED of E))
(DRAWLOOP (create POSITION
XCOORD ←(DSPXPOSITION)
YCOORD ←(DSPYPOSITION))
(fetch PRINTED of E)))
[(EQ T (fetch PRINTED of E))
(* First internal cycle)
(replace PRINTED of E with (LIST (create POSITION
XCOORD ←(
DSPXPOSITION)
YCOORD ←(
DSPYPOSITION]
(T (* Cyclical encounter--PRINTED is a list of positions)
(push (fetch PRINTED of E)
(create POSITION
XCOORD ←(DSPXPOSITION)
YCOORD ←(DSPYPOSITION]
(RETURN (DIFFERENCE BOTTOM (FONTPROP NIL (QUOTE DESCENT]
(T (replace PRINTED of E with T)
(RETURN (PROG1 (DISPLAYENTITY.FS E)
(for K in (fetch PRINTED of E)
do (* draw loops for internal cycles)
(HELP "Call Atty for cyclical printing"))
(replace PRINTED of E
with (create POSITION
XCOORD ←(DSPXPOSITION)
YCOORD ←(DSPYPOSITION]
(SEMANTICFORM (printout NIL "'" (GETGROUNDENTITY (fetch FN of E)))
(COND
((fetch ARGS of E)
(PRIN1 "<")
[for ATAIL on (fetch ARGS of E)
do (SETQ BOTTOM (IMIN BOTTOM (DISPLAYENTITY (CAR ATAIL)
T)))
(COND
((CDR ATAIL)
(PRIN1 ", "]
(PRIN1 ">")))
[COND
((fetch NOTARGS of E)
(for ATAIL on (fetch NOTARGS of E)
do (SETQ BOTTOM (IMIN BOTTOM (DISPLAYENTITY (CAR ATAIL)
T)))
(COND
((CDR ATAIL)
(PRIN1 ", "]
(PRIN1 "'"))
[SET (COND
[(OR INDEXONLY (fetch PRINTED of E))
(printout NIL "{" (CAR (VARS.OF.VALUE E RESULT))
"}")
(RETURN (DIFFERENCE BOTTOM (FONTPROP (DSPFONT)
(QUOTE DESCENT]
(T (replace PRINTED of E with T)
(RETURN (DISPLAYENTITY.SET E]
(PLACEHOLDER (RETURN (DISPLAYENTITY.PH E)))
[MEANING (RETURN (PPSEMENTITY (GETGROUNDENTITY E]
(PRIN1 E))
(RETURN BOTTOM))])
(DISPLAYENTITY.FS
[DLAMBDA ((E FSTRUCTURE)
(RETURNS FIXP))
(* rmk: "30-Jul-84 18:14")
(* Called with Xposition set to left edge of box to be occupied and Yposition set to the baseline of a character
whose top (ASCENT) would line up with the top of the box. Value is the bottom of the bounding box, and on return
the Xposition is set to the right end of the bounding box and the Yposition is set to the baseline of a character
that would be centered vertically within the bounding box. This makes the PRIN1 case in PPENTITY be simple.)
(DPROG ((FSRIGHT NIL (* The maximum xposition of the fstructure contents))
(BOXBOTTOM NIL (* The bottom of the bounding box))
(BOXLEFT (DSPXPOSITION) (* Left end of the bounding box))
(FONT (DSPFONT))
THEN (ASCENT (FONTPROP FONT (QUOTE ASCENT)))
THEN (BOXTOP (PLUS ASCENT (DSPYPOSITION)) (* Top of the box that the f-structure
(with brackets) fits in))
(BRACKETWIDTH (COND
((EQ (FONTPROP FONT (QUOTE WEIGHT))
(QUOTE BOLD))
2)
(T 1)))
THEN (BRACKETMARGIN (LLSH BRACKETWIDTH 1) (* The margin for bracket plus internal white space))
THEN (FSLEFT (PLUS BOXLEFT BRACKETWIDTH BRACKETMARGIN)
(* Left margin for the attributes of the f-structure
f-structure. BRACKETWIDTH spaces between variable and
bracket, BRACKETMARGIN spaces to attributes column.
NIL))
(FSTOP (DIFFERENCE (DIFFERENCE BOXTOP BRACKETWIDTH)
BRACKETMARGIN) (* Top of the internal region of the f-structure
f-structure. White space above and below the bracket
NIL)))
(DSPYPOSITION (DIFFERENCE FSTOP ASCENT))
[for PAIR [VALPOS ←(PLUS FSLEFT (STRINGWIDTH " " FONT)
(for PAIR inpairs (fetch PAIRS of E)
largest (PLUS (ATTRIBUTEWIDTH (GETGROUNDENTITY (fetch FNAME
of PAIR)
FONT))
(VARCOLWIDTH (GETGROUNDENTITY (fetch FVALUE
of PAIR))
FONT))
finally (RETURN (OR $$EXTREME 0]
in (REVERSEFSPAIRS (fetch PAIRS of E))
do (DSPXPOSITION VALPOS)
(SETQ BOXBOTTOM (DISPLAYENTITY (fetch FVALUE of PAIR)))
(* Value of DISPLAYENTITY is the bottom of the bounding box. It leaves the Xposition at the right-most edge of the
bounding box, and the Yposition at the base line of characters that would be vertically centered within the
bounding box.)
[COND
((OR (NULL FSRIGHT)
(IGREATERP (DSPXPOSITION)
FSRIGHT))
(SETQ FSRIGHT (DSPXPOSITION]
(DSPXPOSITION FSLEFT)
[SETQ BOXBOTTOM (IMIN BOXBOTTOM (DISPLAYENTITY (fetch FNAME of PAIR]
(* It's probably safe to assume that the name is not as
low as the value, but ...)
[COND
((fetch UNGOVERNED of PAIR)
(DSPFILL (ATTRIBUTEREGION PAIR FONT FSLEFT (DSPYPOSITION))
BLACKSHADE
(QUOTE INVERT]
(DSPYPOSITION (PLUS BOXBOTTOM (DSPLINEFEED]
(DISPLAYENTITY.VARS E BOXBOTTOM BOXLEFT FONT)
(SQUAREBRACKETS BRACKETWIDTH (DIFFERENCE FSLEFT BRACKETMARGIN)
(DIFFERENCE BOXTOP BRACKETWIDTH)
(PLUS FSRIGHT BRACKETMARGIN)
(SETQ BOXBOTTOM (DIFFERENCE BOXBOTTOM BRACKETMARGIN)))
(MOVETO (PLUS FSRIGHT BRACKETMARGIN BRACKETWIDTH)
(QUOTIENT (PLUS BOXTOP (DIFFERENCE BOXBOTTOM ASCENT))
2))
(RETURN (DIFFERENCE BOXBOTTOM BRACKETWIDTH)))])
(DISPLAYENTITY.PH
[DLAMBDA ((E PLACEHOLDER))
(* rmk: "16-DEC-82 14:17")
(DECLARE (GLOBALVARS LFGSUBOFFSET))
(RELDRAWTO (STRINGWIDTH " " (DSPFONT))
0
(COND
((EQ (FONTPROP (DSPFONT)
(QUOTE WEIGHT))
(QUOTE BOLD))
2)
(T 1)))
(RELMOVETO 2 0)
(LFGSUBSCRIPT (fetch P# of E))
(IDIFFERENCE (DSPYPOSITION)
LFGSUBOFFSET)])
(DISPLAYENTITY.SET
[DLAMBDA ((E SET)
(RETURNS FIXP))
(* rmk: "22-Jul-84 17:07")
(* Called with Xposition set to left edge of box to be occupied and Yposition set to the baseline of a character
whose top (ASCENT) would line up with the top of the box. Value is the bottom of the bounding box, and on return
the Xposition is set to the right end of the bounding box and the Yposition is set to the baseline of a character
that would be centered vertically within the bounding box. This makes the PRIN1 case in DISPLAYENTITY be simple.)
[COND
[(for ELT in (fetch ELEMENTS of E) always (type? (ONEOF SYMBOL IVARIABLE)
(GETGROUNDENTITY ELT)))
(* The IVARIABLE is probably only for sets of semantic
variables, which probably should be symbols anyway)
(PRIN1 "{")
(for ELT FLG in (fetch ELEMENTS of E)
do (COND
(FLG (SPACES 1))
(T (SETQ FLG T)))
(PRIN1 (GETGROUNDENTITY ELT)))
(PRIN1 "}")
(DIFFERENCE (DSPYPOSITION)
(FONTPROP (DSPFONT)
(QUOTE DESCENT]
(T (DPROG ((BOXBOTTOM NIL (* The bottom of the bounding box))
(BOXLEFT (DSPXPOSITION) (* Left end of the bounding box))
(FONT (DSPFONT))
THEN (ASCENT (FONTPROP FONT (QUOTE ASCENT)))
THEN (BOXTOP (PLUS ASCENT (DSPYPOSITION)) (* Top of the box that the f-structure
(with brackets) fits in))
(BRACKETWIDTH (COND
((EQ (FONTPROP FONT (QUOTE WEIGHT))
(QUOTE BOLD))
2)
(T 1)))
THEN (BRACKETMARGIN (TIMES BRACKETWIDTH 2) (* The margin for bracket plus internal white space))
(BRACKETSTUBWIDTH (TIMES BRACKETWIDTH 5))
THEN (SETLEFT (PLUS BOXLEFT BRACKETWIDTH BRACKETMARGIN BRACKETSTUBWIDTH)
(* Leftmargin for the leftmost element))
(SETTOP (DIFFERENCE BOXTOP (PLUS BRACKETWIDTH BRACKETMARGIN))
(* Top of the internal region of the set.
White space above and below the bracket))
THEN (SETRIGHT SETLEFT (* The maximum xposition of the set contents))
(SETBOTTOM SETTOP (* The minimum yposition of all the elements)))
(for ELT TEMP [ELTPOS ←(PLUS SETLEFT (for EE in (fetch ELEMENTS of E)
largest (VARCOLWIDTH (GETGROUNDENTITY EE)
FONT)
finally (RETURN $$EXTREME]
in (fetch ELEMENTS of E)
do [MOVETO ELTPOS (DIFFERENCE SETBOTTOM (COND
(TEMP (* Second thru Nth)
(PLUS ASCENT ASCENT))
(T ASCENT]
(SETQ SETBOTTOM (DISPLAYENTITY ELT))
(AND (LESSP SETRIGHT (SETQ TEMP (DSPXPOSITION)))
(SETQ SETRIGHT TEMP)))
(SETQ BOXBOTTOM (DIFFERENCE SETBOTTOM BRACKETMARGIN))
(DISPLAYENTITY.VARS E BOXBOTTOM BOXLEFT FONT)
(CURLYBRACKETS BRACKETWIDTH (DIFFERENCE SETLEFT BRACKETMARGIN)
(DIFFERENCE BOXTOP BRACKETWIDTH)
(PLUS SETRIGHT BRACKETMARGIN)
BOXBOTTOM BRACKETSTUBWIDTH)
(MOVETO (PLUS SETRIGHT BRACKETMARGIN BRACKETWIDTH BRACKETSTUBWIDTH)
(QUOTIENT (PLUS BOXTOP (DIFFERENCE BOXBOTTOM ASCENT))
2))
(RETURN (DIFFERENCE BOXBOTTOM BRACKETWIDTH)))]])
(DISPLAYENTITY.VARS
[DLAMBDA ((E ENTITY)
(BOTTOM)
(RIGHT)
(FONT))
(* rmk: "26-May-84 17:02")
(* Displays the column of variables for E in FONT
flushright against RIGHT and sitting on BOTTOM)
(DECL (RESULT SOLVERESULT (BOUNDIN PPENTITY)))
(DSPYPOSITION BOTTOM)
[for V in (VARS.OF.VALUE E RESULT)
do (DSPXPOSITION (DIFFERENCE RIGHT (STRINGWIDTH V FONT)))
(PRIN1 V)
(DSPYPOSITION (DIFFERENCE (DSPYPOSITION)
(DSPLINEFEED]])
(DRAWLOOP
[LAMBDA (P1 P2) (* edited: " 4-Jul-84 17:04")
(PROG [(YDIFF (DIFFERENCE (fetch YCOORD of P2)
(fetch YCOORD of P1]
(DRAWCURVE (LIST P1 (create POSITION
XCOORD ←(fetch XCOORD of P2)
YCOORD ←(PLUS (fetch YCOORD of P1)
(QUOTIENT YDIFF 8)))
(create POSITION
XCOORD ←(PLUS (fetch XCOORD of P2)
(QUOTIENT YDIFF 2))
YCOORD ←(PLUS (fetch YCOORD of P1)
(QUOTIENT YDIFF 2)))
P2)
NIL NIL)
(MOVETO (fetch XCOORD of P1)
(fetch YCOORD of P1])
(ENTITYSIZE
[DLAMBDA ((E ENTITY)
(INDEXONLY BOOL)
(RETURNS (LISTP (WHOSE (CAR FIXP)
(CDR FIXP)))))
(* rmk: "19-Apr-84 17:51" posted: " 8-JUN-82 00:26")
(* Returns a pair containing the width and height of the
box that would enclose the entity E)
[SELTYPEQ E
[FSTRUCTURE (COND
[(OR INDEXONLY (fetch PRINTED of E))
(CONS (IPLUS (STRINGWIDTH "[")
[STRINGWIDTH (OR (fetch INDEX of E)
(replace INDEX of E
with (add FSTRUCTUREINDEX# 1]
(STRINGWIDTH "]"))
(FONTPROP NIL (QUOTE HEIGHT]
(T (replace PRINTED of E with T)
(for PAIR VALSIZE (MAXNAMEWIDTH ← 0)
(MAXVALWIDTH ← 0)
(MAXVALHEIGHT ← 0) inpairs (fetch PAIRS of E)
do [SETQ MAXNAMEWIDTH (IMAX MAXNAMEWIDTH
(STRINGWIDTH (fetch FNAME of PAIR]
(SETQ VALSIZE (ENTITYSIZE (fetch FVALUE of PAIR)))
(SETQ MAXVALWIDTH (IMAX MAXVALWIDTH (CAR VALSIZE)))
(SETQ MAXVALHEIGHT (IMAX MAXVALHEIGHT (CDR VALSIZE)))
finally (RETURN (CONS (IPLUS (STRINGWIDTH "[")
MAXNAMEWIDTH MAXVALWIDTH
(ITIMES 4 (STRINGWIDTH " "))
(STRINGWIDTH "]"))
(IMAX MAXVALHEIGHT (FONTPROP NIL
(QUOTE HEIGHT]
[SEMANTICFORM (CONS (IPLUS (STRINGWIDTH "'")
(STRINGWIDTH (fetch FN of E))
[COND
((fetch ARGS of E)
(IPLUS (STRINGWIDTH "<")
[for ATAIL on (fetch ARGS of E)
sum (IPLUS (CAR (ENTITYSIZE (CAR ATAIL)
T))
(COND
((CDR ATAIL)
(STRINGWIDTH ", "))
(T 0]
(STRINGWIDTH ">"]
(STRINGWIDTH "'"))
(FONTPROP NIL (QUOTE HEIGHT]
[SET (for ETAIL TEMP (W ← 0)
(H ← 0) on (fetch ELEMENTS of E)
do (SETQ TEMP (ENTITYSIZE (CAR ETAIL)))
(add W (CAR TEMP)
(COND
((CDR ETAIL)
(STRINGWIDTH " "))
(T 0)))
(SETQ H (IMAX H (CDR TEMP)))
finally (RETURN (CONS (IPLUS (STRINGWIDTH "{")
W
(STRINGWIDTH "}"))
H]
(CONS (STRINGWIDTH E)
(FONTPROP NIL (QUOTE HEIGHT]])
(VARCOLWIDTH
[DLAMBDA ((E ENTITY)
(FONT)
(RETURNS CARDINAL))
(* rmk: "31-May-84 21:41")
(* Returns the maximum width of the variable column for
E)
(DECL (RESULT SOLVERESULT (BOUNDIN PPENTITY)))
(SELTYPEQ E
[(ONEOF FSTRUCTURE SET)
(COND
((fetch PRINTED of E)
0)
(T (for V inside (VARS.OF.VALUE E RESULT) largest (STRINGWIDTH V FONT)
finally (RETURN $$EXTREME]
0)])
(SQUAREBRACKETS
[DLAMBDA ((WIDTH FIXP)
(LEFT FIXP (* This and other dimensions specify the bounding box
that the brackets lie within))
(TOP FIXP)
(RIGHT FIXP)
(BOTTOM FIXP))
(* rmk: "15-DEC-82 11:29")
(PROG ((HEIGHT (IDIFFERENCE TOP BOTTOM))
(SHORTSTROKE (ITIMES WIDTH 5))) (* Start the left bracket)
(BITBLT NIL NIL NIL NIL LEFT (IDIFFERENCE TOP WIDTH)
SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL LEFT BOTTOM SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE) (* Start the right bracket)
(BITBLT NIL NIL NIL NIL (IDIFFERENCE RIGHT SHORTSTROKE)
(IDIFFERENCE TOP WIDTH)
SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL (IDIFFERENCE RIGHT WIDTH)
BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE)
(BITBLT NIL NIL NIL NIL (IDIFFERENCE RIGHT SHORTSTROKE)
BOTTOM SHORTSTROKE WIDTH (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE))])
)
(DEFINEQ
(LAYOUTCONSTITUENT
[DLAMBDA ((C CONSTITUENT)
(CS# (ONEOF NIL FIXP)))
(* edited: "13-Aug-84 23:31")
(DECLARE (GLOBALVARS CSTRUCTUREFONT))
(DPROG (CAPTION ROOTID ROOTPOS
(RESULT NIL (USEDIN LAYOUTCONSTITUENT1)))
(SETQ ROOTID (LAYOUTCONSTITUENT1 C))
(SETQ RESULT (LAYOUTGRAPH RESULT (LIST ROOTID)
(QUOTE VERTICAL)
CSTRUCTUREFONT
[FIX (TIMES CSTRUCTUREMOTHERD (FONTPROP CSTRUCTUREFONT
(QUOTE HEIGHT]
[FIX (TIMES CSTRUCTUREPERSONALD (FONTPROP CSTRUCTUREFONT
(QUOTE HEIGHT]
NIL))
[COND
(CS# (SETQ ROOTPOS (fetch NODEPOSITION of (GRNODEFROMCONST C RESULT)))
(* Put C-structure # as a pseudo-node centered above the
root.)
(SETQ CAPTION (CONCAT (COND
((EQ CURRENTVERSION (QUOTE FOOT))
"Foot structure ")
(T "C-structure "))
CS#))
(push (fetch GRAPHNODES of RESULT)
(NODECREATE CAPTION CAPTION (create POSITION
XCOORD ←(fetch XCOORD of ROOTPOS)
YCOORD ←(IPLUS (fetch YCOORD of ROOTPOS)
(LLSH (FONTHEIGHT
CSTRUCTUREFONT)
1)))
NIL NIL CSTRUCTUREFONT]
(RETURN RESULT))])
(LAYOUTCONSTITUENT1
[DLAMBDA ((C CONSTITUENT)
(RETURNS (ONEOF NIL (LISTP OF CONSTITUENT)) (* NIL if avoiding empty nodes, otherwise something to
serve as a graph NODEID)))
(* rmk: " 8-Aug-84 16:57")
(DECLARE (USEDFREE RESULT)
(GLOBALVARS NOPRINTEMPTYNODES TERMINALFONT)) (* Listing the NODEID insures that there is no confusion
if the same physical node appears in two trees.)
[COND
((NOT (AND NOPRINTEMPTYNODES (EMPTYCONSTITUENTP C)))
(fetch NODEID of (CAR (push RESULT (COND
((type? TERMNODE C)
(NODECREATE (LIST C)
(NODELABEL C)
NIL NIL NIL TERMINALFONT))
(T (* LISTing the terminal suppresses graph boxing)
(NODECREATE (LIST C)
(NODELABEL C)
NIL
(for D indaughters C when (SETQ D (
LAYOUTCONSTITUENT1
D))
do (push $$VAL D))
NIL CSTRUCTUREFONT]])
)
(DECLARE: DOEVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(RESETSAVE COMPILEIGNOREDECL (QUOTE T))
)
(PUTPROPS DISPLAYENTITY COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (887 4981 (GRNODEFROMCONST 897 . 1334) (DTREEPRINT 1336 . 3183) (LAYOUTCONTINUATIONS
3185 . 4979)) (4982 25955 (ATTRIBUTEWIDTH 4992 . 5330) (ATTRIBUTEREGION 5332 . 6455) (CURLYBRACKETS
6457 . 8301) (DISPLAYENTITY 8303 . 11976) (DISPLAYENTITY.FS 11978 . 15978) (DISPLAYENTITY.PH 15980 .
16437) (DISPLAYENTITY.SET 16439 . 20181) (DISPLAYENTITY.VARS 20183 . 20836) (DRAWLOOP 20838 . 21514) (
ENTITYSIZE 21516 . 23967) (VARCOLWIDTH 23969 . 24574) (SQUAREBRACKETS 24576 . 25953)) (25956 28473 (
LAYOUTCONSTITUENT 25966 . 27364) (LAYOUTCONSTITUENT1 27366 . 28471)))))
STOP