reduce-historical/psl-1983/3-1/glisp/grtree.old

(FILECREATED "15-JAN-83 16:03:58" {DSK}GRTREE.LSP;11 7426   

      changes to:  (FNS STRINGDATA-DRAW TREEELEMENT-DRAWIN BOXTYPE-DRAW BOXTYPE-ERASE DRAWRECTANGLE 
			GRAPHICSBOX-DRAWIN GRAPHICSBOX-ERASEIN MATCHTREE RECTANGLESIZE 
			BOXTYPE-SETSIZE GRAPHICSTREE-BOXTYPE GRAPHICSTREE-WIDTH)
		   (VARS GRTREECOMS GRAPHICSBOXTYPES)
		   (PROPS (RECTANGLE SIZEPROGRAM)
			  (RECTANGLE DRAWPROGRAM))

      previous date: "13-JAN-83 10:32:08" {DSK}GRTREE.LSP;1)


(PRETTYCOMPRINT GRTREECOMS)

(RPAQQ GRTREECOMS [(GLISPOBJECTS BOXTYPE GRAPHICSBOX GRAPHICSTREE LISPGRAPHICSTREE LISPNODEDISPLAY 
				 TREEELEMENT)
		   (FNS BOXTYPE-DRAW BOXTYPE-ERASE BOXTYPE-SETSIZE DRAWRECTANGLE GRAPHICSBOX-DRAWIN 
			GRAPHICSBOX-ERASEIN MATCHTREE RECTANGLESIZE STRINGDATA-DRAW 
			TREEELEMENT-DRAWIN)
		   (GLISPGLOBALS GRAPHICSBOXTYPES)
		   (PROP DRAWPROGRAM RECTANGLE)
		   (PROP SIZEPROGRAM RECTANGLE)
		   (VARS GRAPHICSBOXTYPES)
		   (GLOBALVARS GRAPHICSBOXTYPES)
		   (P (LOAD? (QUOTE VECTOR.LSP])


[GLISPOBJECTS


(BOXTYPE

   (ATOM (PROPLIST (DRAWPROGRAM ATOM)
		   (SIZEPROGRAM ATOM)))

   MSG    ((DRAW BOXTYPE-DRAW OPEN T)
	   (ERASE BOXTYPE-ERASE OPEN T)
	   (SETSIZE BOXTYPE-SETSIZE OPEN T))  )

(GRAPHICSBOX

   (LISTOBJECT (BOXTYPE BOXTYPE)
	       (START VECTOR)
	       (SIZE VECTOR)
	       (CONTENTSOFFSET VECTOR)
	       (DISPLAYCONTENTS ANYTHING)
	       (CONTENTSSIZE VECTOR))

   MSG    [(DRAWIN GRAPHICSBOX-DRAWIN OPEN T)
	   (ERASEIN GRAPHICSBOX-ERASEIN OPEN T)
	   (SETSIZE ((SEND BOXTYPE SETSIZE self]

   SUPERS (REGION)  )

(GRAPHICSTREE

   ANYTHING

   PROP   ((BOXTYPE (BOXTYPENAME)
		    RESULT BOXTYPE))

   MSG    ((MAKEGRAPHICSTREE MATCHTREE)
	   (DRAW GRAPHICSTREE-DRAW)
	   (TERMINAL? (self IS TERMINAL)))  )

(LISPGRAPHICSTREE

   (LISTOBJECT (EXPR ANYTHING))

   PROP   ((BOXTYPENAME ((QUOTE RECTANGLE)))
	   [BOXCONTENTS ((IF EXPR IS ATOMIC THEN EXPR ELSE (CAR EXPR]
	   (BOXDISPLAYCONTENTS ((A LISPNODEDISPLAY WITH CONTENTS = BOXCONTENTS)))
	   (SUCCESSORS [(IF EXPR IS ATOMIC THEN NIL ELSE (FOR X IN (CDR EXPR)
							      COLLECT
							      (A LISPGRAPHICSTREE WITH EXPR = X]
		       RESULT
		       (LISTOF LISPGRAPHICSTREE)))

   ADJ    ((TERMINAL (EXPR IS ATOMIC)))

   SUPERS (GRAPHICSTREE)  )

(LISPNODEDISPLAY

   (LISTOBJECT (CONTENTS ANYTHING))

   PROP   [(DISPLAYSIZE ((A VECTOR WITH X = (NCHARS CONTENTS)
			    *8 Y = 12]

   MSG    ((DRAW STRINGDATA-DRAW))  )

(TREEELEMENT

   (LISTOBJECT (BOX GRAPHICSBOX)
	       (ORIGINALNODE ANYTHING)
	       (SUCCESSORS (LISTOF TREEELEMENT))
	       (DISPLAYSIZE VECTOR))

   PROP   ((DISPLAYWIDTH (DISPLAYSIZE:X))
	   (DISPLAYHEIGHT (DISPLAYSIZE:Y)))

   MSG    ((DRAWIN TREEELEMENT-DRAWIN))  )
]

(DEFINEQ

(BOXTYPE-DRAW
  (GLAMBDA (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX W:WINDOW)        (* GSN "14-JAN-83 12:58")
	   (APPLY* BOXTYPE:DRAWPROGRAM BOX (QUOTE PAINT)
		   W)))

(BOXTYPE-ERASE
  (GLAMBDA (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX W:WINDOW)        (* GSN "14-JAN-83 12:58")
	   (APPLY* BOXTYPE:DRAWPROGRAM BOX (QUOTE ERASE)
		   W)))

(BOXTYPE-SETSIZE
  (GLAMBDA (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX)                 (* GSN "14-JAN-83 09:52")
	   (BOX:CONTENTSSIZE _(SEND BOX:DISPLAYCONTENTS DISPLAYSIZE))
	   (APPLY* BOXTYPE:SIZEPROGRAM BOX)))

(DRAWRECTANGLE
  (GLAMBDA (BOX:GRAPHICSBOX DSPOP:ATOM W:WINDOW)             (* GSN "14-JAN-83 13:01")
	   (PROG (OLDDS)
	         (OLDDS _(CURRENTDISPLAYSTREAM W))
	         (DSPOPERATION DSPOP)
	         (MOVETO BOX:LEFT BOX:BOTTOM)
	         (DRAWTO BOX:LEFT BOX:TOP)
	         (DRAWTO BOX:RIGHT BOX:TOP)
	         (DRAWTO BOX:RIGHT BOX:BOTTOM)
	         (DRAWTO BOX:LEFT BOX:BOTTOM)
	         (CURRENTDISPLAYSTREAM OLDDS))))

(GRAPHICSBOX-DRAWIN
  (GLAMBDA (BOX:GRAPHICSBOX W:WINDOW)                        (* GSN "14-JAN-83 12:55")
	   (SEND BOX:BOXTYPE DRAW BOX W)))

(GRAPHICSBOX-ERASEIN
  (GLAMBDA (BOX:GRAPHICSBOX W:WINDOW)                        (* GSN "14-JAN-83 12:55")
	   (SEND BOX:BOXTYPE ERASE BOX W)))

(MATCHTREE
  (GLAMBDA (TR)                                              (* GSN "14-JAN-83 10:46")
                                                             (* Build a TREEELEMENT structure to match the given tree
							     TR.)
	   (RESULT TREEELEMENT)
	   (PROG (TE SUM)
	         [TE _(A TREEELEMENT WITH ORIGINALNODE = TR BOX =(A GRAPHICSBOX WITH BOXTYPE =(SEND
								      TR BOXTYPE)
								    DISPLAYCONTENTS =(SEND TR 
									       BOXDISPLAYCONTENTS))
			 SUCCESSORS =(FOR X IN (SEND TR SUCCESSORS) COLLECT (SEND X MAKEGRAPHICSTREE]
	         (SEND TE:BOX SETSIZE)
	         (TE:DISPLAYWIDTH _(IF (SEND TR TERMINAL?)
				       THEN TE:BOX:WIDTH + 10
				     ELSE (SUM_0)
					  (FOR X IN TE:SUCCESSORS DO SUM_+X:DISPLAYWIDTH)
					  (MAX (TE:BOX:WIDTH + 10)
					       SUM)))
	         [TE:DISPLAYHEIGHT _(IF (SEND TR TERMINAL?)
					THEN TE:BOX:HEIGHT
				      ELSE TE:BOX:HEIGHT + 20 +(APPLY (FUNCTION MAX)
								      (FOR X IN TE:SUCCESSORS
									 COLLECT X:BOX:HEIGHT]
	         (RETURN TE))))

(RECTANGLESIZE
  (GLAMBDA (BOX:GRAPHICSBOX)                                 (* GSN "14-JAN-83 10:28")
	   (BOX:SIZE _ BOX:CONTENTSSIZE +(A VECTOR WITH X = 10 Y = 10))
	   (BOX:CONTENTSOFFSET _(A VECTOR WITH X = 5 Y = 5))))

(STRINGDATA-DRAW
  (GLAMBDA (self:LISPNODEDISPLAY POS:VECTOR W:WINDOW)        (* GSN "14-JAN-83 14:35")
	   (SEND W PRINTAT self:CONTENTS POS)))

(TREEELEMENT-DRAWIN
  [GLAMBDA (TREE:TREEELEMENT AREA:REGION W:WINDOW)           (* GSN "14-JAN-83 14:42")
                                                             (* Draw the subtree beginning with TREE inside area AREA
							     in window W.)
	   (PROG (NEWX NEWY SUM FSPN (TB TREE:BOX))
	         (IF TREE:DISPLAYSIZE>AREA:SIZE
		     THEN (ERROR "Area is too small for tree."))
	         (TB:START _(A VECTOR WITH X =(AREA:LEFT + AREA:RIGHT - TB:SIZE:X)/2 Y = AREA:TOP - 
			       TB:SIZE:Y))
	         (SEND TB DRAWIN W)
	         (SEND TB:DISPLAYCONTENTS DRAW TB:START+TB:CONTENTSOFFSET W)
                                                             (* Now compute positions for successors of top node.)
	         (IF TREE:SUCCESSORS
		     THEN (NEWY _ AREA:TOP - TB:SIZE:Y - 20)
			  (SUM_0)
			  (FOR S IN TREE:SUCCESSORS DO SUM_+S:DISPLAYSIZE:X) 
                                                             (* Calculate free space for each box.)
			  (FSPN _(AREA:SIZE:X - SUM)/(LENGTH SUCCESSORS))
			  (NEWX _ AREA:START:X + FSPN/2)     (* Draw each subtree.)
			  (FOR S IN TREE:SUCCESSORS
			     DO                              (* Draw arc to new subtree.)
				(SEND W DRAWLINE TB:BOTTOMCENTER
				      (A VECTOR WITH X = NEWX+S:DISPLAYSIZE:X/2 Y = NEWY))
				(SEND S DRAWIN
				      (AN AREA WITH START =(A VECTOR WITH X = NEWX Y = AREA:START:Y)
					  SIZE =(A VECTOR WITH X = S:DISPLAYSIZE:X Y = NEWY - 
						   AREA:START:Y))
				      W)
				(NEWX_+S:DISPLAYSIZE:X+FSPN])
)


[GLISPGLOBALS

(GRAPHICSBOXTYPES   (LISTOF BOXTYPE)  )
]


(PUTPROPS RECTANGLE DRAWPROGRAM DRAWRECTANGLE)

(PUTPROPS RECTANGLE SIZEPROGRAM RECTANGLESIZE)

(RPAQQ GRAPHICSBOXTYPES (RECTANGLE))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS GRAPHICSBOXTYPES)
)
(LOAD? (QUOTE VECTOR.LSP))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2714 7091 (BOXTYPE-DRAW 2724 . 2892) (BOXTYPE-ERASE 2894 . 3063) (BOXTYPE-SETSIZE 3065
 . 3278) (DRAWRECTANGLE 3280 . 3715) (GRAPHICSBOX-DRAWIN 3717 . 3867) (GRAPHICSBOX-ERASEIN 3869 . 4021
) (MATCHTREE 4023 . 5126) (RECTANGLESIZE 5128 . 5358) (STRINGDATA-DRAW 5360 . 5512) (
TREEELEMENT-DRAWIN 5514 . 7089)))))
STOP