| 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 |
| 98 |
|
kdevent /Canvas Can put % something which acts interchangably with |
| 99 |
|
kdevent expressinterest % a normal keyboard event. |
| 100 |
|
|
| 101 |
< |
cdef box(x1,y1,x2,y2,float r,float g,float b) |
| 101 |
> |
cdef box(x1,y1,x2,y2,r,g,b) |
| 102 |
|
% Draw a filled box at x,y in pixels with color r,g,b |
| 103 |
< |
r g b setrgbcolor newpath |
| 103 |
> |
r 500 div g 500 div b 500 div setrgbcolor newpath |
| 104 |
|
x1 y1 x2 y2 points2rect rectpath fill |
| 105 |
|
#define tag 1990 |
| 106 |
|
cdef cps_cleanup() => tag() |
| 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 /SGIWindow known |
| 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 |
| 135 |
|
y0 y1 gt { /y y1 def /h y0 y1 sub def } |
| 136 |
|
{ /y y0 def /h y1 y0 sub def } ifelse |
| 137 |
|
h w y x tag tagprint typedprint typedprint typedprint typedprint |
| 138 |
+ |
cdef sgicheck(V) => tag(V) |
| 139 |
+ |
% Check if this is viewed on an SGI screen |
| 140 |
+ |
0 |
| 141 |
+ |
currentdict /SGIWindow known |
| 142 |
+ |
{ |
| 143 |
+ |
pop 100 |
| 144 |
+ |
} if |
| 145 |
+ |
tag tagprint typedprint |
| 146 |
|
cdef printout(string message) |
| 147 |
|
% print message without scrolling the text "window" up |
| 148 |
|
message myshow |
