(FILECREATED "12-Aug-85 12:57:50" {ERIS}<LISPUSERS>BIZGRAFIX.;4 29709
changes to: (FNS BAR BARredisplay minXof minYof maxXof maxYof)
previous date: "11-Aug-85 19:23:02" {ERIS}<LISPUSERS>BIZGRAFIX.;3)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT BIZGRAFIXCOMS)
(RPAQQ BIZGRAFIXCOMS ((FNS BAR BARdrawBar BARredisplay DR HORIZPRIN1 VERTPRIN1 labelBarGraph
labelXaxis labelYaxis drawBar NEARESTPOWEROFTWO LINEGRAPH PIEfill
GRAPH.ROUND graphScale GRAPHdrawline GRAPHredisplay pickupBitMap
BITMAP.INTERIOR EXTEND.AREA TEST.AND.SET EXTEND.AREA.Y EXTEND.AREA.X PIE
PIEredisplay drawPoint fourWayFill labelGraph labelPieChart labelPrint
minXof minYof placeHTicks placeTicks placeVTicks scaleToGraph maxXof
maxYof)
(VARS DATA DATA2 DATA3 PIEDATA smallGraphFont largeGraphFont)
(UGLYVARS PICDATA)
(ARRAY textureArray)
(GLOBALVARS smallGraphFont largeGraphFont textureArray)
(BITMAPS pointBM)
(P (LOCALVARS . T))
(RECORDS graphScale)))
(DEFINEQ
(BAR
[LAMBDA (points window ymin ymax) (* FS "12-Aug-85 12:10")
(PUTWINDOWPROP window (QUOTE bizgraphData)
points)
(TwoD.Init window)
(SETQ ymin (COND
((NUMBERP ymin)
ymin)
((EQ ymin (QUOTE relative))
(minYof points))
(T 0)))
[SETQ ymax (COND
((NUMBERP ymax)
ymax)
(T (maxYof points]
(TwoD.SetWorld 0 ymin (LENGTH points)
ymax window)
(PUTWINDOWPROP window (QUOTE RESHAPEFN)
(QUOTE (TwoD.Reshapefn BARredisplay)))
(PUTWINDOWPROP window (QUOTE REPAINTFN)
(QUOTE BARredisplay))
(REDISPLAYW window])
(BARdrawBar
[LAMBDA (whichPoint WIDTH HEIGHT texture window) (* Jellinek " 6-Apr-84 09:57")
(COND
((MINUSP HEIGHT)
(TwoD.BitBLT NIL NIL NIL window whichPoint HEIGHT WIDTH (MINUS HEIGHT)
(QUOTE TEXTURE)
(QUOTE REPLACE)
texture))
(T (TwoD.BitBLT NIL NIL NIL window whichPoint 0 WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
texture])
(BARredisplay
[LAMBDA (window) (* FS "12-Aug-85 12:52")
(PROG ((whichTexture 0)
(values (GETWINDOWPROP window (QUOTE bizgraphData)))
(originalHeight (GETWINDOWPROP window (QUOTE originalHeight)))
(originalWidth (GETWINDOWPROP window (QUOTE originalWidth)))
(pointsPerCM (CONSTANT (FQUOTIENT 76.0 2.54)))
Xmin Ymin Xmax Ymax Xscaleinfo YscaleInfo)
(TwoD.InitViewport window)
(SETQ Xmin (minXof values))
(SETQ Ymin (minYof values))
(SETQ Xmax (maxXof values))
(SETQ Ymax (maxYof values))
(SETQ Xscaleinfo (graphScale Xmax Xmin (FQUOTIENT originalWidth pointsPerCM)))
(SETQ YscaleInfo (graphScale Ymax Ymin (FQUOTIENT originalHeight pointsPerCM)))
(CLEARW window)
(TwoD.SetViewport (fracOfWidth .05 window)
(fracOfHeight .05 window)
(fracOfWidth .95 window)
(fracOfHeight .95 window)
window)
(for pair in values as whichPoint from 0
do [SETQ whichTexture (ADD1 (IREMAINDER whichTexture (ARRAYSIZE textureArray]
(BARdrawBar whichPoint 1 (fetch (POSITION YCOORD) of pair)
(ELT textureArray whichTexture)
window))
(restoreDSPCLIPPINGREGION window)
(labelXaxis window Xscaleinfo Xmin Xmax Ymin Ymax)
(labelYaxis window YscaleInfo Xmin Xmax Ymin Ymax)
(restoreDSPCLIPPINGREGION window])
(DR
[LAMBDA (x1 y1 x2 y2) (* edited: " 3-Apr-84 18:26")
(TwoD.DrawLine x1 y1 x2 y2 1 NIL W])
(HORIZPRIN1
[LAMBDA (what stream) (* Jellinek " 6-Apr-84 16:28")
(PRIN1 what stream])
(VERTPRIN1
[LAMBDA (what stream) (* Jellinek " 6-Apr-84 16:41")
(PROG [(charHeight (fetch HEIGHT of (STRINGREGION what stream]
(for char in (UNPACK what)
do (PRIN1 char stream)
(RELMOVETO (MINUS (CHARWIDTH (CAR (CHCON char))
stream))
(MINUS charHeight)
stream])
(labelBarGraph
[LAMBDA (value label Xposition maxValue window) (* Jellinek "29-Mar-84 18:12")
(PROG [(scaledHeight (FTIMES value (FQUOTIENT (GETWINDOWPROP window (QUOTE HEIGHT))
maxValue]
(MOVETO Xposition 0 window)
(COND
(label (PRINT label window])
(labelXaxis
[LAMBDA (window hScale Xmin Xmax Ymin Ymax) (* Todd " 9-Apr-85 14:42")
(PROG ([scalejump (MAX 1 (NEARESTPOWEROFTWO (FIX (fetch (graphScale scale) of hScale]
(whereX Ymin)
(ODDFLAG T))
(for labelSpot from Xmin to Xmax by scalejump
do (TwoD.MoveTo [create POSITION
XCOORD ←(DIFFERENCE labelSpot (TIMES .05 scalejump))
YCOORD ←(FPLUS whereX (FTIMES -.03 (IDIFFERENCE Ymax Ymin]
window)
(COND
(ODDFLAG (labelPrint labelSpot window smallGraphFont NIL)))
(TwoD.MoveTo (create POSITION
XCOORD ← labelSpot
YCOORD ← whereX)
window)
(RELDRAWTO 0 3 2 NIL window)
(SETQ ODDFLAG (NOT ODDFLAG)))
(TwoD.MoveTo (create POSITION
XCOORD ←(FQUOTIENT (GETWINDOWPROP window (QUOTE Wxr))
2.0)
YCOORD ←(FPLUS whereX 2))
window)
(TwoD.DrawLine Xmin whereX Xmax whereX 2 NIL window])
(labelYaxis
[LAMBDA (window vScale Xmin Xmax Ymin Ymax) (* Todd " 9-Apr-85 14:42")
(PROG ([scalejump (MAX 1 (NEARESTPOWEROFTWO (FIX (fetch (graphScale scale) of vScale]
(whereY Xmin))
(for labelSpot from Ymin to Ymax by scalejump
do (TwoD.MoveTo (create POSITION
XCOORD ←(FPLUS whereY (FTIMES -.04 (IDIFFERENCE Xmax Xmin)))
YCOORD ← labelSpot)
window)
(labelPrint labelSpot window smallGraphFont NIL)
(TwoD.MoveTo (create POSITION
XCOORD ← whereY
YCOORD ← labelSpot)
window)
(RELDRAWTO 3 0 2 NIL window))
(TwoD.MoveTo (create POSITION
XCOORD ←(FPLUS whereY 2)
YCOORD ←(FQUOTIENT (GETWINDOWPROP window (QUOTE Wyt))
2.0))
window)
(TwoD.DrawLine whereY Ymin whereY Ymax 2 NIL window])
(drawBar
[LAMBDA (value maxValue Xposition barWidth texture window)
(* Jellinek "28-Mar-84 14:33")
(PROG [(scaledHeight (FTIMES value (FQUOTIENT (GETWINDOWPROP window (QUOTE HEIGHT))
maxValue]
(BITBLT NIL NIL NIL window Xposition 0 barWidth scaledHeight (QUOTE TEXTURE)
(QUOTE PAINT)
texture])
(NEARESTPOWEROFTWO
[LAMBDA (INP) (* edited: "22-Feb-85 20:12")
(* * comment)
(COND
((LESSP INP 1)
1)
(T (EXPT 2 (FIX (PLUS .2 (QUOTIENT (LOG INP)
(LOG 2])
(LINEGRAPH
[LAMBDA (points graphWindow wantLines hUnits vUnits) (* edited: " 8-Feb-85 13:01")
(PROG NIL
(PUTWINDOWPROP graphWindow (QUOTE bizgraphData)
points)
(PUTWINDOWPROP graphWindow (QUOTE wantLines)
wantLines)
(TwoD.Init graphWindow)
(TwoD.SetWorld (minXof points)
(minYof points)
(maxXof points)
(maxYof points)
graphWindow)
(PUTWINDOWPROP graphWindow (QUOTE hUnits)
hUnits)
(PUTWINDOWPROP graphWindow (QUOTE vUnits)
vUnits)
(PUTWINDOWPROP graphWindow (QUOTE RESHAPEFN)
(QUOTE (TwoD.Reshapefn GRAPHredisplay)))
(PUTWINDOWPROP graphWindow (QUOTE REPAINTFN)
(QUOTE GRAPHredisplay))
(REDISPLAYW graphWindow])
(PIEfill
[LAMBDA (WINDOW X Y texture) (* Jellinek "11-Apr-84 10:51")
(PROG [BITMAP REGION PT INTERIOR LEFT BOTTOM (COLORDS (WINDOWPROP WINDOW (QUOTE INCOLOR]
LP [SETQ BITMAP (COND
[COLORDS (pickupBitMap COLORDS (SETQ REGION (GETCOLORREGION]
(T [SETQ REGION (DSPCLIPPINGREGION NIL (WINDOWPROP WINDOW (QUOTE DSP]
(COND
(REGION (pickupBitMap WINDOW REGION))
(T (printout PROMPTWINDOW T "An empty region: try again")
(GO LP]
(SETQ PT (create POSITION
XCOORD ← X
YCOORD ← Y))
(COND
[(INSIDE? REGION (fetch XCOORD of PT)
(fetch YCOORD of PT))
(SETQ PT (create POSITION
XCOORD ←(IDIFFERENCE (fetch XCOORD of PT)
(SETQ LEFT (fetch LEFT of REGION)))
YCOORD ←(IDIFFERENCE (fetch YCOORD of PT)
(SETQ BOTTOM (fetch BOTTOM of REGION]
(T (PROMPTPRINT "The point should be inside the bounding region.")
(GO LP)))
(SETQ INTERIOR (BITMAP.INTERIOR BITMAP PT)) (* simulate merge since this will work for both color
and b&w where as BITBLT merge only works for b&w NIL)
(BITBLT INTERIOR 0 0 (OR COLORDS WINDOW)
LEFT BOTTOM NIL NIL (QUOTE INPUT)
(QUOTE ERASE))
[BITBLT NIL NIL NIL INTERIOR 0 0 NIL NIL (QUOTE TEXTURE)
(QUOTE ERASE)
(LOGXOR texture (COND
(COLORDS (MAXIMUMCOLOR))
(T BLACKSHADE]
(BITBLT INTERIOR 0 0 (OR COLORDS WINDOW)
LEFT BOTTOM NIL NIL (QUOTE INPUT)
(QUOTE PAINT])
(GRAPH.ROUND
[LAMBDA (V D) (* Jellinek "29-Mar-84 11:51" posted: " 8-JUL-78 16:49")
(* Rounds V to an integer within tolerance and direction
of D. A positive value of D rounds up and a negative one
down)
(FIX (FPLUS V (COND
((NULL D)
(COND
((MINUSP V)
-.5)
(T .5)))
((EQ (MINUSP V)
(MINUSP D))
D)
(T 0.0])
(graphScale
[LAMBDA (MX MN GRID) (* Jellinek "29-Mar-84 16:25" posted: "10-JUL-78 14:20")
(* Computes a rounded scaling factor for HIST and PLOT.
Resets the args to their rounded values so no SMALLPs
allowed)
(COND
((EQP MX MN)
1.0)
(T (PROG ((CORE (FQUOTIENT (DIFFERENCE MX MN)
(SUB1 GRID)) (* The digits of the value)
)
(MXI NIL (* MX in scale units))
(MNI NIL (* MN in scale units)))
(* Exponent for scaling)
[bind (POW10 ← 0) do (COND
((FGREATERP CORE 10.0)
(add POW10 1)
(SETQ CORE (FQUOTIENT CORE 10.0)))
((FGREATERP CORE .5)
(SETQ CORE (FTIMES (COND
((FGREATERP CORE 5.0)
(add POW10 1)
1.0)
((FGREATERP CORE 2.5)
5.0)
((FGREATERP CORE 2.0)
2.5)
((FGREATERP CORE 1.0)
2.0)
(T 1.0))
(EXPT 10 POW10)))
(* The 2.5 case is kept because an overflow from 2.000x
to 5 leaves less than half the page used in the plot)
(RETURN))
(T (add POW10 -1)
(SETQ CORE (FTIMES CORE 10.0]
(SETQ MXI (GRAPH.ROUND (FQUOTIENT MX CORE)
.5))
(SETQ MNI (GRAPH.ROUND (FQUOTIENT MN CORE)
-.5))
(RETURN (create graphScale
maximum ←(GRAPH.ROUND (FTIMES CORE (FLOAT MXI)))
minimum ←(GRAPH.ROUND (FTIMES CORE (FLOAT MNI)))
grid ←(ADD1 (IDIFFERENCE MXI MNI))
scale ← CORE])
(GRAPHdrawline
[LAMBDA (fromPt toPt maxX maxY originX originY window) (* Jellinek "30-Mar-84 17:49")
(PROG ((Pt1 (scaleToGraph fromPt maxX maxY originX originY window))
(Pt2 (scaleToGraph toPt maxX maxY originX originY window))
(lineWidth 1))
(DRAWBETWEEN Pt1 Pt2 lineWidth (QUOTE PAINT)
window])
(GRAPHredisplay
[LAMBDA (graphWindow) (* Todd " 9-Apr-85 14:41")
(PROG ((lineWidth 1)
(originalHeight (GETWINDOWPROP graphWindow (QUOTE originalHeight)))
(originalWidth (GETWINDOWPROP graphWindow (QUOTE originalWidth)))
(points (GETWINDOWPROP graphWindow (QUOTE bizgraphData)))
(wantLines (GETWINDOWPROP graphWindow (QUOTE wantLines)))
(hUnits (GETWINDOWPROP graphWindow (QUOTE hUnits)))
(vUnits (GETWINDOWPROP graphWindow (QUOTE vUnits)))
(pointsPerCM (CONSTANT (FQUOTIENT 76.0 2.54)))
oldPair XscaleInfo YscaleInfo Ymax Xmax Ymin Xmin)
(TwoD.InitViewport graphWindow)
(SETQ Ymax (maxYof points))
(SETQ Xmax (maxXof points))
(SETQ Ymin (minYof points))
(SETQ Xmin (minXof points))
(SETQ XscaleInfo (graphScale Xmax Xmin (FQUOTIENT originalWidth pointsPerCM)))
(SETQ YscaleInfo (graphScale Ymax Ymin (FQUOTIENT originalHeight pointsPerCM)))
(CLEARW graphWindow)
(TwoD.SetViewport (fracOfWidth .05 graphWindow)
(fracOfHeight .05 graphWindow)
(fracOfWidth .95 graphWindow)
(fracOfHeight .95 graphWindow)
graphWindow)
[COND
((NUMBERP (fetch (POSITION XCOORD) of (CAR points)))
(for pair in points
do (TwoD.PlotAt pair pointBM graphWindow)
(AND wantLines oldPair (TwoD.DrawBetween oldPair pair lineWidth NIL graphWindow))
(SETQ oldPair pair)))
(T (for pair in points as spacing from 0 by (FQUOTIENT Xmax (LENGTH points))
do (TwoD.PlotAt (create POSITION
XCOORD ← spacing
YCOORD ←(fetch (POSITION YCOORD) of pair))
pointBM graphWindow)
(AND wantLines oldPair (TwoD.DrawBetween oldPair pair lineWidth NIL graphWindow))
(SETQ oldPair (create POSITION
XCOORD ← spacing
YCOORD ←(fetch (POSITION YCOORD) of pair]
(labelXaxis graphWindow XscaleInfo Xmin Xmax Ymin Ymax)
(labelYaxis graphWindow YscaleInfo Xmin Xmax Ymin Ymax)
(restoreDSPCLIPPINGREGION graphWindow])
(pickupBitMap
[LAMBDA (WINDOW REGION) (* rrb "22-DEC-82 12:14")
(PROG (NEW.BITMAP WIDTH HEIGHT)
(SETQ WIDTH (fetch (REGION WIDTH) of REGION))
(SETQ HEIGHT (fetch (REGION HEIGHT) of REGION))
[SETQ NEW.BITMAP (BITMAPCREATE WIDTH HEIGHT (COND
(WINDOW (fetch (BITMAP BITMAPBITSPERPIXEL)
of (DSPDESTINATION NIL WINDOW)))
(T 1]
(BITBLT (OR WINDOW (SCREENBITMAP))
(fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
NEW.BITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE))
(RETURN NEW.BITMAP])
(BITMAP.INTERIOR
[LAMBDA (BITMAP PT) (* rrb "19-JAN-83 18:53")
(* returns a bitmap which has all 1's at all points that are the same value as PT and touch it or another point of
the same value that touches it.)
(PROG ((WIDTH (BITMAPWIDTH BITMAP))
(HEIGHT (BITMAPHEIGHT BITMAP))
INTERIOR
(X (fetch (POSITION XCOORD) of PT))
(Y (fetch (POSITION YCOORD) of PT))
(NBITS (BITSPERPIXEL BITMAP))
FROMVALUE MAXVAL)
(SETQ MAXVAL (SUB1 (EXPT 2 NBITS)))
(SETQ FROMVALUE (BITMAPBIT BITMAP X Y))
(SETQ INTERIOR (BITMAPCREATE WIDTH HEIGHT NBITS))
(EXTEND.AREA BITMAP INTERIOR X Y (SUB1 WIDTH)
(SUB1 HEIGHT)
FROMVALUE MAXVAL)
(RETURN INTERIOR])
(EXTEND.AREA
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVALUE TOVALUE)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(COND
((TEST.AND.SET DEFINING.BITMAP AREA.BITMAP X Y FROMVALUE TOVALUE)
(EXTEND.AREA.X DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVALUE TOVALUE])
(TEST.AND.SET
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y FROMVALUE TOVALUE)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(COND
((EQ (BITMAPBIT AREA.BITMAP X Y)
TOVALUE) (* already been here)
NIL)
((NEQ (BITMAPBIT DEFINING.BITMAP X Y)
FROMVALUE) (* hit a boundary point)
NIL)
(T (BITMAPBIT AREA.BITMAP X Y TOVALUE)
T])
(EXTEND.AREA.Y
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVAL TOVAL)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(PROG (BOTTOM TOP)
(SETQ BOTTOM Y)
(for I from (SUB1 Y) to 0 by -1 while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP X I FROMVAL
TOVAL)
do (SETQ BOTTOM I))
(SETQ TOP Y)
(for I from (ADD1 Y) to MAXY while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP X I FROMVAL
TOVAL)
do (SETQ TOP I))
(for I from BOTTOM to TOP unless (EQ I Y)
do (EXTEND.AREA.X DEFINING.BITMAP AREA.BITMAP X I MAXX MAXY FROMVAL TOVAL))
(RETURN])
(EXTEND.AREA.X
[LAMBDA (DEFINING.BITMAP AREA.BITMAP X Y MAXX MAXY FROMVAL TOVAL)
(* rrb "19-JAN-83 19:21")
(DECLARE (LOCALVARS . T))
(PROG (LEFT RIGHT)
(SETQ LEFT X)
(for I from (SUB1 X) to 0 by -1 while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP I Y FROMVAL
TOVAL)
do (SETQ LEFT I))
(SETQ RIGHT X)
(for I from (ADD1 X) to MAXX while (TEST.AND.SET DEFINING.BITMAP AREA.BITMAP I Y FROMVAL
TOVAL)
do (SETQ RIGHT I))
(for I from LEFT to RIGHT unless (EQ I X)
do (EXTEND.AREA.Y DEFINING.BITMAP AREA.BITMAP I Y MAXX MAXY FROMVAL TOVAL))
(RETURN])
(PIE
[LAMBDA (percentages chartWindow fill?) (* Jellinek "10-Apr-84 15:34")
(PUTWINDOWPROP chartWindow (QUOTE bizgraphData)
percentages)
(PUTWINDOWPROP chartWindow (QUOTE fillFlag)
fill?)
(PUTWINDOWPROP chartWindow (QUOTE RESHAPEFN)
(QUOTE PIEredisplay))
(PUTWINDOWPROP chartWindow (QUOTE REPAINTFN)
(QUOTE PIEredisplay))
(REDISPLAYW chartWindow])
(PIEredisplay
[LAMBDA (chartWindow) (* Jellinek "11-Apr-84 10:47")
(PROG [(percentages (GETWINDOWPROP chartWindow (QUOTE bizgraphData)))
(fill? (GETWINDOWPROP chartWindow (QUOTE fillFlag)))
(twoPi (CONSTANT (TIMES 2 3.141529)))
(angle 0)
(oldAngle 0)
(distanceFromCenter .5)
(wedge 0)
(lineWidth 2)
(centerX (IQUOTIENT (GETWINDOWPROP chartWindow (QUOTE WIDTH))
2))
(centerY (IQUOTIENT (GETWINDOWPROP chartWindow (QUOTE HEIGHT))
2))
(radius (MIN (IDIFFERENCE (IQUOTIENT (GETWINDOWPROP chartWindow (QUOTE WIDTH))
2)
10)
(IDIFFERENCE (IQUOTIENT (GETWINDOWPROP chartWindow (QUOTE HEIGHT))
2)
10]
(CLEARW chartWindow)
(DRAWCIRCLE centerX centerY radius (BQUOTE (ROUND , lineWidth))
NIL chartWindow)
(DRAWLINE centerX centerY (PLUS centerX radius)
centerY lineWidth (QUOTE PAINT)
chartWindow)
[for point in percentages
do (SETQ wedge (IREMAINDER (ADD1 wedge)
(ARRAYSIZE textureArray)))
(SETQ oldAngle angle)
(SETQ angle (PLUS angle (FTIMES (FQUOTIENT (CDR point)
100.0)
twoPi)))
(DRAWLINE centerX centerY (PLUS centerX (FTIMES (COS angle T)
radius))
(PLUS centerY (FTIMES (SIN angle T)
radius))
lineWidth
(QUOTE PAINT)
chartWindow)
(COND
(fill? (PIEfill chartWindow (PLUS centerX (FTIMES (COS (FQUOTIENT (FPLUS oldAngle
angle)
2.0)
T)
(FTIMES radius distanceFromCenter)
))
(PLUS centerY (FTIMES (SIN (FQUOTIENT (FPLUS oldAngle angle)
2.0)
T)
(FTIMES radius distanceFromCenter)))
(ELT textureArray wedge]
(SETQ angle 0)
(for labelPoint in percentages
do (SETQ oldAngle angle)
(SETQ angle (PLUS angle (FTIMES (FQUOTIENT (CDR labelPoint)
100.0)
twoPi)))
(labelPieChart labelPoint centerX centerY radius angle oldAngle chartWindow])
(drawPoint
[LAMBDA (point maxX maxY xOrigin yOrigin window) (* Jellinek "29-Mar-84 17:50")
(PROG [(scaledPoint (scaleToGraph point maxX maxY xOrigin yOrigin window))
(wHeight (GETWINDOWPROP graphWindow (QUOTE HEIGHT)))
(wWidth (GETWINDOWPROP graphWindow (QUOTE WIDTH]
(BITBLT pointBM 0 0 window (IDIFFERENCE (fetch (POSITION XCOORD) of scaledPoint)
(IQUOTIENT (BITMAPWIDTH pointBM)
2))
(IDIFFERENCE (fetch (POSITION YCOORD) of scaledPoint)
(IQUOTIENT (BITMAPHEIGHT pointBM)
2])
(fourWayFill
[LAMBDA (BM X Y newColor) (* Jellinek "26-Mar-84 14:49")
(COND
((INSIDE? (CREATEREGION 0 0 (BITMAPWIDTH BM)
(BITMAPHEIGHT BM))
X Y)
(COND
((EQ (BITMAPBIT BM X Y)
(IDIFFERENCE 1 newColor))
(BITMAPBIT BM X Y newColor)))
(fourWayFill BM (ADD1 X)
Y newColor)
(fourWayFill BM X (ADD1 Y)
newColor)
(fourWayFill BM (SUB1 X)
Y newColor)
(fourWayFill BM X (SUB1 Y)
newColor])
(labelGraph
[LAMBDA (pair Xmax Ymax graphWindow) (* Jellinek "27-Mar-84 16:27")
(scaleToGraph pair Xmax Ymax graphWindow])
(labelPieChart
[LAMBDA (pair centerX centerY radius angle1 angle2 chartWindow)
(* Jellinek "10-Apr-84 16:24")
(PROG ((distanceFromCenter .85)
labelX labelY)
[SETQ labelX (PLUS centerX (FTIMES (COS (FQUOTIENT (FPLUS angle1 angle2)
2.0)
T)
(FTIMES radius distanceFromCenter]
[SETQ labelY (PLUS centerY (FTIMES (SIN (FQUOTIENT (FPLUS angle1 angle2)
2.0)
T)
(FTIMES radius distanceFromCenter]
(COND
((BITMAPP (CAR pair))
(BITBLT (CAR pair)
0 0 chartWindow labelX labelY NIL NIL (QUOTE INPUT)
(QUOTE REPLACE)))
(T (MOVETO labelX labelY chartWindow)
(printout chartWindow (CAR pair)
" ("
(CDR pair)
"%%)"])
(labelPrint
[LAMBDA (label window font vertical?) (* edited: "19-Feb-85 10:57")
(DSPFONT font window)
(COND
(vertical? (VERTPRIN1 label window))
(T (PRIN1 (FIX label)
window])
(minXof
[LAMBDA (pointList) (* Jellinek "27-Mar-84 17:06")
(fetch (POSITION XCOORD) of (for point in pointList smallest (fetch (POSITION XCOORD)
of point])
(minYof
[LAMBDA (pointList) (* Jellinek "27-Mar-84 17:06")
(fetch (POSITION YCOORD) of (for point in pointList smallest (fetch (POSITION YCOORD)
of point])
(placeHTicks
[LAMBDA (window hScale Xmin Xmax label) (* Jellinek "10-Apr-84 10:33")
(PROG ((lineWidth 2))
(TwoD.DrawLine Xmin 0 Xmax 0 lineWidth NIL window)
(for tickSpot from Xmin to Xmax by (fetch (graphScale scale) of hScale)
do (TwoD.MoveTo (create POSITION
XCOORD ← tickSpot
YCOORD ← 0)
window)
(RELDRAWTO 0 3 1 NIL window])
(placeTicks
[LAMBDA (window maxX maxY) (* Jellinek "28-Mar-84 12:09")
(PROG ((wWidth (GETWINDOWPROP window (QUOTE WIDTH)))
(wHeight (GETWINDOWPROP window (QUOTE HEIGHT)))
(lineWidth 2)
xOrigin yOrigin)
(SETQ xOrigin (FQUOTIENT wWidth 6.0))
(SETQ yOrigin (FQUOTIENT wHeight 6.0))
(DRAWLINE xOrigin yOrigin wWidth yOrigin lineWidth (QUOTE PAINT)
window)
(DRAWLINE xOrigin yOrigin xOrigin wHeight lineWidth (QUOTE PAINT)
window])
(placeVTicks
[LAMBDA (window vScale Ymin Ymax) (* Jellinek " 6-Apr-84 14:06")
(PROG ((lineWidth 1))
(TwoD.DrawLine 0 Ymin 0 Ymax lineWidth NIL window)
(for tickSpot from Ymin to Ymax by (fetch (graphScale scale) of vScale)
do (TwoD.MoveTo (create POSITION
XCOORD ← 0
YCOORD ← tickSpot)
window)
(RELDRAWTO 3 0 lineWidth NIL window])
(scaleToGraph
[LAMBDA (pointToScale Xmax Ymax originX originY win) (* Jellinek "29-Mar-84 17:57")
(create POSITION
XCOORD ←(FPLUS originX (FTIMES (fetch (POSITION XCOORD) of pointToScale)
(FQUOTIENT (FDIFFERENCE (GETWINDOWPROP win (QUOTE WIDTH))
originX)
Xmax)))
YCOORD ←(FPLUS originY (FTIMES (fetch (POSITION YCOORD) of pointToScale)
(FQUOTIENT (FDIFFERENCE (GETWINDOWPROP win (QUOTE HEIGHT))
originY)
Ymax])
(maxXof
[LAMBDA (pointList) (* Jellinek "27-Mar-84 16:11")
(fetch (POSITION XCOORD) of (for point in pointList largest (fetch (POSITION XCOORD)
of point])
(maxYof
[LAMBDA (pointList) (* Jellinek "27-Mar-84 16:12")
(fetch (POSITION YCOORD) of (for point in pointList largest (fetch (POSITION YCOORD)
of point])
)
(RPAQQ DATA ((0 . 10)
(20 . 30)
(-10 . 20)
(-20 . 10)))
(RPAQQ DATA2 ((-100 . 0)
(-95 . 48)
(-90 . 28)
(-85 . 20)
(-80 . 38)
(-75 . -1)
(-70 . -23)
(-65 . 35)
(-60 . 42)
(-55 . 2)
(-50 . 24)
(-45 . 45)
(-40 . 42)
(-35 . -40)
(-30 . 17)
(-25 . 38)
(-20 . -29)
(-15 . 28)
(-10 . 46)
(-5 . -28)
(0 . 17)
(5 . 25)
(10 . 28)
(15 . -5)
(20 . 20)
(25 . 19)
(30 . -1)
(35 . -36)
(40 . 31)
(45 . -22)
(50 . 1)
(55 . -36)
(60 . -36)
(65 . -37)
(70 . 44)
(75 . 30)
(80 . 5)
(85 . 35)
(90 . 13)
(95 . 1)
(100 . -17)))
(RPAQQ DATA3 ((0 . 7879)
(300000 . 5860)
(600000 . 1998)
(900000 . 7709)
(1000000 . 8244)))
(RPAQQ PIEDATA ((land . 21)
(sea . 70)
(sky . 9)))
(RPAQQ smallGraphFont (HELVETICA 8 MRR))
(RPAQQ largeGraphFont (HELVETICA 12 MRR))
(READVARS PICDATA)
((({(READBITMAP)(32 32
"@@BDD@@@"
"@@GMN@@@"
"@@OGF@@@"
"@@EJOH@@"
"@CDCAH@@"
"@AKCCL@@"
"@AHOHF@@"
"@ALFON@@"
"@@KKH@@@"
"@@@K@@@@"
"@@@G@@@@"
"@@@E@@@@"
"@@@E@@@@"
"@@@E@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"CL@@@@H@"
"BD@@@@H@"
"BD@@@@L@"
"BD@@@@D@"
"BD@@@@D@"
"CDOBNCL@"
"AHHCJDN@"
"AHIKBDF@"
"CLIJCNML"
"DGNN@CH@"
"H@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@")} . 21) ({(READBITMAP)(32 32
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@CL@GAO@"
"@FBAICO@"
"@LOBCGI@"
"AIHBDE@@"
"AA@FLM@@"
"CA@MII@@"
"CIKMCACH"
"GOOOOOOH"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@@@@@@@@"
"@AH@@@@@"
"@BL@@@@@"
"@D@@@@@@"
"@FANCH@@"
"@CABFH@@"
"AAKFDL@@"
"A@KLEL@@"
"AKIOOGN@"
"@F@@@@@@")} . 70) ({(READBITMAP)(32 32
"NHAHBL@@"
"BDB@@@@@"
"IKO@@B@@"
"DBAMNL@@"
"@D@C@@@@"
"@H@B@@@@"
"LH@BOL@@"
"@L@B@@@@"
"CF@F@@@@"
"FKOMN@@@"
"IH@@@L@@"
"C@JA@@H@"
"BABDL@@@"
"DBC@CK@@"
"LLAB@AH@"
"H@AC@@@@"
"@@ABH@@@"
"@@AB@@@@"
"@@AB@@@@"
"@@@B@@@@"
"@@@B@@@@"
"@C@CLB@@"
"@C@BFB@@"
"@FHFBBA@"
"@DHGNBAC"
"@DHF@BCF"
"@LHO@BGD"
"AHIM@CLL"
"AHK@HDAH"
"FON@GHCH"
"DGH@@@NH"
"@@@@@AHH")} . 9)))
(RPAQ textureArray (READARRAY 16 (QUOTE POINTER) 1))
(42405
42405
42405
42405
42405
42405
42405
42405
42405
42405
42405
42405
42405
42405
42405
42405
NIL
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS smallGraphFont largeGraphFont textureArray)
)
(RPAQ pointBM (READBITMAP))
(5 5
"G@@@"
"OH@@"
"OH@@"
"OH@@"
"G@@@")
(LOCALVARS . T)
[DECLARE: EVAL@COMPILE
(RECORD graphScale (maximum minimum grid scale))
]
(PUTPROPS BIZGRAFIX COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1047 26949 (BAR 1057 . 1746) (BARdrawBar 1748 . 2152) (BARredisplay 2154 . 3790) (DR
3792 . 3935) (HORIZPRIN1 3937 . 4073) (VERTPRIN1 4075 . 4447) (labelBarGraph 4449 . 4757) (labelXaxis
4759 . 5835) (labelYaxis 5837 . 6794) (drawBar 6796 . 7190) (NEARESTPOWEROFTWO 7192 . 7473) (LINEGRAPH
7475 . 8329) (PIEfill 8331 . 9962) (GRAPH.ROUND 9964 . 10477) (graphScale 10479 . 12378) (
GRAPHdrawline 12380 . 12729) (GRAPHredisplay 12731 . 15100) (pickupBitMap 15102 . 15787) (
BITMAP.INTERIOR 15789 . 16607) (EXTEND.AREA 16609 . 16982) (TEST.AND.SET 16984 . 17507) (EXTEND.AREA.Y
17509 . 18311) (EXTEND.AREA.X 18313 . 19115) (PIE 19117 . 19533) (PIEredisplay 19535 . 21615) (
drawPoint 21617 . 22197) (fourWayFill 22199 . 22707) (labelGraph 22709 . 22871) (labelPieChart 22873
. 23699) (labelPrint 23701 . 23949) (minXof 23951 . 24207) (minYof 24209 . 24465) (placeHTicks 24467
. 24915) (placeTicks 24917 . 25453) (placeVTicks 25455 . 25911) (scaleToGraph 25913 . 26435) (maxXof
26437 . 26691) (maxYof 26693 . 26947)))))
STOP