| 1 |
< |
# SCCSid "$SunId$ LBL" |
| 1 |
> |
% SCCSid "$SunId$ LBL" |
| 2 |
|
|
| 3 |
|
% |
| 4 |
|
% By Isaac Kuo |
| 5 |
|
% |
| 6 |
|
|
| 7 |
|
#include "newsconstants.h" |
| 8 |
+ |
|
| 9 |
|
cdef cps_clear() |
| 10 |
|
textbackground setcolor clippath fill |
| 11 |
|
cdef initcanvas(x,y,width,height,mb1key,mb2key,mb3key) |
| 12 |
+ |
% a couple of definitions of commands in Sun NeWS but not in |
| 13 |
+ |
% SiliconGraphics NeWS |
| 14 |
+ |
|
| 15 |
+ |
currentdict /createcanvas known not % check if they're defined or not |
| 16 |
+ |
{ |
| 17 |
+ |
/createcanvas |
| 18 |
+ |
{ |
| 19 |
+ |
3 2 roll newcanvas /newcan exch def |
| 20 |
+ |
0 0 4 2 roll newpath rectpath |
| 21 |
+ |
newcan reshapecanvas newpath |
| 22 |
+ |
newcan |
| 23 |
+ |
} def |
| 24 |
+ |
/mapcanvas |
| 25 |
+ |
{ |
| 26 |
+ |
/Mapped true put |
| 27 |
+ |
} def |
| 28 |
+ |
} if |
| 29 |
+ |
|
| 30 |
+ |
% terrific, wasn't it? |
| 31 |
+ |
|
| 32 |
|
/Can framebuffer width height createcanvas def |
| 33 |
|
Can /Retained true put |
| 34 |
|
Can setcanvas x y movecanvas currentcanvas mapcanvas |
| 117 |
|
tag tagprint |
| 118 |
|
cdef getthebox(X,Y,W,H) => tag(X,Y,W,H) |
| 119 |
|
% Get the coordinates of the box from the user |
| 120 |
< |
currentcanvas createoverlay setcanvas getwholerect waitprocess |
| 120 |
> |
|
| 121 |
> |
% While Sun NeWS coordinates default to pixels, Silicon Graphics NeWS |
| 122 |
> |
% defaults to "points", which are 4/3 the size of pixels in both directions. |
| 123 |
> |
% Silicon Graphics NeWS does not have "createcanvas" defined, so it is |
| 124 |
> |
% used to determine whether the coordinates should be translated. |
| 125 |
> |
|
| 126 |
> |
currentcanvas createoverlay setcanvas |
| 127 |
> |
currentdict /createcanvas known not |
| 128 |
> |
{ |
| 129 |
> |
.75 .75 scale |
| 130 |
> |
} if |
| 131 |
> |
getwholerect waitprocess |
| 132 |
|
aload pop /y1 exch def /x1 exch def /y0 exch def /x0 exch def |
| 133 |
|
x0 x1 gt { /x x1 def /w x0 x1 sub def } |
| 134 |
|
{ /x x0 def /w x1 x0 sub def } ifelse |
