| 1 | TMGWSCR ;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 |
|
|---|
| 10 | Constructor(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 |
|
|---|
| 52 | Destructor(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 |
|
|---|
| 82 | Run()
|
|---|
| 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 |
|
|---|
| 93 | Conv2Global(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 |
|
|---|
| 109 | SetWindow(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 |
|
|---|
| 132 | Tick(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
|
|---|
| 147 | TickDone
|
|---|
| 148 | quit result
|
|---|
| 149 |
|
|---|
| 150 |
|
|---|
| 151 | CheckKeyboard
|
|---|
| 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
|
|---|
| 161 | CK1 . 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)
|
|---|
| 169 | CKBDone
|
|---|
| 170 | quit
|
|---|
| 171 |
|
|---|
| 172 |
|
|---|
| 173 | ProcessAlpha(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 |
|
|---|
| 182 | ProcessCmd(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
|
|---|
| 203 | PCMM . 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)
|
|---|
| 216 | PCDone
|
|---|
| 217 | quit
|
|---|
| 218 |
|
|---|
| 219 |
|
|---|
| 220 | ProcessMove(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 |
|
|---|
| 253 | SendMsg(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"))
|
|---|
| 273 | SMgDone
|
|---|
| 274 | quit result
|
|---|
| 275 |
|
|---|
| 276 |
|
|---|
| 277 | DrawMouse
|
|---|
| 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 |
|
|---|
| 289 | CheckPaint
|
|---|
| 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 |
|
|---|
| 296 | FullPaint
|
|---|
| 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 |
|
|---|
| 302 | HideMouse
|
|---|
| 303 | ;"Purpose: Erase Mouse
|
|---|
| 304 | if $data(@TMGthis@("MOUSE","SAVE")) do
|
|---|
| 305 | . do RESTORE^TMGXGF($name(@TMGthis@("MOUSE","SAVE")))
|
|---|
| 306 | quit
|
|---|
| 307 |
|
|---|
| 308 |
|
|---|
