sjs@spectral.ctt.bellcore.com (Stan Switzer) (10/11/89)
Here's a simple "graph" item.
Just stuff it into "psh." There's a test routine at the end.
Stan Switzer sjs@bellcore.com
-------------------
%
% GraphItem: a simple "graph" item
%
% Copyright (C) 1989 by Stan Switzer. All rights reserved.
% This program is provided for unrestricted use, provided that this
% copyright message is preserved. There is no warranty, and no author
% or distributer accepts responsibility for any damage caused by this
% program.
%
% S. J. Switzer 8/14/89 sjs@bellcore.com
% GraphItem
/GraphItem LabeledItem dictbegin
/MinX 0 def
/MaxX 0 def
/Nticks 0 def
/Xlabels 0 def
/MinY 0 def
/MaxY 0 def
/Yticks 0 def
/Ylabels 0 def
/GraphWidth 0 def
/GraphHeight 0 def
/GraphX 0 def
/GraphY 0 def
/GraphD 0 def
/dD 0 def
/dL 0 def
/TrackIndex 0 def
/Overlay null def
/Array null def
dictend classbegin
% minx maxx xticks xlabels
% miny maxy yticks ylabels
% label [ initial-values ] loc notifyproc parentcanvas => instance
/new {
/new super send begin
/Array ItemObject def
/Ylabels exch def
/Yticks exch def
/MaxY exch def
/MinY exch def
/Xlabels exch def
/Xticks exch def
/MaxX exch def
/MinX exch def
currentdict
end
} def
/Xoff 23 def
/Yoff 14 def
/Tick 3 def
/reshape { % x y w h
/ItemHeight exch def /ItemWidth exch def
LabelSize /LabelHeight exch def /LabelWidth exch def
/ObjectWidth ItemWidth def
/ObjectHeight ItemHeight def
AdjustItemSize
/ObjectWidth ItemWidth 2 ItemBorder mul sub def
ObjectLoc /Right eq ObjectLoc /Left eq or {
/ObjectWidth ObjectWidth LabelWidth sub ItemGap sub def
} if
CalcObj&LabelXY
/GraphWidth ObjectWidth Xoff sub def
/GraphHeight ObjectHeight Yoff sub def
/GraphX ObjectX Xoff add def
/GraphY ObjectY Yoff add def
/GraphD GraphWidth Array length 1 sub 1 max div def
ItemWidth ItemHeight /reshape super send
} def
/LabFont /Times-Roman findfont 10 scalefont def
/PaintItem {
/PaintItem super send
ItemBorderColor setcolor
LabFont setfont
/dD GraphHeight currentfont fontascent sub Ylabels 1 add div def
/dL MaxY MinY sub Ylabels 1 add div def
0 1 Ylabels 1 add {
ObjectX 2 add GraphY 2 index dD mul add cvi moveto
dL mul MinY add (xxxx) cvs show
} for
/dD GraphWidth MaxX (xxxx) cvs stringwidth
pop sub Xlabels 1 add div def
/dL MaxX MinX sub Xlabels 1 add div def
0 1 Xlabels 1 add {
GraphX 1 index dD mul add cvi ObjectY moveto
dL mul MinX add (xxxx) cvs show
} for
/dD GraphHeight Yticks 1 add div def
0 1 Yticks 1 add {
GraphX exch GraphY exch dD mul add cvi moveto
Tick neg 0 rlineto stroke
} for
/dD GraphWidth Xticks 1 add div def
0 1 Xticks 1 add {
GraphX exch dD mul add cvi GraphY moveto
0 Tick neg rlineto stroke
} for
PaintGraph
} def
/PaintGraph {
gsave ItemFillColor setcolor
GraphX GraphY GraphWidth GraphHeight rectpath fill
grestore
GraphX GraphY GraphWidth GraphHeight rectpath stroke
% 2 setlinewidth 1 setlinequality
0 1 Array length 1 sub {
dup IndexToX Array 2 index get ValToY
2 index 0 eq { moveto } { 2 copy lineto stroke moveto } ifelse
pop
} for
} def
/IndexToX { GraphX exch GraphD mul add cvi } def
/ValToY { MinY sub MaxY MinY sub div GraphHeight mul GraphY add cvi } def
/DragIndex? false def
/ClientDown {
EventMgrDict /CurrentTextItem known {
CurrentTextItem null ne {
/stoptext CurrentTextItem /ItemText get send
null SetCurrentTextItem
} if
} if
CurrentEvent /XLocation get GraphX sub GraphD .5 mul add
GraphD div cvi 0 max Array length 1 sub min
/TrackIndex exch def
Overlay null eq {
/Overlay currentcanvas createoverlay store
} if
ClientDrag
} def
/ClientDrag {
Overlay setcanvas
erasepage
DragIndex? { % Thanks, Don!
TrackIndex % old
CurrentEvent /XLocation get GraphX sub GraphD .5 mul add % old x
GraphD div cvi 0 max Array length 1 sub min % old new
2 copy eq { pop pop } {
dup 3 1 roll % new old new
2 copy sub 0 lt 1 -1 ifelse exch { % new first step last
Array exch EventY put
} for % new
ItemBegin PaintGraph ItemEnd
/TrackIndex exch def %
} ifelse
} if
TrackIndex 0 ne {
TrackIndex 1 sub IndexToX Array TrackIndex 1 sub get ValToY moveto
} if
TrackIndex IndexToX CurrentEvent /YLocation get
GraphY max GraphY GraphHeight add min
% 2 copy
TrackIndex 0 ne { lineto } { moveto } ifelse
TrackIndex Array length 1 sub lt {
TrackIndex 1 add IndexToX Array TrackIndex 1 add get ValToY
lineto
} if
stroke
% LabFont setfont moveto EventY (xxxx) cvs cshow
} def
/ClientUp {
Overlay setcanvas
erasepage
Array TrackIndex EventY put
ItemBegin PaintGraph ItemEnd
NotifyUser
StopItem
} def
/EventY {
CurrentEvent /YLocation get GraphY sub GraphHeight div
0 max 1 min MaxY MinY sub mul MinY add
} def
classend def
/TestGraph {
/win currentcanvas /new DefaultWindow send def
{
10 10 200 150 reshape
/PaintClient { Items paintitems } def
/FrameLabel ( GraphItem Demo ) def
ClientCanvas ClientFillColor
} win send
/fillcol exch def /can exch def
/Items dictbegin
/Graph 0 256 3 1 0 256 3 1
(Graph) [ 0 64 256 {} for ] /Top { } can
120 60 /new GraphItem send
10 10 /move 3 index send def
dictend def
Items { /ItemFillColor fillcol put pop } forall
/ItemMgr Items forkitems def
/map win send
} def
TestGraph