source: cprs/branches/tmg-cprs/m_files/TMGWSCR.m@ 1536

Last change on this file since 1536 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

File size: 10.8 KB
Line 
1TMGWSCR ;TMG/kst/OO screen setup ;04/18/07
2 ;;1.0;TMG-LIB;**1**;04/18/07
3
4 ;"Kevin Toppenberg MD
5 ;"GNU General Public License (GPL) applies
6 ;"------------------------------------------
7 ;"Object oriented screen object setup code below
8 ;"------------------------------------------
9
10Constructor(TMGthis) ;"Module MUST have 'Constructor' procedure
11 ;"Purpose -- A constructor for object Window
12 ;"Input: TMGthis -- the NAME of the type of the object to be defined.
13 ;" This should be a variable (global or otherwise) of the object.
14 ;"Note: This function should NOT be called directly, but instead is called
15 ;" via new^TMGOOL
16 ;"Result: none <--- REQUIRED TO NOT RETURN A RESULT
17
18 ;"Here we define the default values for vars and functions.
19
20 ;"----------------All constructors should copy this format --------------------
21 new typeDef set typeDef=@TMGthis@("TYPEDEF")
22
23 ;"---------------------------------------------------------------------
24 ;"register PROCEDURES/FUNCTIONS
25 do regFn^TMGOOL(TMGthis,"RUN","Run^TMGWSCR()")
26 do regFn^TMGOOL(TMGthis,"ACCEPT CHILD","AcceptChild^TMGWSCR(Child)")
27
28 ;"---------------------------------------------------------------------
29 ;"Register Event Handlers
30
31 ;"---------------------------------------------------------------------
32 ;"Register some Properties
33
34 do regProp^TMGOOL(TMGthis,"WINDOW","","SetWindow^TMGWSCR")
35
36 ;"--------------------------------------------------------------------------------
37 ;"Optional initialization of some instance-specific variables.
38
39 set @TMGthis@("MOUSE","TOP")=5
40 set @TMGthis@("MOUSE","LEFT")=5
41 set @TMGthis@("MOUSE","VISIBLE")=1
42
43 ;"--------------------------------------------------------------------------------
44 ;"Startup code here...
45 kill XGSCRN
46 do PREP^TMGXGF ;"prepare environment for graphics functions
47 do CLEAR^TMGXGF(0,0,150,150)
48 quit
49
50
51
52Destructor(TMGthis) ;"Module MUST have 'Destructor' procedure
53 ;"Purpose: A destructor for object Widget
54 ;" any needed clean up code would go here first.
55 ;"Input: TMGthis -- the name of the object instance to be deleted.
56 ;" This should be the value returned from defWidget
57 ;"Note: Don't actually delete the object here. Just perform code needed to
58 ;" save the object variables etc. Anything neeed before the object
59 ;" is deleted by delete^TMGOOL
60
61 ;" Here I put code that needs to be called before destruction of the object.
62 do
63 . write IOCUON
64 . xecute ^%ZOSF("EON")
65 . do CLEAN^TMGXGF
66 . kill ^TMP($J)
67 . kill XGSCRN
68 . write #
69
70 quit
71
72
73 ;"------------------------------------------
74 ;"Object Widget member functions below
75 ;"------------------------------------------
76
77 ;"Note: All functions may depend on variable (with global scope) TMGthis, as
78 ;" a 'this' pointer to object calling
79 ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure)
80
81
82Run()
83 ;"Purpose: This will be the main entry point. From here the keyboard will be
84 ;" monitored and handled, and window management will occur. This
85 ;" procedure will not exit until all the action of the windows is
86 ;" complete.
87
88 new count
89 for quit:($$Tick(.count)=1)
90 quit 0
91
92
93Conv2Global(Top,Left,Bottom,Right)
94 ;"Purpose: convert to a screen frame of reference
95 ;"Input: Top,Left -- PASS BY REFERENCE.
96 ;" Bottom,Right -- PASS BY REFERENCE. OPTIONAL
97 ;"Results: none
98
99 ;"NOTE: THIS FUNCTION IS DONE
100 ;"It turns out that nothing more needs to done to convert to screen frame.
101 ;"This function is left in for symmetry with Conv2Global^TMGWIN1
102
103 quit 0
104
105 ;"------------------------------------------
106 ;"Event handlers below
107 ;"------------------------------------------
108
109SetWindow(TMGthis,PropName,pWin)
110 ;"Purpose: To set the main output window
111 ;"Input: TMGthis -- a this pointer for properter setter.
112 ;" PropName -- the name of the property -- not used here
113 ;" pWin -- the name/ref of the window to use as main window
114
115 set @TMGthis@("PROP","WINDOW")=pWin
116 ;;"do setProp^TMGOOL(pWin,"SCREEN",TMGthis) ;"I'm not sure if this is right.
117
118 ;"I am reinstating this line so that getScrn will return the top level window,
119 ;"not a reference to TMGWSCR, which doesn't have coordinates property etc.
120 do setProp^TMGOOL(pWin,"SCREEN",pWin)
121 do setProp^TMGOOL(pWin,"MOUSE HOLDER",TMGthis)
122
123 quit ;"<-- required: NO return value for event handler
124
125
126
127 ;"------------------------------------------
128 ;"Private functions below
129 ;"------------------------------------------
130
131
132Tick(count)
133 ;"Purpose: To handle one processing cycle for the screen (and all contained objects)
134 ;"input: count -- a counter variable for occasional screen refreshing
135 ;"Results: 0 is OK to continue, 1 is ABORT
136 new result set result=0
137 set count=+$get(count)+1
138
139 if count<20 do
140 . do CheckPaint ;"If repaint needed, do it here.
141 . set count=count+1
142 else do
143 . do FullPaint
144 . set count=0
145 do DrawMouse ;"do after last draw so nothing overwrites it
146 do CheckKeyboard
147TickDone
148 quit result
149
150
151CheckKeyboard
152 ;"Purpose: to check keyboard for user interaction, and handle if found
153
154 new key
155 kill XGRT
156 ;"set key=$$READ^TMGXGF(1,1) ;"read 1 character, 1 sec time out.
157 set key=$$READ^TMGXGF(1,1) ;"read 1 character, 0 sec time out.
158
159 if $data(DTOUT) goto CKBDone ;"key read timed out
160 if key="!" do
161CK1 . new temp set temp=1 ;"a debug stopping point
162 if key="#" do goto CKBDone
163 . set cmdKey="FULL PAINT"
164 . new scrap set scrap=$$SendMsg(.cmdKey)
165 if key="^" set result=1 goto CKBDone
166 if key'="" do ProcessAlpha(key)
167 if (key="")&(XGRT="") set key="ESC"
168 if $length(XGRT)>0 do ProcessCmd(XGRT)
169CKBDone
170 quit
171
172
173ProcessAlpha(key)
174 ;"Purpose: to fire alpha-numeric input stream event
175 new cmdKey
176 set cmdKey="ALPHA KEY"
177 set cmdKey("KEY")=key
178 new scrap set scrap=$$SendMsg(.cmdKey)
179 quit
180
181
182ProcessCmd(key)
183 ;"Purpose: to handle command keys, as outlined below:
184 ;"Input: cmdKey -- the command input. Examples:
185 ;" UP, DOWN, LEFT, RIGHT
186 ;" NEXT (page down), PREV (page up)
187 ;" REMOVE (for delete)
188 ;" note: HOME and END are NOT returned from $$READ^TMGXGF.
189 ;" F1, F2, ...
190 ;" ^A, ^B (ctrl-A, ctrl-B etc.)
191 ;" CR (return/enter), TAB
192 ;" KPENTER (shift-enter) <-- this will be used as a 'double click' signal
193 ;" note: ESC is NOT returned from $$READ^TMGXGF.
194 ;" ... but maybe I have captured [esc][esc] --> 'ESC'
195
196 new cmdKey
197
198 if $get(@TMGthis@("MOUSE","VISIBLE"))=0 do goto PCDone
199 . if (key="CR")!(key="KPENTER") do ProcessAlpha("CR")
200 . ;"I need to have a way here to send key movements to move around in an edit box...
201
202 if key="CR" do goto PCDone
203PCMM . set cmdKey="MOUSE-CLICK"
204 . new scrap set scrap=$$SendMsg(.cmdKey)
205
206 if key="KPENTER" do goto PCDone
207 . set cmdKey="MOUSE-SHIFT-CLICK"
208 . new scrap set scrap=$$SendMsg(.cmdKey)
209
210 if (key="UP")!(key="DOWN")!(key="LEFT")!(key="RIGHT") do goto PCDone
211 . do ProcessMove(key)
212
213 set cmdKey="COMMAND"
214 set cmdKey("KEY")=key
215 new scrap set scrap=$$SendMsg(.cmdKey)
216PCDone
217 quit
218
219
220ProcessMove(dir)
221 ;"Purpose: to move the mouse around and set status
222 ;"Input: dir -- UP, DOWN etc.
223
224 new cmdKey
225 set cmdKey="MOVE REQUEST"
226
227 new T,L,curT,curL,deltaT,deltaL
228 set T=+$get(@TMGthis@("MOUSE","TOP"))
229 set L=+$get(@TMGthis@("MOUSE","LEFT"))
230 set curT=T,curL=L
231
232 if dir="UP" set T=T-1
233 else if dir="DOWN" set T=T+1
234 else if dir="LEFT" set L=L-1
235 else if dir="RIGHT" set L=L+1
236
237 set cmdKey("DELTA","TOP")=(T-curT)
238 set cmdKey("DELTA","LEFT")=(L-curL)
239 merge cmdKey=@TMGthis@("MOUSE")
240 set cmdKey("GLOBAL COORDS","TOP")=@TMGthis@("MOUSE","TOP")
241 set cmdKey("GLOBAL COORDS","LEFT")=@TMGthis@("MOUSE","LEFT")
242
243 new result set result=$$SendMsg(.cmdKey)
244 if result'=-1 do ;"actually move mouse, because no problem.
245 . set @TMGthis@("MOUSE","VISIBLE")=1
246 . set @TMGthis@("MOUSE","TOP")=T
247 . set @TMGthis@("MOUSE","LEFT")=L
248
249 ;"Note: mouse is NOT drawn here...
250 quit
251
252
253SendMsg(cmdKey)
254 ;"Purpose: to send out message to TOP LEVEL window child (an only child)
255 ;"Input: cmdKey -- PASS BY REFERENCE. The message to send.
256 ;"results: 0 if OK, or -1 if failed
257 ;"Note: here are the messages that will be set through this fn:
258 ;" MOVE REQUEST
259 ;" MOUSE-CLICK
260 ;" MOUSE-SHIFT-CLICK
261 ;" ALPHA KEY (details in KEY)
262 ;" COMMAND (details in KEY)
263
264 new result,MainWin
265 set MainWin=$$getProp^TMGOOL(TMGthis,"WINDOW")
266 set cmdKey("TOP")=+$get(@TMGthis@("MOUSE","TOP"))
267 set cmdKey("LEFT")=+$get(@TMGthis@("MOUSE","LEFT"))
268 ;"set cmdKey("FRAME")=TMGthis ;"specifies which frame of ref are coordinates in.
269 set cmdKey("FRAME")="SCREEN" ;"specifies which frame of ref are coordinates in.
270
271 do fireEvent^TMGOOL(MainWin,"MSG",.cmdKey)
272 new result set result=+$get(cmdKey("RESULT"))
273SMgDone
274 quit result
275
276
277DrawMouse
278 ;"Purpose: to draw the mouse, or hide it if it is not visible.
279 do CLRCLIP^TMGXGF ;"clear clip area
280 do HideMouse
281 if $get(@TMGthis@("MOUSE","VISIBLE"))=1 do
282 . new L,T
283 . set L=@TMGthis@("MOUSE","LEFT"),T=@TMGthis@("MOUSE","TOP")
284 . do SAVE^TMGXGF(T,L,T,L,$name(@TMGthis@("MOUSE","SAVE")))
285 . do CHGA^TMGXGF("B1") do SAY^TMGXGF(T,L,"*","R1") do CHGA^TMGXGF("B0") ;turn blink off
286 quit
287
288
289CheckPaint
290 ;"Purpose: to send a paint message to MainWindow
291 new cmdKey set cmdKey="CHECK PAINT"
292 new scrap set scrap=$$SendMsg(.cmdKey)
293 quit
294
295
296FullPaint
297 ;"Purpose: to send a FULL paint message to MainWindow
298 new cmdKey set cmdKey="FULL PAINT"
299 new scrap set scrap=$$SendMsg(.cmdKey)
300 quit
301
302HideMouse
303 ;"Purpose: Erase Mouse
304 if $data(@TMGthis@("MOUSE","SAVE")) do
305 . do RESTORE^TMGXGF($name(@TMGthis@("MOUSE","SAVE")))
306 quit
307
308
Note: See TracBrowser for help on using the repository browser.