Artifact 4f81573f018b2b580ecf70658d4dba30a9c1000400ea5edaaa1ffe5c52c9728f:
- File
psl-1983/3-1/glisp/grtree.old
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 7498) [annotate] [blame] [check-ins using] [more...]
- File
psl-1983/glisp/grtree.old
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 7498) [annotate] [blame] [check-ins using]
(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