| 1 |
# SCCSid "$SunId$ LBL" |
| 2 |
|
| 3 |
% |
| 4 |
% By Isaac Kuo |
| 5 |
% |
| 6 |
|
| 7 |
#include "newsconstants.h" |
| 8 |
cdef cps_clear() |
| 9 |
textbackground setcolor clippath fill |
| 10 |
cdef initcanvas(x,y,width,height,mb1key,mb2key,mb3key) |
| 11 |
/Can framebuffer width height createcanvas def |
| 12 |
Can /Retained true put |
| 13 |
Can setcanvas x y movecanvas currentcanvas mapcanvas |
| 14 |
clippath pathbbox pop pop translate |
| 15 |
1.0 .75 .3 setrgbcolor clippath fill |
| 16 |
/scrollheight textareaheight fontheight sub def |
| 17 |
thefont findfont fontheight scalefont setfont |
| 18 |
/textbackground textbackgroundRED textbackgroundGREEN |
| 19 |
textbackgroundBLUE rgbcolor def |
| 20 |
/MB1key mb1key def |
| 21 |
/MB2key mb2key def |
| 22 |
/MB3key mb3key def |
| 23 |
|
| 24 |
% scroll scrolls the text area |
| 25 |
/scroll |
| 26 |
{ |
| 27 |
newpath |
| 28 |
0 0 width scrollheight points2rect rectpath |
| 29 |
0 fontheight copyarea % Scroll the text area |
| 30 |
newpath textbackground setcolor |
| 31 |
0 0 width fontheight points2rect rectpath |
| 32 |
fill |
| 33 |
/textcursorposition 0 def |
| 34 |
} def |
| 35 |
scroll scroll |
| 36 |
|
| 37 |
% myshow takes a string and prints it at the current cursor location |
| 38 |
/myshow |
| 39 |
{ |
| 40 |
textshadowgray setgray |
| 41 |
textcursorposition 1 sub textbottom 1 sub moveto dup show |
| 42 |
0 setgray |
| 43 |
textcursorposition textbottom moveto show |
| 44 |
/textcursorposition currentpoint pop def |
| 45 |
} def |
| 46 |
|
| 47 |
% mydel takes a string and deletes it from the current cursor location |
| 48 |
/mydel |
| 49 |
{ |
| 50 |
textbackground setcolor |
| 51 |
dup stringwidth pop textcursorposition exch sub |
| 52 |
dup /textcursorposition exch def |
| 53 |
1 sub textbottom 1 sub moveto dup show textcursorposition % |
| 54 |
textbottom moveto show |
| 55 |
} def |
| 56 |
|
| 57 |
/normalcursor |
| 58 |
{ |
| 59 |
/xcurs /xcurs_m Can setstandardcursor |
| 60 |
} def |
| 61 |
normalcursor |
| 62 |
|
| 63 |
% get this canvas ready for input |
| 64 |
/buttonevent createevent def |
| 65 |
buttonevent /Name [/LeftMouseButton /MiddleMouseButton /RightMouseButton] put |
| 66 |
buttonevent /Action /UpTransition put |
| 67 |
buttonevent /Canvas Can put |
| 68 |
/keyevent Can addkbdinterests aload /EVENTS exch |
| 69 |
def revokeinterest revokeinterest def |
| 70 |
/dumevent createevent def % dumevent is used by the input checker |
| 71 |
dumevent /Name 32 put % to insure awaitevent returns an answer |
| 72 |
dumevent /Action 13 put % immediately; if it is the first one |
| 73 |
dumevent /Canvas Can put % returned, then no keyboard events |
| 74 |
dumevent expressinterest % were waiting. |
| 75 |
/kdevent createevent def % kdevent is used by the input checker |
| 76 |
kdevent /Action 666 put % to replace waiting keyboard events with |
| 77 |
kdevent /Canvas Can put % something which acts interchangably with |
| 78 |
kdevent expressinterest % a normal keyboard event. |
| 79 |
|
| 80 |
cdef box(x1,y1,x2,y2,float r,float g,float b) |
| 81 |
% Draw a filled box at x,y in pixels with color r,g,b |
| 82 |
r g b setrgbcolor newpath |
| 83 |
x1 y1 x2 y2 points2rect rectpath fill |
| 84 |
#define tag 1990 |
| 85 |
cdef cps_cleanup() => tag() |
| 86 |
% Clean up just enough stuff so the window will die quietly |
| 87 |
keyevent revokeinterest |
| 88 |
kdevent revokeinterest |
| 89 |
EVENTS Can revokekbdinterests |
| 90 |
dumevent revokeinterest |
| 91 |
/Can currentcanvas def |
| 92 |
Can /EventsConsumed /NoEvents put |
| 93 |
Can /Transparent true put |
| 94 |
Can /Mapped false put |
| 95 |
Can /Retained false put |
| 96 |
tag tagprint |
| 97 |
cdef getthebox(X,Y,W,H) => tag(X,Y,W,H) |
| 98 |
% Get the coordinates of the box from the user |
| 99 |
currentcanvas createoverlay setcanvas getwholerect waitprocess |
| 100 |
aload pop /y1 exch def /x1 exch def /y0 exch def /x0 exch def |
| 101 |
x0 x1 gt { /x x1 def /w x0 x1 sub def } |
| 102 |
{ /x x0 def /w x1 x0 sub def } ifelse |
| 103 |
y0 y1 gt { /y y1 def /h y0 y1 sub def } |
| 104 |
{ /y y0 def /h y1 y0 sub def } ifelse |
| 105 |
h w y x tag tagprint typedprint typedprint typedprint typedprint |
| 106 |
cdef printout(string message) |
| 107 |
% print message without scrolling the text "window" up |
| 108 |
message myshow |
| 109 |
cdef linefeed(string message) |
| 110 |
% print message and scroll |
| 111 |
message myshow scroll |
| 112 |
cdef getclick(x,y,key) => tag(key,y,x) |
| 113 |
% get a cursor position marked by click or key |
| 114 |
buttonevent expressinterest |
| 115 |
/beye_m /xhair_m Can setstandardcursor |
| 116 |
/theclick awaitevent def |
| 117 |
currentcursorlocation textareaheight sub |
| 118 |
normalcursor |
| 119 |
buttonevent revokeinterest |
| 120 |
|
| 121 |
theclick /Name get |
| 122 |
% Translate mouse clicks if necessary |
| 123 |
dup /LeftMouseButton eq |
| 124 |
{pop MB1key} if |
| 125 |
dup /MiddleMouseButton eq |
| 126 |
{pop MB2key} if |
| 127 |
dup /RightMouseButton eq |
| 128 |
{pop MB3key} if |
| 129 |
cvi |
| 130 |
tag tagprint typedprint typedprint typedprint |
| 131 |
cdef isready(keyread) => tag(keyread) |
| 132 |
% tells whether character input is ready |
| 133 |
0 % default output |
| 134 |
dumevent createevent copy sendevent |
| 135 |
{ |
| 136 |
/theevent awaitevent def |
| 137 |
theevent /Action get 13 eq |
| 138 |
{ exit } if |
| 139 |
pop 1 |
| 140 |
/newevent kdevent createevent copy def |
| 141 |
newevent /Name theevent /Name get put |
| 142 |
newevent sendevent |
| 143 |
} loop |
| 144 |
tag tagprint typedprint |
| 145 |
cdef startcomin() |
| 146 |
% get ready for execution of comin |
| 147 |
/nouse /nouse_m Can setstandardcursor |
| 148 |
cdef endcomin() |
| 149 |
% get ready for normal execution |
| 150 |
normalcursor |
| 151 |
cdef getkey(key) => tag(key) |
| 152 |
% get a keypress |
| 153 |
textcursor myshow awaitevent /Name get cvi |
| 154 |
textcursor mydel tag tagprint typedprint |
| 155 |
cdef delete(string s) |
| 156 |
% delete the string s |
| 157 |
s mydel |
