(FILECREATED "24-Apr-87 19:08:21" {ERIS}<LISPUSERS>KOTO>HGRAPH.;2 12562
changes to: (FNS HARDCOPYWHOLEGRAPH)
previous date: "27-Jan-87 14:35:21" {PHYLUM}<LISPUSERS>KOTO>HGRAPH.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT HGRAPHCOMS)
(RPAQQ HGRAPHCOMS ((FNS CEILING HARDCOPYDISPLAYGRAPH HARDCOPYWHOLEGRAPH)
(P (MOVD (QUOTE HARDCOPYGRAPH)
(QUOTE OLDHARDCOPYGRAPH))
(MOVD (QUOTE HARDCOPYWHOLEGRAPH)
(QUOTE HARDCOPYGRAPH)))
(* This is in order to fix the problem with borders on Interpress printers. I\t
seems that you cannot bitblt anything thinner than 36 pixel onto an
Interpress stream, why? Anyway, this fixes the problem by setting the border
width to 36)))
(DEFINEQ
(CEILING
[LAMBDA (NUMBER)
(COND
((EQP (FIX NUMBER)
NUMBER)
NUMBER)
(T (ADD1 (FIX NUMBER])
(HARDCOPYDISPLAYGRAPH
[LAMBDA (GRAPH STREAM CLIP/REG TRANS) (* bbb "27-Jan-87 11:52")
(* Displays GRAPH with coordinates system translated to TRANS on STREAM. POS=NIL is interpreted as 0\,0.
Draws links first then labels so that lattices don't have lines through the labels.)
(* This function is to be used together with
HARDCOPYWHOLEGRAPH\, it assumes that the scaling of
the graph is done already, for efficiency.)
(PROG (SCALE (LINEWIDTH 1))
[OR (type? POSITION TRANS)
(SETQ TRANS (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0]
(SETQ STREAM (GETSTREAM STREAM (QUOTE OUTPUT)))
(COND
((DISPLAYSTREAMP STREAM)
(* This is because PRIN3 on displaystreams can sometimes cause CR's to be output. GRAPHER/CENTERPRINTINAREA doesn't
have the rightmargin kludge that the CENTERPRINTINAREA in MENU has.)
(DSPRIGHTMARGIN 65000 STREAM))
(T (SETQ SCALE (DSPSCALE NIL STREAM))
[SETQ TRANS (create POSITION
XCOORD ← (FIXR (FTIMES SCALE (fetch XCOORD
of TRANS)))
YCOORD ← (FIXR (FTIMES SCALE (fetch YCOORD
of TRANS]
(SETQ LINEWIDTH SCALE)))
(for N in (fetch (GRAPH GRAPHNODES) of GRAPH)
do (DISPLAYNODELINKS N TRANS STREAM GRAPH T LINEWIDTH))
(for N in (fetch (GRAPH GRAPHNODES) of GRAPH) do (PRINTDISPLAYNODE N TRANS
STREAM
CLIP/REG])
(HARDCOPYWHOLEGRAPH
[LAMBDA (GraphOrWindow File ImageType Translation NoAlignmentDots DontCloseStream)
(* N.H.Briggs "24-Apr-87 19:07")
(* * Hardcopy \a whole graph from \a window using as many pages as necessary)
(* fix: moved SCALE/GRAPH outside the for loops for
effiency.)
(* fix: moved SCALE.REGION inline, in order to avoid
the LOADFNS in the COMS list.)
(LET ((Stream (OR (AND File (OPENP File (QUOTE OUTPUT))
File)
(OPENIMAGESTREAM File ImageType)))
(Graph (COND
((WINDOWP GraphOrWindow)
(WINDOWPROP GraphOrWindow (QUOTE GRAPH)))
(T GraphOrWindow)))
GraphUnitsPerPageUnit PageUnitsPerGraphUnit GraphRegionInGraphUnits GraphRegionInPageUnits
PageRegion PageWidthInGraphUnits PageHeightInGraphUnits GraphWidthInGraphUnits
GraphHeightInGraphUnits CornerXOffsetInGraphUnits CornerYOffsetInGraphUnits PageScale
LeftCenteringOffsetInGraphUnits BottomCenteringOffsetInGraphUnits PageNumberFont
NumberOfXPages NumberOfYPages XPageNumberPositionInPageUnits YPageNumberPositionInPageUnits
LeftXAlignmentInPageUnits RightXAlignmentInPageUnits LowerYAlignmentInPageUnits
UpperYAlignmentInPageUnits PageUnitsPerInch)
(SETQ PageScale (DSPSCALE NIL Stream))
(SETQ GraphUnitsPerPageUnit (FQUOTIENT 1.0 PageScale))
(SETQ PageUnitsPerGraphUnit PageScale) (* 72 screen points per inch.)
(SETQ PageUnitsPerInch (TIMES PageScale 72))
(SETQ GraphRegionInGraphUnits (GRAPHREGION Graph))
(SETQ CornerXOffsetInGraphUnits (MINUS (fetch (REGION LEFT) of
GraphRegionInGraphUnits)))
(SETQ CornerYOffsetInGraphUnits (MINUS (fetch (REGION BOTTOM) of
GraphRegionInGraphUnits)))
(* fix: moved SCALE.REGION inline, in order to avoid
the LOADFNS in the COMS list.)
[SETQ GraphRegionInPageUnits (CREATEREGION (FIXR (QUOTIENT (fetch (REGION LEFT)
of
GraphRegionInGraphUnits)
GraphUnitsPerPageUnit))
(FIXR (QUOTIENT (fetch (REGION BOTTOM)
of
GraphRegionInGraphUnits)
GraphUnitsPerPageUnit))
(FIXR (QUOTIENT (fetch (REGION WIDTH)
of
GraphRegionInGraphUnits)
GraphUnitsPerPageUnit))
(FIXR (QUOTIENT (fetch (REGION HEIGHT)
of
GraphRegionInGraphUnits)
GraphUnitsPerPageUnit]
(SELECTQ (IMAGESTREAMTYPE Stream)
[INTERPRESS
(* * Make the clipping region be the whole page on Interpress streams)
(DSPCLIPPINGREGION (CREATEREGION 0 0 (FIXR (TIMES
PageUnitsPerInch 8.5)
)
(FIXR (TIMES
PageUnitsPerInch
11.0)))
Stream)
(* * Get rid of 1 inch margins except .5 inch at right and top)
(SETQ PageRegion (CREATEREGION 0 0 (FIXR (TIMES
PageUnitsPerInch 8.0)
)
(FIXR (TIMES PageUnitsPerInch
10.5]
[PRESS
(* * Make the clipping region be the whole page on Press streams)
(DSPCLIPPINGREGION (CREATEREGION 0 0 (FIXR (TIMES PageUnitsPerInch
8.5))
(FIXR (TIMES PageUnitsPerInch
11.0)))
Stream)
(* * Get rid of 1 inch margins except 1 inch at right and top)
(SETQ PageRegion (CREATEREGION 0 0 (FIXR (TIMES PageUnitsPerInch
7.5))
(FIXR (TIMES PageUnitsPerInch 10.0]
(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 NumberOfYPages (CEILING (QUOTIENT GraphHeightInGraphUnits PageHeightInGraphUnits)
))
(SETQ NumberOfXPages (CEILING (QUOTIENT GraphWidthInGraphUnits PageWidthInGraphUnits)))
(SETQ PageNumberFont (FONTCREATE (QUOTE MODERN)
6))
(* * The page numbers are \a quarter of in after the edge of the printing edge and are in the upper right hand
corner of the page. The pages are printed row-wise and no page numbers are printed on the last page.
The page numbers are positioned .25 inch to the right of the right edge of the page region and .35 inch up from the
top of the page region. The alignment dots are .25 inch to the right of the right edge of the page region and .25
inch up from the page region.)
(SETQ XPageNumberPositionInPageUnits (PLUS (fetch (REGION RIGHT) of PageRegion)
(TIMES PageUnitsPerInch .25)))
(SETQ YPageNumberPositionInPageUnits (PLUS (fetch (REGION TOP) of PageRegion)
(TIMES PageUnitsPerInch .35)))
(SETQ LeftXAlignmentInPageUnits (TIMES PageUnitsPerInch .25))
(SETQ RightXAlignmentInPageUnits (PLUS (fetch (REGION RIGHT) of PageRegion)
(TIMES PageUnitsPerInch .25)))
(SETQ LowerYAlignmentInPageUnits (TIMES PageUnitsPerInch .25))
(SETQ UpperYAlignmentInPageUnits (PLUS (fetch (REGION TOP) of PageRegion)
(TIMES PageUnitsPerInch .25)))
(* Latest fix: moved SCALE/GRAPH outside the for loops
for effiency.)
(SETQ Graph (SCALE/GRAPH Graph Stream PageScale))
[for BottomOfPageInGraphUnits from 0 to GraphHeightInGraphUnits by
PageHeightInGraphUnits
as YPageNumber from 1
do (for LeftOfPageInGraphUnits from 0 to GraphWidthInGraphUnits by
PageWidthInGraphUnits
as XPageNumber from 1
do [HARDCOPYDISPLAYGRAPH Graph Stream (DSPCLIPPINGREGION NIL Stream)
(create POSITION
XCOORD ← (FIXR (PLUS
CornerXOffsetInGraphUnits
LeftCenteringOffsetInGraphUnits
(MINUS
LeftOfPageInGraphUnits)))
YCOORD ← (FIXR (PLUS
BottomCenteringOffsetInGraphUnits
CornerYOffsetInGraphUnits
(MINUS
BottomOfPageInGraphUnits]
(* * Print the alignment points)
[COND
((NOT NoAlignmentDots)
(* * The lower left page should not have \a dot in the lower left corner. Similarly for other corner pages.)
(COND
((NOT (AND (EQ XPageNumber 1)
(EQ YPageNumber 1)))
(MOVETO LeftXAlignmentInPageUnits LowerYAlignmentInPageUnits
Stream)
(printout Stream ".")))
(COND
((NOT (AND (EQ XPageNumber NumberOfXPages)
(EQ YPageNumber 1)))
(MOVETO RightXAlignmentInPageUnits LowerYAlignmentInPageUnits
Stream)
(printout Stream ".")))
(COND
((NOT (AND (EQ YPageNumber NumberOfYPages)
(EQ XPageNumber 1)))
(MOVETO LeftXAlignmentInPageUnits UpperYAlignmentInPageUnits
Stream)
(printout Stream ".")))
(COND
((NOT (AND (EQ XPageNumber NumberOfXPages)
(EQ YPageNumber NumberOfYPages)))
(MOVETO RightXAlignmentInPageUnits UpperYAlignmentInPageUnits
Stream)
(printout Stream "."]
(COND
((NOT (AND (EQ XPageNumber NumberOfXPages)
(EQ YPageNumber NumberOfYPages)))
(* Not on the very last page)
(DSPFONT PageNumberFont Stream)
(MOVETO XPageNumberPositionInPageUnits YPageNumberPositionInPageUnits
Stream)
(printout Stream XPageNumber "," YPageNumber)
(* Print the page number)
(DSPNEWPAGE Stream]
(COND
((NOT DontCloseStream)
(CLOSEF Stream])
)
(MOVD (QUOTE HARDCOPYGRAPH)
(QUOTE OLDHARDCOPYGRAPH))
(MOVD (QUOTE HARDCOPYWHOLEGRAPH)
(QUOTE HARDCOPYGRAPH))
(* This is in order to fix the problem with borders on Interpress printers. I\t seems that you
cannot bitblt anything thinner than 36 pixel onto an Interpress stream, why? Anyway, this
fixes the problem by setting the border width to 36)
(PUTPROPS HGRAPH COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (779 12115 (CEILING 789 . 928) (HARDCOPYDISPLAYGRAPH 930 . 2653) (HARDCOPYWHOLEGRAPH
2655 . 12113)))))
STOP