(FILECREATED "24-Jul-86 14:15:08" {QV}<NOTECARDS>RELEASE1.2I>LIBRARY>GRAPHHARDCOPIER.;7 8450
changes to: (VARS GRAPHHARDCOPIERCOMS)
previous date: " 3-Oct-85 18:51:37" {QV}<NOTECARDS>RELEASE1.2I>LIBRARY>GRAPHHARDCOPIER.;6)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GRAPHHARDCOPIERCOMS)
(RPAQQ GRAPHHARDCOPIERCOMS ((* * Fixes to GRAPHER)
(FNS SCALE/GRAPH SET/LABEL/SIZE)
(* * Hardcopier)
(FNS HARDCOPYWHOLEGRAPH)
(* *)
(P (AND (NOT (GETD (QUOTE SCALE.REGION)))
(LOADFNS (QUOTE SCALE.REGION)
(QUOTE GRAPHZOOM.DCOM))))
(P (MOVD (QUOTE HARDCOPYWHOLEGRAPH)
(QUOTE HARDCOPYGRAPH)))))
(* * Fixes to GRAPHER)
(DEFINEQ
(SCALE/GRAPH
(LAMBDA (GRAPH STREAM SCALE) (* fgh: "29-Sep-85 23:44")
(create GRAPH using GRAPH GRAPHNODES ←(for N in (fetch GRAPHNODES of GRAPH)
collect
(SETQ N
(create GRAPHNODE
using N NODEPOSITION ←(create
POSITION
XCOORD ←(FIXR (FTIMES SCALE
(fetch XCOORD
of (fetch
NODEPOSITION
of N))))
YCOORD ←(FIXR (FTIMES SCALE
(fetch YCOORD
of (fetch
NODEPOSITION
of N)))))
NODELABELBITMAP ← NIL NODEWIDTH ← NIL
NODEHEIGHT ← NIL NODEFONT ←(FONTCREATE
(fetch NODEFONT of N)
NIL NIL NIL STREAM)
TONODES ←(SCALE/TONODES N SCALE)
NODEBORDER ←(SCALE/GRAPHNODE/BORDER
(fetch NODEBORDER of N)
SCALE)))
(SET/LABEL/SIZE N NIL STREAM)
N))))
(SET/LABEL/SIZE
(LAMBDA (NODE RESET/FLG STREAM) (* fgh: "29-Sep-85 23:43")
(* the SHADE and null font stuff is for ZOOMGRAPH)
(OR (AND (NOT RESET/FLG)
(FIXP (fetch NODEHEIGHT of NODE))
(FIXP (fetch NODEWIDTH of NODE)))
(PROG ((FONT (fetch (GRAPHNODE NODEFONT) of NODE))
(LAB (fetch (GRAPHNODE NODELABEL) of NODE))
(NBW (GRAPHNODE/BORDER/WIDTH (fetch NODEBORDER of NODE)))
WIDTH HEIGHT)
(COND
((BITMAPP LAB)
(SETQ WIDTH (BITMAPWIDTH LAB))
(SETQ HEIGHT (BITMAPHEIGHT LAB)))
((EQ FONT (QUOTE SHADE)) (* node image is very small)
(SETQ WIDTH (SETQ HEIGHT 2)))
((IMAGEOBJP LAB)
(SETQ WIDTH (APPLY* (IMAGEOBJPROP LAB (QUOTE IMAGEBOXFN))
LAB STREAM))
(SETQ HEIGHT (fetch (IMAGEBOX YSIZE) of WIDTH))
(SETQ WIDTH (fetch (IMAGEBOX XSIZE) of WIDTH)))
((NULL FONT) (* FONT of NIL means that the node is smaller than
displays)
(SETQ NBW (SETQ WIDTH (SETQ HEIGHT 0))))
(T (OR (FONTP FONT)
(SETQ FONT (FONTCREATE FONT)))
(SETQ WIDTH (IPLUS (STRINGWIDTH (fetch NODELABEL of NODE)
FONT)
(FONTPROP FONT (QUOTE DESCENT))))
(SETQ HEIGHT (IPLUS (FONTPROP FONT (QUOTE HEIGHT))
(FONTPROP FONT (QUOTE DESCENT))))))
(OR (AND (NOT RESET/FLG)
(FIXP (fetch NODEWIDTH of NODE)))
(replace NODEWIDTH of NODE with (IPLUS WIDTH NBW NBW)))
(OR (AND (NOT RESET/FLG)
(FIXP (fetch NODEHEIGHT of NODE)))
(replace NODEHEIGHT of NODE with (IPLUS HEIGHT NBW NBW)))
(RETURN NODE)))))
)
(* * Hardcopier)
(DEFINEQ
(HARDCOPYWHOLEGRAPH
(LAMBDA (GraphOrWindow File ImageType Translation) (* fgh: " 1-Oct-85 21:02")
(* * Hardcopy a whole graph from a window using as many pages as necessary)
(LET ((Stream (OR (AND File (OPENP File (QUOTE OUTPUT)))
(OPENIMAGESTREAM File (OR ImageType (SETQ ImageType (QUOTE INTERPRESS))))))
(Graph (COND
((WINDOWP GraphOrWindow)
(WINDOWPROP GraphOrWindow (QUOTE GRAPH)))
(T GraphOrWindow)))
GraphUnitsPerPageUnit PageUnitsPerGraphUnit GraphRegionInGraphUnits GraphRegionInPageUnits
PageRegion PageWidthInGraphUnits PageHeightInGraphUnits GraphWidthInGraphUnits
GraphHeightInGraphUnits PagesPrinted CornerXOffsetInGraphUnits CornerYOffsetInGraphUnits
PageScale LeftCenteringOffsetInGraphUnits BottomCenteringOffsetInGraphUnits)
(SETQ PageScale (DSPSCALE NIL Stream))
(SETQ GraphUnitsPerPageUnit (FQUOTIENT 1.0 (DSPSCALE NIL Stream)))
(SETQ PageUnitsPerGraphUnit (DSPSCALE NIL Stream))
(SETQ GraphRegionInGraphUnits (GRAPHREGION Graph))
(SETQ CornerXOffsetInGraphUnits (MINUS (fetch (REGION LEFT) of GraphRegionInGraphUnits)))
(SETQ CornerYOffsetInGraphUnits (MINUS (fetch (REGION BOTTOM) of GraphRegionInGraphUnits)))
(SETQ GraphRegionInPageUnits (SCALE.REGION GraphRegionInGraphUnits GraphUnitsPerPageUnit))
(COND
((EQ (IMAGESTREAMTYPE Stream)
(QUOTE INTERPRESS))
(* * Make the clipping region be the whole page on Interpress streams)
(DSPCLIPPINGREGION (CREATEREGION 0 0 (FIXR (TIMES 2540.0 8.5))
(FIXR (TIMES 2540.0 11.0)))
Stream)
(* * Get rid of 1 inch margins except .5 inch at right and top)
(SETQ PageRegion (CREATEREGION 0 0 (FIXR (TIMES 2540.0 8.0))
(FIXR (TIMES 2540.0 10.5)))))
((EQ (IMAGESTREAMTYPE Stream)
(QUOTE PRESS))
(* * Make the clipping region be the whole page on Interpress streams)
(DSPCLIPPINGREGION (CREATEREGION 0 0 (FIXR (TIMES 2540.0 8.5))
(FIXR (TIMES 2540.0 11.0)))
Stream)
(* * Get rid of 1 inch margins except .5 inch at right and top)
(SETQ PageRegion (CREATEREGION 0 0 (FIXR (TIMES 2540.0 7.5))
(FIXR (TIMES 2540.0 10.0)))))
(T (SETQ PageRegion (DSPCLIPPINGREGION NIL Stream))))
(SETQ PageWidthInGraphUnits (TIMES (fetch (REGION WIDTH) of PageRegion)
GraphUnitsPerPageUnit))
(SETQ PageHeightInGraphUnits (TIMES (fetch (REGION HEIGHT) of PageRegion)
GraphUnitsPerPageUnit))
(SETQ GraphWidthInGraphUnits (fetch (REGION WIDTH) of GraphRegionInGraphUnits))
(SETQ GraphHeightInGraphUnits (fetch (REGION HEIGHT) of GraphRegionInGraphUnits))
(SETQ BottomCenteringOffsetInGraphUnits (QUOTIENT (DIFFERENCE PageHeightInGraphUnits
(REMAINDER
GraphHeightInGraphUnits
PageHeightInGraphUnits))
1.75))
(SETQ LeftCenteringOffsetInGraphUnits (QUOTIENT (DIFFERENCE PageWidthInGraphUnits
(REMAINDER GraphWidthInGraphUnits
PageWidthInGraphUnits))
1.75))
(SETQ PagesPrinted (for BottomOfPageInGraphUnits from 0 to GraphHeightInGraphUnits
by PageHeightInGraphUnits
sum (for LeftOfPageInGraphUnits from 0 to GraphWidthInGraphUnits
by PageWidthInGraphUnits
sum (DISPLAYGRAPH Graph Stream (DSPCLIPPINGREGION NIL Stream)
(create POSITION
XCOORD ←(FIXR (PLUS
CornerXOffsetInGraphUnits
LeftCenteringOffsetInGraphUnits
(MINUS
LeftOfPageInGraphUnits)))
YCOORD ←(FIXR (PLUS
BottomCenteringOffsetInGraphUnits
CornerYOffsetInGraphUnits
(MINUS
BottomOfPageInGraphUnits)))))
(DSPNEWPAGE Stream)
1)))
(CLOSEF Stream))))
)
(* *)
(AND (NOT (GETD (QUOTE SCALE.REGION)))
(LOADFNS (QUOTE SCALE.REGION)
(QUOTE GRAPHZOOM.DCOM)))
(MOVD (QUOTE HARDCOPYWHOLEGRAPH)
(QUOTE HARDCOPYGRAPH))
(PUTPROPS GRAPHHARDCOPIER COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (772 3886 (SCALE/GRAPH 782 . 1842) (SET/LABEL/SIZE 1844 . 3884)) (3910 8179 (
HARDCOPYWHOLEGRAPH 3920 . 8177)))))
STOP