| 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 |
| 35 |
clippath pathbbox pop pop translate |
| 36 |
1.0 .75 .3 setrgbcolor clippath fill |
| 37 |
/scrollheight textareaheight fontheight sub def |
| 38 |
thefont findfont fontheight scalefont setfont |
| 39 |
/textbackground textbackgroundRED textbackgroundGREEN |
| 40 |
textbackgroundBLUE rgbcolor def |
| 41 |
/MB1key mb1key def |
| 42 |
/MB2key mb2key def |
| 43 |
/MB3key mb3key def |
| 44 |
|
| 45 |
% scroll scrolls the text area |
| 46 |
/scroll |
| 47 |
{ |
| 48 |
newpath |
| 49 |
0 0 width scrollheight points2rect rectpath |
| 50 |
0 fontheight copyarea % Scroll the text area |
| 51 |
newpath textbackground setcolor |
| 52 |
0 0 width fontheight points2rect rectpath |
| 53 |
fill |
| 54 |
/textcursorposition 0 def |
| 55 |
} def |
| 56 |
scroll scroll |
| 57 |
|
| 58 |
% myshow takes a string and prints it at the current cursor location |
| 59 |
/myshow |
| 60 |
{ |
| 61 |
textshadowgray setgray |
| 62 |
textcursorposition 1 sub textbottom 1 sub moveto dup show |
| 63 |
0 setgray |
| 64 |
textcursorposition textbottom moveto show |
| 65 |
/textcursorposition currentpoint pop def |
| 66 |
} def |
| 67 |
|
| 68 |
% mydel takes a string and deletes it from the current cursor location |
| 69 |
/mydel |
| 70 |
{ |
| 71 |
textbackground setcolor |
| 72 |
dup stringwidth pop textcursorposition exch sub |
| 73 |
dup /textcursorposition exch def |
| 74 |
1 sub textbottom 1 sub moveto dup show textcursorposition % |
| 75 |
textbottom moveto show |
| 76 |
} def |
| 77 |
|
| 78 |
/normalcursor |
| 79 |
{ |
| 80 |
/xcurs /xcurs_m Can setstandardcursor |
| 81 |
} def |
| 82 |
normalcursor |
| 83 |
|
| 84 |
% get this canvas ready for input |
| 85 |
/buttonevent createevent def |
| 86 |
buttonevent /Name [/LeftMouseButton /MiddleMouseButton /RightMouseButton] put |
| 87 |
buttonevent /Action /UpTransition put |
| 88 |
buttonevent /Canvas Can put |
| 89 |
/keyevent Can addkbdinterests aload /EVENTS exch |
| 90 |
def revokeinterest revokeinterest def |
| 91 |
/dumevent createevent def % dumevent is used by the input checker |
| 92 |
dumevent /Name 32 put % to insure awaitevent returns an answer |
| 93 |
dumevent /Action 13 put % immediately; if it is the first one |
| 94 |
dumevent /Canvas Can put % returned, then no keyboard events |
| 95 |
dumevent expressinterest % were waiting. |
| 96 |
/kdevent createevent def % kdevent is used by the input checker |
| 97 |
kdevent /Action 666 put % to replace waiting keyboard events with |
| 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,r,g,b) |
| 102 |
% Draw a filled box at x,y in pixels with color r,g,b |
| 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() |
| 107 |
% Clean up just enough stuff so the window will die quietly |
| 108 |
keyevent revokeinterest |
| 109 |
kdevent revokeinterest |
| 110 |
EVENTS Can revokekbdinterests |
| 111 |
dumevent revokeinterest |
| 112 |
/Can currentcanvas def |
| 113 |
Can /EventsConsumed /NoEvents put |
| 114 |
Can /Transparent true put |
| 115 |
Can /Mapped false put |
| 116 |
Can /Retained false put |
| 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 |
|
| 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 |
| 149 |
cdef linefeed(string message) |
| 150 |
% print message and scroll |
| 151 |
message myshow scroll |
| 152 |
cdef getclick(x,y,key) => tag(key,y,x) |
| 153 |
% get a cursor position marked by click or key |
| 154 |
buttonevent expressinterest |
| 155 |
/beye_m /xhair_m Can setstandardcursor |
| 156 |
/theclick awaitevent def |
| 157 |
currentcursorlocation textareaheight sub |
| 158 |
normalcursor |
| 159 |
buttonevent revokeinterest |
| 160 |
|
| 161 |
theclick /Name get |
| 162 |
% Translate mouse clicks if necessary |
| 163 |
dup /LeftMouseButton eq |
| 164 |
{pop MB1key} if |
| 165 |
dup /MiddleMouseButton eq |
| 166 |
{pop MB2key} if |
| 167 |
dup /RightMouseButton eq |
| 168 |
{pop MB3key} if |
| 169 |
cvi |
| 170 |
tag tagprint typedprint typedprint typedprint |
| 171 |
cdef isready(keyread) => tag(keyread) |
| 172 |
% tells whether character input is ready |
| 173 |
0 % default output |
| 174 |
dumevent createevent copy sendevent |
| 175 |
{ |
| 176 |
/theevent awaitevent def |
| 177 |
theevent /Action get 13 eq |
| 178 |
{ exit } if |
| 179 |
pop 1 |
| 180 |
/newevent kdevent createevent copy def |
| 181 |
newevent /Name theevent /Name get put |
| 182 |
newevent sendevent |
| 183 |
} loop |
| 184 |
tag tagprint typedprint |
| 185 |
cdef startcomin() |
| 186 |
% get ready for execution of comin |
| 187 |
/nouse /nouse_m Can setstandardcursor |
| 188 |
cdef endcomin() |
| 189 |
% get ready for normal execution |
| 190 |
normalcursor |
| 191 |
cdef getkey(key) => tag(key) |
| 192 |
% get a keypress |
| 193 |
textcursor myshow awaitevent /Name get cvi |
| 194 |
textcursor mydel tag tagprint typedprint |
| 195 |
cdef delete(string s) |
| 196 |
% delete the string s |
| 197 |
s mydel |
