| [796] | 1 | TMGWGOJ ;TMG/kst/OO Graphic Object ;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 window object setup code below
|
|---|
| 8 | ;"------------------------------------------
|
|---|
| 9 |
|
|---|
| 10 | Constructor(instanceName) ;"Module MUST have 'Constructor' procedure
|
|---|
| 11 | ;"Purpose -- A constructor for object Window
|
|---|
| 12 | ;"Input: instanceName -- 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 TMGthis set TMGthis=instanceName
|
|---|
| 22 |
|
|---|
| 23 | ;"do inheritFrom^TMGOOL(instanceName,"TMGWSCR")
|
|---|
| 24 |
|
|---|
| 25 | ;"Examples of use: PROCEDURES/FUNCTIONS
|
|---|
| 26 | ;"Note: to evoke a procedure/function, use this format:
|
|---|
| 27 | ;" do proc^TMGOOL(instanceName,"SET TOP",MyTopVar),!
|
|---|
| 28 | ;" set MyTop=$$fn^TMGOOL(instanceName,"GET TOP")
|
|---|
| 29 |
|
|---|
| 30 | ;"---------------------------------------------------------
|
|---|
| 31 | ;"register PROCEDURES/FUNCTIONS
|
|---|
| 32 | do regFn^TMGOOL(TMGthis,"PAINT","Paint^TMGWGOJ()")
|
|---|
| 33 | do regFn^TMGOOL(TMGthis,"MOVE TO","MoveTo^TMGWGOJ(Top,Left)") ;"note parameter variables are placeholders
|
|---|
| 34 | do regFn^TMGOOL(TMGthis,"SET TLBR","setTLBR^TMGWGOJ(Top,Left,Bottom,Right)") ;"note parameter variables are placeholders
|
|---|
| 35 | do regFn^TMGOOL(TMGthis,"SET TLHW","setTLHW^TMGWGOJ(Top,Left,Height,Width)") ;"note parameter variables are placeholders
|
|---|
| 36 | do regFn^TMGOOL(TMGthis,"MOVE OBJ","MoveObj^TMGWGOJ(cmdKey)")
|
|---|
| 37 | do regFn^TMGOOL(TMGthis,"RESIZE OBJ","ResizeObj^TMGWGOJ(flags,cmdKey)")
|
|---|
| 38 | do regFn^TMGOOL(TMGthis,"CLIP TO PARENT","ClipToParent^TMGWGOJ(TMGthis)")
|
|---|
| 39 |
|
|---|
| 40 | do regFn^TMGOOL(TMGthis,"GET SCREEN","GetScrn^TMGWGOJ()")
|
|---|
| 41 | do regFn^TMGOOL(TMGthis,"ACCEPT CHILD","AcceptChild^TMGWGOJ(Child)")
|
|---|
| 42 | do regFn^TMGOOL(TMGthis,"SET FOCUSED","setFocused^TMGWGOJ(child)")
|
|---|
| 43 | do regFn^TMGOOL(TMGthis,"IS FOCUSED","IsFocused^TMGWGOJ(child)")
|
|---|
| 44 | do regFn^TMGOOL(TMGthis,"GET FOCUSED","getFocused^TMGWGOJ()")
|
|---|
| 45 | do regFn^TMGOOL(TMGthis,"UNFOCUS CURRENT FOCUSED","UnfocusCur^TMGWGOJ()")
|
|---|
| 46 | do regFn^TMGOOL(TMGthis,"FLUSH SCREEN SAVE","FlushScrnSave^TMGWGOJ()")
|
|---|
| 47 | do regFn^TMGOOL(TMGthis,"FLUSH MOUSE SAVE","FlushMouseBuffer^TMGWGOJ()")
|
|---|
| 48 | do regFn^TMGOOL(TMGthis,"CONTAINS COORDS","Contains^TMGWGOJ(LOC)")
|
|---|
| 49 | do regFn^TMGOOL(TMGthis,"GET CONTAINED","GetContained^TMGWGOJ(LOC)")
|
|---|
| 50 | do regFn^TMGOOL(TMGthis,"CONVERT TO FRAME","Conv2Frame^TMGWGOJ(LOC,TargetFrame)")
|
|---|
| 51 |
|
|---|
| 52 | ;"---------------------------------------------------------------------
|
|---|
| 53 | ;"Register Event Handlers
|
|---|
| 54 | do regEvent^TMGOOL(TMGthis,"MSG","HandleMsg^TMGWGOJ(cmdKey)")
|
|---|
| 55 | do regEvent^TMGOOL(TMGthis,"ALPHA KEY","HandleAlpha^TMGWGOJ(key)")
|
|---|
| 56 | do regEvent^TMGOOL(TMGthis,"CLICK","HandleClick^TMGWGOJ(LOC)")
|
|---|
| 57 | do regEvent^TMGOOL(TMGthis,"FRAME CLICK","FmClick^TMGWGOJ(LOC,Flags)")
|
|---|
| 58 | do regEvent^TMGOOL(TMGthis,"SHIFT-CLICK","HandleSClick^TMGWGOJ(LOC)")
|
|---|
| 59 | do regEvent^TMGOOL(TMGthis,"MOVE REQUEST","HndlMMove^TMGWGOJ(cmdKey)")
|
|---|
| 60 | do regEvent^TMGOOL(TMGthis,"LOOSING FOCUS","") ;"<--- implement later
|
|---|
| 61 |
|
|---|
| 62 | ;"---------------------------------------------------------------------
|
|---|
| 63 | ;"Register Properties
|
|---|
| 64 |
|
|---|
| 65 | do regProp^TMGOOL(TMGthis,"LOC","","","$$getLOC^TMGWGOJ") ;"actually holds T,L,W,H,S,F below
|
|---|
| 66 | do regProp^TMGOOL(TMGthis,"TOP",0,"setTop^TMGWGOJ","$$getTop^TMGWGOJ")
|
|---|
| 67 | do regProp^TMGOOL(TMGthis,"LEFT",0,"setLeft^TMGWGOJ","$$getLeft^TMGWGOJ")
|
|---|
| 68 | do regProp^TMGOOL(TMGthis,"WIDTH",10,"setWidth^TMGWGOJ","$$getWidth^TMGWGOJ")
|
|---|
| 69 | do regProp^TMGOOL(TMGthis,"HEIGHT",10,"setHeight^TMGWGOJ","$$getHeight^TMGWGOJ")
|
|---|
| 70 | do regProp^TMGOOL(TMGthis,"ALIGN","NONE","","","NONE^TOP^LEFT^BOTTOM^RIGHT")
|
|---|
| 71 |
|
|---|
| 72 | do regProp^TMGOOL(TMGthis,"FRAME","SOLID","","","NONE^SOLID^SIZABLE")
|
|---|
| 73 | do regProp^TMGOOL(TMGthis,"NEEDS REPAINT",0,"","$$getNeedsRepaint^TMGWGOJ","0^1")
|
|---|
| 74 | do regProp^TMGOOL(TMGthis,"RESIZING FLAGS","","","","^[TBLR]") ;"current resizing mode
|
|---|
| 75 | do regProp^TMGOOL(TMGthis,"TITLE","") ;"default null title
|
|---|
| 76 | do regProp^TMGOOL(TMGthis,"PARENT","","setParent^TMGWGOJ","$$getParent^TMGWGOJ")
|
|---|
| 77 | do regProp^TMGOOL(TMGthis,"STATE",0,"setState^TMGWGOJ","$$getState^TMGWGOJ","SELECTED^0")
|
|---|
| 78 | do regProp^TMGOOL(TMGthis,"FOCUSED",0,"","","0^1")
|
|---|
| 79 | do regProp^TMGOOL(TMGthis,"LAST DRAW","")
|
|---|
| 80 | do regProp^TMGOOL(TMGthis,"SCREEN","")
|
|---|
| 81 |
|
|---|
| 82 | ;"---------------------------------------------------------------------
|
|---|
| 83 | ;"Optional initialization of some instance-specific variables.
|
|---|
| 84 |
|
|---|
| 85 | ;"--------------------------------------------------------------------------------
|
|---|
| 86 | ;"Startup code here...
|
|---|
| 87 |
|
|---|
| 88 | quit
|
|---|
| 89 |
|
|---|
| 90 |
|
|---|
| 91 | Destructor(instanceName) ;"Module MUST have 'Destructor' procedure
|
|---|
| 92 | ;"Purpose: A destructor for object Widget
|
|---|
| 93 | ;" any needed clean up code would go here first.
|
|---|
| 94 | ;"Input: instanceName -- the name of the object instance to be deleted.
|
|---|
| 95 | ;" This should be the value returned from defWidget
|
|---|
| 96 | ;"Note: Don't actually delete the object here. Just perform code needed to
|
|---|
| 97 | ;" save the object variables etc. Anything neeed before the object
|
|---|
| 98 | ;" is deleted by delete^TMGOOL
|
|---|
| 99 |
|
|---|
| 100 | ;"-----------------
|
|---|
| 101 |
|
|---|
| 102 | ;" Here I put code that needs to be called before destruction of the object.
|
|---|
| 103 |
|
|---|
| 104 | ;"-----------------
|
|---|
| 105 |
|
|---|
| 106 | ;"Here I delete any children (and they can delete their children)
|
|---|
| 107 | new num set num=""
|
|---|
| 108 | for set num=$order(@TMGthis@("CHILDREN",num)) quit:(+num'>0) do
|
|---|
| 109 | . new child set child=$order(@TMGthis@("CHILDREN",num,""))
|
|---|
| 110 | . if child="" quit
|
|---|
| 111 | . do delete^TMGOOL(child)
|
|---|
| 112 |
|
|---|
| 113 | quit
|
|---|
| 114 |
|
|---|
| 115 |
|
|---|
| 116 | ;"------------------------------------------
|
|---|
| 117 | ;"Object member functions below
|
|---|
| 118 | ;"------------------------------------------
|
|---|
| 119 |
|
|---|
| 120 | ;"Note: A variable (with global scope) TMGthis is available as a 'this' pointer (this instance)
|
|---|
| 121 | ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure)
|
|---|
| 122 |
|
|---|
| 123 | Paint()
|
|---|
| 124 | ;"Purpose: To paint the current window (and all children windows)
|
|---|
| 125 | ;"Input: instanceName -- the name/ref of this instance
|
|---|
| 126 |
|
|---|
| 127 | new T,L,H,W,B,R,LOC
|
|---|
| 128 | new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
|
|---|
| 129 | set scrap=$$Conv2Frame(.LOC,"SCREEN")
|
|---|
| 130 | set T=+$get(LOC("TOP")),L=+$get(LOC("LEFT"))
|
|---|
| 131 | set B=+$get(LOC("BOTTOM")),R=+$get(LOC("RIGHT"))
|
|---|
| 132 |
|
|---|
| 133 | if $data(@TMGthis@("screen save")) do
|
|---|
| 134 | . do CLRCLIP^TMGXGF
|
|---|
| 135 | . do RESTORE^TMGXGF($name(@TMGthis@("screen save")))
|
|---|
| 136 | . ;"note: tell children to flush their saved screens."
|
|---|
| 137 | . new num set num=""
|
|---|
| 138 | . for set num=$order(@TMGthis@("CHILDREN",num)) quit:(+num'>0) do
|
|---|
| 139 | . . new child set child=$order(@TMGthis@("CHILDREN",num,""))
|
|---|
| 140 | . . if child="" quit
|
|---|
| 141 | . . do proc^TMGOOL(child,"FLUSH SCREEN SAVE")
|
|---|
| 142 |
|
|---|
| 143 | new selected,focused
|
|---|
| 144 | set selected=($$getProp^TMGOOL(TMGthis,"STATE")="SELECTED")
|
|---|
| 145 | ;"new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 146 | ;"set focused=$$fn^TMGOOL(parent,"IS FOCUSED",TMGthis)
|
|---|
| 147 | set focused=$$fn^TMGOOL(TMGthis,"IS FOCUSED")
|
|---|
| 148 | new rflags set rflags=$$getProp^TMGOOL(TMGthis,"RESIZING FLAGS")
|
|---|
| 149 |
|
|---|
| 150 | do proc^TMGOOL(TMGthis,"CLIP TO PARENT",TMGthis)
|
|---|
| 151 |
|
|---|
| 152 | if selected do CHGA^TMGXGF("I1")
|
|---|
| 153 | do WIN^TMGXGF(T,L,B,R,$name(@TMGthis@("screen save")))
|
|---|
| 154 | if (rflags'="") do
|
|---|
| 155 | . do CHGA^TMGXGF("R1")
|
|---|
| 156 | . do FRAME^TMGXGF(T,L,B,R)
|
|---|
| 157 | . do CHGA^TMGXGF("R0")
|
|---|
| 158 | else if ('selected)&(focused) do
|
|---|
| 159 | . do CHGA^TMGXGF("I1")
|
|---|
| 160 | . do FRAME^TMGXGF(T,L,B,R)
|
|---|
| 161 | if (selected)!(focused) do CHGA^TMGXGF("I0")
|
|---|
| 162 |
|
|---|
| 163 | if rflags'="" do ;"goto P2
|
|---|
| 164 | PMV . new msg set msg=" ["
|
|---|
| 165 | . if rflags="T" set msg=msg_"MOVING"
|
|---|
| 166 | . else set msg=msg_"RESIZING"
|
|---|
| 167 | . set msg=msg_". Press ENTER to stop] "
|
|---|
| 168 | . set W=+$get(LOC("WIDTH"))
|
|---|
| 169 | . set msg=$extract(msg,1,W-1)
|
|---|
| 170 | . do SAY^TMGXGF(T+1,L+1,msg,"")
|
|---|
| 171 | . do setProp^TMGOOL($$GetScrn(),"NEEDS REPAINT",1) ;"flag full screen repaint needed next time
|
|---|
| 172 |
|
|---|
| 173 | ;"Here I paint any children (and they can paint their children)
|
|---|
| 174 | new num set num=""
|
|---|
| 175 | for set num=$order(@TMGthis@("CHILDREN",num)) quit:(+num'>0) do
|
|---|
| 176 | X2 . new child set child=$order(@TMGthis@("CHILDREN",num,""))
|
|---|
| 177 | . if child="" quit
|
|---|
| 178 | . do proc^TMGOOL(child,"PAINT")
|
|---|
| 179 |
|
|---|
| 180 | P2
|
|---|
| 181 | do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",0) ;"flag as painted.
|
|---|
| 182 |
|
|---|
| 183 | quit 0
|
|---|
| 184 |
|
|---|
| 185 |
|
|---|
| 186 | MoveObj(cmdKey)
|
|---|
| 187 | ;"Purpose: To move (drag) the object based on mouse movement
|
|---|
| 188 | ;"Input: cmdKey. PASS BY REFERENCE. An array with following structure
|
|---|
| 189 | ;" cmdKey="xxx" <--- ignored
|
|---|
| 190 | ;" cmdKey("DELTA","TOP") <-- delta Y
|
|---|
| 191 | ;" cmdKey("DELTA","LEFT") <-- delta X
|
|---|
| 192 | ;"Output: returns result in cmdKey('RESULT'): -1=failure, 1=success
|
|---|
| 193 |
|
|---|
| 194 | new T,L,LOC,PLOC,dT,dL,csrT,csrL
|
|---|
| 195 | new result set result=0
|
|---|
| 196 | new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
|
|---|
| 197 |
|
|---|
| 198 | set dT=+$get(cmdKey("DELTA","TOP")),dL=+$get(cmdKey("DELTA","LEFT"))
|
|---|
| 199 | set csrT=+$get(cmdKey("GLOBAL COORDS","TOP"))
|
|---|
| 200 | set csrL=+$get(cmdKey("GLOBAL COORDS","LEFT"))
|
|---|
| 201 | new PT,PL,PB,PR
|
|---|
| 202 | do getPCoords(TMGthis,.PT,.PL,.PB,.PR) ;"get parent coordinates (in SCREEN frame of refernce)
|
|---|
| 203 | if (dT<0)&(csrT<PT) set result=-1
|
|---|
| 204 | if (dT>0)&(csrT>PB) set result=-1
|
|---|
| 205 | if (dL<0)&(csrL<PL) set result=-1
|
|---|
| 206 | if (dL>0)&(csrL>PR) set result=-1
|
|---|
| 207 | if result=-1 goto MOL2
|
|---|
| 208 |
|
|---|
| 209 | set T=$get(LOC("TOP"))+dT
|
|---|
| 210 | set L=$get(LOC("LEFT"))+dL
|
|---|
| 211 | set result=$$fn^TMGOOL(TMGthis,"MOVE TO",.T,.L)
|
|---|
| 212 | MOL2
|
|---|
| 213 | if result>0 do
|
|---|
| 214 | . new scrap set scrap=$$FlushMouseBuffer()
|
|---|
| 215 | . do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1) ;"flag repaint of entire screen
|
|---|
| 216 | . set cmdKey("RESULT")=1
|
|---|
| 217 | else do
|
|---|
| 218 | . set cmdKey("RESULT")=-1
|
|---|
| 219 | quit result
|
|---|
| 220 |
|
|---|
| 221 |
|
|---|
| 222 | ResizeObj(flags,cmdKey)
|
|---|
| 223 | ;"Purpose: to resize the object based on mouse movement.
|
|---|
| 224 | ;"Input: flags
|
|---|
| 225 | ;" "T" if on top of frame ; <--- shouldn't be called here with just T
|
|---|
| 226 | ;" "B" if on bottom of frame
|
|---|
| 227 | ;" "L" if on left of frame
|
|---|
| 228 | ;" "R" if on right of frame
|
|---|
| 229 | ;" "TL","TR","BL","BR" for the corners
|
|---|
| 230 | ;" cmdKey. PASS BY REFERENCE. An array with following structure
|
|---|
| 231 | ;" cmdKey="xxx" <--- ignored
|
|---|
| 232 | ;" cmdKey("DELTA","TOP") <-- delta Y
|
|---|
| 233 | ;" cmdKey("DELTA","LEFT") <-- delta X
|
|---|
| 234 | ;"Results: none
|
|---|
| 235 | ;"Output: cmdKey("RESULT")=-1 if failure
|
|---|
| 236 |
|
|---|
| 237 | new T,L,W,H,LOC
|
|---|
| 238 | new scrap set scrap=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
|
|---|
| 239 | set T=$get(LOC("TOP")),L=$get(LOC("LEFT"))
|
|---|
| 240 | set H=$get(LOC("HEIGHT")),W=$get(LOC("WIDTH"))
|
|---|
| 241 | new dX,dY
|
|---|
| 242 | set dX=$get(cmdKey("DELTA","LEFT"))
|
|---|
| 243 | set dY=$get(cmdKey("DELTA","TOP"))
|
|---|
| 244 |
|
|---|
| 245 | if flags["T" do
|
|---|
| 246 | . set T=T+dY
|
|---|
| 247 | . set H=H-dY
|
|---|
| 248 | if flags["L" do
|
|---|
| 249 | . set L=L+dX
|
|---|
| 250 | . set W=W-dX
|
|---|
| 251 | if flags["B" do
|
|---|
| 252 | . set H=H+dY
|
|---|
| 253 | if flags["R" do
|
|---|
| 254 | . set W=W+dX
|
|---|
| 255 |
|
|---|
| 256 | new success set success=$$setTLHW(T,L,H,W)
|
|---|
| 257 | if success=0 do
|
|---|
| 258 | RO1 . set cmdKey("RESULT")=-1 ;"failure signal.
|
|---|
| 259 | else new scrap set scrap=$$FlushMouseBuffer()
|
|---|
| 260 |
|
|---|
| 261 | quit 0
|
|---|
| 262 |
|
|---|
| 263 |
|
|---|
| 264 | MoveTo(Top,Left)
|
|---|
| 265 | ;"Purpose: position object
|
|---|
| 266 | ;"Results: 1 if change made, 0 if not change made
|
|---|
| 267 | new result set result=0
|
|---|
| 268 | new LOC set LOC=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
|
|---|
| 269 | if $get(LOC("TOP"))'=Top do
|
|---|
| 270 | . do setProp^TMGOOL(TMGthis,"TOP",.Top)
|
|---|
| 271 | . if $$getProp^TMGOOL(TMGthis,"TOP")'=Top quit ;" set failed
|
|---|
| 272 | . set result=1
|
|---|
| 273 | if $get(LOC("LEFT"))'=Left do
|
|---|
| 274 | . do setProp^TMGOOL(TMGthis,"LEFT",.Left)
|
|---|
| 275 | . if $$getProp^TMGOOL(TMGthis,"LEFT")'=Left quit ;" set failed
|
|---|
| 276 | . set result=1
|
|---|
| 277 | ;"do setProp^TMGOOL(TMGthis,"TOP",.Top)
|
|---|
| 278 | ;"do setProp^TMGOOL(TMGthis,"LEFT",.Left)
|
|---|
| 279 | quit result
|
|---|
| 280 |
|
|---|
| 281 |
|
|---|
| 282 | AcceptChild(Child)
|
|---|
| 283 | ;"Purpose: to add a child to list of managed children
|
|---|
| 284 | ;"Input: Child -- name/ref of child to add
|
|---|
| 285 |
|
|---|
| 286 | ;"Note: this num will be used as a 'z-order'. Can reorder later
|
|---|
| 287 | new num set num=""
|
|---|
| 288 | for set num=$order(@TMGthis@("CHILDREN",num)) quit:(+num'=num)
|
|---|
| 289 | set num=$order(@TMGthis@("CHILDREN",num),-1) ;"get last used number
|
|---|
| 290 | set num=num+1
|
|---|
| 291 | set @TMGthis@("CHILDREN",num,Child)=""
|
|---|
| 292 | quit 0
|
|---|
| 293 |
|
|---|
| 294 |
|
|---|
| 295 | FlushScrnSave()
|
|---|
| 296 | ;"Purpose: To flush the saved text from under this window
|
|---|
| 297 | kill @TMGthis@("screen save")
|
|---|
| 298 | quit 0
|
|---|
| 299 |
|
|---|
| 300 |
|
|---|
| 301 | Contains(LOC)
|
|---|
| 302 | ;"Purpose: To see if some coordinates are located inside this window
|
|---|
| 303 | ;"Input: LOC -- a location array. Pass by reference
|
|---|
| 304 | ;" LOC("TOP")=top
|
|---|
| 305 | ;" LOC("LEFT")=left
|
|---|
| 306 | ;" Coordinates (in parent's frame of reference)
|
|---|
| 307 | ;"Results: 1 if coordinates are contained, 0 otherwise
|
|---|
| 308 |
|
|---|
| 309 | new result set result=0
|
|---|
| 310 | ;"new temp set temp=$$Conv2Local(.LOC)
|
|---|
| 311 | ;"new temp set temp=$$Conv2Frame(.LOC,TMGthis)
|
|---|
| 312 | ;"Reemmber, THISs' coordinates are in parent's frame of ref
|
|---|
| 313 | new thisLOC set thisLOC=$$getProp^TMGOOL(TMGthis,"LOC",.thisLOC)
|
|---|
| 314 | if (LOC("TOP")<$get(thisLOC("TOP")))!(LOC("LEFT")<$get(thisLOC("LEFT"))) goto CDone
|
|---|
| 315 | if LOC("TOP")>($get(thisLOC("TOP"))+$get(thisLOC("HEIGHT"))) goto CDone
|
|---|
| 316 | if LOC("LEFT")>($get(thisLOC("LEFT"))+$get(thisLOC("WIDTH"))) goto CDone
|
|---|
| 317 | set result=1
|
|---|
| 318 | CDone
|
|---|
| 319 | quit result
|
|---|
| 320 |
|
|---|
| 321 |
|
|---|
| 322 | Conv2Frame(LOC,targetFrame)
|
|---|
| 323 | ;"Purpose: convert LOC to targetFrame's coordinate system.
|
|---|
| 324 | ;" Note: initially, targetFrame may only be the name/ref of a parent,
|
|---|
| 325 | ;" or child of TMGthis, or the word 'SCREEN' to indicate
|
|---|
| 326 | ;" a desired targetFrame to be in screen coordinates.
|
|---|
| 327 | ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
|
|---|
| 328 | ;" LOC("TOP")=
|
|---|
| 329 | ;" LOC("LEFT")=
|
|---|
| 330 | ;" LOC("HEIGHT")= ;"optional
|
|---|
| 331 | ;" LOC("WIDTH")= ;"optional
|
|---|
| 332 | ;" LOC("BOTTOM")=
|
|---|
| 333 | ;" LOC("RIGHT")=
|
|---|
| 334 | ;" LOC("FRAME")=Frame of reference for these coordinates
|
|---|
| 335 | ;" Note: frame should typically be the same as
|
|---|
| 336 | ;" the PARENT of the current object
|
|---|
| 337 | ;" targetFrame=the frame of refernce to change to.
|
|---|
| 338 | ;"Results: none
|
|---|
| 339 | ;"Output: Input variables are modified as OUT PARAMETERS
|
|---|
| 340 | ;" LOC("TOP") is modified
|
|---|
| 341 | ;" LOC("LEFT") is modified
|
|---|
| 342 | ;" LOC("HEIGHT")=unchanged
|
|---|
| 343 | ;" LOC("WIDTH")=unchanged
|
|---|
| 344 | ;" LOC("BOTTOM") is updated
|
|---|
| 345 | ;" LOC("RIGHT") is updated
|
|---|
| 346 |
|
|---|
| 347 | new pathArray
|
|---|
| 348 | do getPath(.LOC,targetFrame,.pathArray)
|
|---|
| 349 | do convPath(.LOC,.pathArray)
|
|---|
| 350 |
|
|---|
| 351 | C2FDone
|
|---|
| 352 | quit 0
|
|---|
| 353 |
|
|---|
| 354 |
|
|---|
| 355 | GetScrn()
|
|---|
| 356 | ;"Purpose: to get a ref/name/pointer to Screen.
|
|---|
| 357 | ;" Note: because all graphic objects have to have the Screen as the
|
|---|
| 358 | ;" ultimate parent, this will be found by recursively searching for parents
|
|---|
| 359 | ;"results: returns ref to Screen
|
|---|
| 360 |
|
|---|
| 361 | new result set result=""
|
|---|
| 362 | new curObj set curObj=TMGthis
|
|---|
| 363 | for do quit:(curObj="")!(result'="")
|
|---|
| 364 | . set result=$$getProp^TMGOOL(curObj,"SCREEN")
|
|---|
| 365 | . set curObj=$$getProp^TMGOOL(curObj,"PARENT")
|
|---|
| 366 |
|
|---|
| 367 | quit result
|
|---|
| 368 |
|
|---|
| 369 |
|
|---|
| 370 | ClipToParent(TMGthis,extraT,extraL,extraB,extraR)
|
|---|
| 371 | ;"Purpose: to set the clipping boundries to the parent frame of TMGthis
|
|---|
| 372 | ;"Note: because the parent frame might be partly off screen, this will also
|
|---|
| 373 | ;" clip to the screen to prevent off-screen writing.
|
|---|
| 374 | ;"Input: TMGthis -- the THIS pointer to have the clipping to
|
|---|
| 375 | ;" extraT,extraL,extraB,extraR -- OPTIONAL -- NOT IMPLEMENTED (YET)
|
|---|
| 376 | ;" was to allow shrinking of the clip area by extra amounts.
|
|---|
| 377 | new PT,PL,PB,PR
|
|---|
| 378 | do getPCoords(TMGthis,.PT,.PL,.PB,.PR) ;"get parent coordinates
|
|---|
| 379 | new pScrn set pScrn=$$GetScrn()
|
|---|
| 380 | new ST,SL,SB,SR,SLOC
|
|---|
| 381 | set SLOC=$$getProp^TMGOOL(pScrn,"LOC",.SLOC) ;"get screen coordinates
|
|---|
| 382 | set ST=+$get(SLOC("TOP"))
|
|---|
| 383 | set SL=+$get(SLOC("LEFT"))
|
|---|
| 384 | set SR=SL+$get(SLOC("WIDTH"))
|
|---|
| 385 | set SB=ST+$get(SLOC("HEIGHT"))
|
|---|
| 386 | if PT<ST set PT=ST
|
|---|
| 387 | if PB'<SB set PB=SB
|
|---|
| 388 | if PL<SL set PL=SL
|
|---|
| 389 | if PR'<SR set PR=SR
|
|---|
| 390 | do SETCLIP^TMGXGF(PT,PL,PB,PR) ;"clip to parent's window
|
|---|
| 391 | quit 0
|
|---|
| 392 |
|
|---|
| 393 |
|
|---|
| 394 | FlushMouseBuffer()
|
|---|
| 395 | ;"Purpose: to flush mouse buffer so false trail isn't laid down after object change
|
|---|
| 396 |
|
|---|
| 397 | new pScrn set pScrn=$$GetScrn()
|
|---|
| 398 | set pScrn=$$getProp^TMGOOL(pScrn,"MOUSE HOLDER")
|
|---|
| 399 | if pScrn'="" kill @pScrn@("MOUSE","SAVE") ;"flush mouse save buffer
|
|---|
| 400 | quit 0
|
|---|
| 401 |
|
|---|
| 402 | ;"------------------------------------------
|
|---|
| 403 | ;"Event handlers below
|
|---|
| 404 | ;"------------------------------------------
|
|---|
| 405 |
|
|---|
| 406 | HandleAlpha(key)
|
|---|
| 407 | ;"Purpose: Accept an alpha-numeric character, and process as implemented
|
|---|
| 408 | ;"Note: This will be one key at a time, EXCEPT if an enter/return has
|
|---|
| 409 | ;" been pressed. In that case, key=CR
|
|---|
| 410 | ;"input: key -- the one letter alpha-numeric entered by user
|
|---|
| 411 |
|
|---|
| 412 | ;"I will add functionality here later...
|
|---|
| 413 |
|
|---|
| 414 | quit ;"<-- required: NO return value for event handler
|
|---|
| 415 |
|
|---|
| 416 |
|
|---|
| 417 | HandleMsg(cmdKey)
|
|---|
| 418 | ;"Purpose: Accept a command character, and process as implemented
|
|---|
| 419 | ;"Input: cmdKey -- the command input. Examples:
|
|---|
| 420 | ;" **MESSAGES**
|
|---|
| 421 | ;" For messages, cmdKey='MESSAGE TEXT'
|
|---|
| 422 | ;" All messages will include mouse locations:
|
|---|
| 423 | ;" cmdKey("TOP"), and cmdKey("LEFT") <-- in parent's coordinates frame of reference
|
|---|
| 424 | ;" Note: Because the top,left are in the parent's frame of reference,
|
|---|
| 425 | ;" a call to Conv2Local to get local frame. For example,
|
|---|
| 426 | ;" if a control on a window was located at 10,10 and it gets clicked
|
|---|
| 427 | ;" at 12,15, then a call Conv2Local will convert this to 2,5, and
|
|---|
| 428 | ;" this will make sense for the child
|
|---|
| 429 | ;" COMMAND Details stored in ("KEY") node: e.g.
|
|---|
| 430 | ;" UP, DOWN, LEFT, RIGHT
|
|---|
| 431 | ;" NEXT (page down), PREV (page up)
|
|---|
| 432 | ;" REMOVE (for delete)
|
|---|
| 433 | ;" note: HOME and END are NOT returned from READ^TMGXGF.
|
|---|
| 434 | ;" F1, F2, ...
|
|---|
| 435 | ;" ^A, ^B (ctrl-A, ctrl-B etc.)
|
|---|
| 436 | ;" TAB
|
|---|
| 437 | ;" ESC (maybe)
|
|---|
| 438 | ;" MOUSE-CLICK -- includes mouse location
|
|---|
| 439 | ;" MOUSE-SHIFT-CLICK -- includes mouse location
|
|---|
| 440 | ;" MOVE REQUEST
|
|---|
| 441 | ;" ("DELTA","TOP")=deltaTop
|
|---|
| 442 | ;" ("DELTA","LEFT")=deltaLeft
|
|---|
| 443 | ;" i.e. TOP=1,LEFT=1 would mean that the mouse moved downward 1 and rightward 1
|
|---|
| 444 | ;" CHECK PAINT, FULL PAINT
|
|---|
| 445 | ;"Result: none. To pass back a result, set:
|
|---|
| 446 | ;" cmdKey("RESULT")=result
|
|---|
| 447 | ;" -1 ==> failure
|
|---|
| 448 | ;" 0 ==> OK
|
|---|
| 449 | ;" 1 ==> handled
|
|---|
| 450 |
|
|---|
| 451 | new result set result=0
|
|---|
| 452 | set cmdKey=$get(cmdKey)
|
|---|
| 453 | set cmdKey("RESULT")=result
|
|---|
| 454 | new child set child=""
|
|---|
| 455 | new temp set temp=$$Conv2Frame(.cmdKey,TMGthis) ;"convert coordinates to TMGthis's frame
|
|---|
| 456 |
|
|---|
| 457 | if cmdKey="FULL PAINT" do
|
|---|
| 458 | . ;"Draw a frame to white out entire screen.
|
|---|
| 459 | . ;"do CLEAR^TMGXGF(0,0,IOSL,IOM) ;"clear screen portion TOP,LEFT,BOTTOM,RIGHT
|
|---|
| 460 | . new scrap set scrap=$$FlushScrnSave()
|
|---|
| 461 | . do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1)
|
|---|
| 462 | . set cmdKey="CHECK PAINT"
|
|---|
| 463 |
|
|---|
| 464 | if cmdKey="CHECK PAINT" do goto AMDone
|
|---|
| 465 | . do CheckPaint ;"note only MainWindow should be getting this event, from Screen
|
|---|
| 466 |
|
|---|
| 467 | ;"NOTE: If a CLICK occurs, check to pass the message on to newly chosen child
|
|---|
| 468 | ;" Otherwise message should go to focused child.
|
|---|
| 469 | if cmdKey["CLICK" do goto:(child'="") AMDone
|
|---|
| 470 | . ;"First find out if click should belong to a child window. If so, pass it on.
|
|---|
| 471 | . set child=$$GetContained(.cmdKey)
|
|---|
| 472 | . if child="" do UnfocusCur() quit ;"ignore click
|
|---|
| 473 | . else do FocusThis()
|
|---|
| 474 | . do fireEvent^TMGOOL(child,"MSG",.cmdKey)
|
|---|
| 475 |
|
|---|
| 476 | new focused set focused=$$getFocused()
|
|---|
| 477 | if focused'="" do goto AMDone
|
|---|
| 478 | . do fireEvent^TMGOOL(focused,"MSG",.cmdKey) ;"pass message to focused and quit
|
|---|
| 479 |
|
|---|
| 480 | ;"Message belongs to this object, so handle messages below:
|
|---|
| 481 | ;"--------------------------------------------------------
|
|---|
| 482 | do FocusThis()
|
|---|
| 483 | if cmdKey="MOUSE-CLICK" do
|
|---|
| 484 | . set cmdKey("RESULT")=1
|
|---|
| 485 | . do fireEvent^TMGOOL(TMGthis,"CLICK",.cmdKey)
|
|---|
| 486 | else if cmdKey="MOUSE-SHIFT-CLICK" do
|
|---|
| 487 | . do fireEvent^TMGOOL(TMGthis,"SHIFT-CLICK",.cmdKey)
|
|---|
| 488 | . set cmdKey("RESULT")=1
|
|---|
| 489 | else if cmdKey="MOVE REQUEST" do
|
|---|
| 490 | AMMM . new flags set flags=$$getProp^TMGOOL(TMGthis,"RESIZING FLAGS")
|
|---|
| 491 | . if flags="" do fireEvent^TMGOOL(TMGthis,"MOVE REQUEST",.cmdKey) quit
|
|---|
| 492 | . new pScrn set pScrn=$$GetScrn()
|
|---|
| 493 | . do setProp^TMGOOL(pScrn,"NEEDS REPAINT",1)
|
|---|
| 494 | . new scrap set scrap=$$FlushMouseBuffer()
|
|---|
| 495 | . if flags="T" do quit
|
|---|
| 496 | . . do proc^TMGOOL(TMGthis,"MOVE OBJ",.cmdKey) ;"returns result in cmdKey
|
|---|
| 497 | . do proc^TMGOOL(TMGthis,"RESIZE OBJ",flags,.cmdKey) quit
|
|---|
| 498 |
|
|---|
| 499 | AMDone
|
|---|
| 500 | quit ;"<-- required: NO return value for event handler
|
|---|
| 501 |
|
|---|
| 502 |
|
|---|
| 503 | HndlMMove(cmdKey) ;"Handle MouseMove request
|
|---|
| 504 | ;"Purpose: Handle Mouse Move
|
|---|
| 505 | ;"Input: cmdKey -- the command input.
|
|---|
| 506 | ;" MOVE REQUEST
|
|---|
| 507 | ;" ("TOP")=Current Top
|
|---|
| 508 | ;" ("LEFT")=Current Left
|
|---|
| 509 | ;" ("DELTA","TOP")=deltaTop
|
|---|
| 510 | ;" ("DELTA","LEFT")=deltaLeft
|
|---|
| 511 | ;" i.e. TOP=1,LEFT=1 would mean that the mouse moved downward 1 and rightward 1
|
|---|
| 512 | ;"Result: None, but result is put into cmdKey("RESULT")
|
|---|
| 513 | ;" -1 ==> failure
|
|---|
| 514 | ;" 0 ==> OK
|
|---|
| 515 | ;" 1 ==> handled
|
|---|
| 516 |
|
|---|
| 517 | new abort set abort=0
|
|---|
| 518 | set cmdKey("RESULT")=0
|
|---|
| 519 | new temp set temp=$$Conv2Frame(.cmdKey,TMGthis) ;"ensure coordinates in TMGthis's frame
|
|---|
| 520 | new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT") ;"if null, then this is MainWindow
|
|---|
| 521 | new newT,newL
|
|---|
| 522 | set newT=+$get(cmdKey("TOP"))+$get(cmdKey("DELTA","TOP"))
|
|---|
| 523 | set newL=+$get(cmdKey("LEFT"))+$get(cmdKey("DELTA","LEFT"))
|
|---|
| 524 | set LOC=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
|
|---|
| 525 |
|
|---|
| 526 | if (newT<0)!(newT>$get(LOC("HEIGHT")))!(newL<0)!(newL>$get(LOC("WIDTH"))) do
|
|---|
| 527 | . if parent="SCREEN" do quit ;"don't allow mouse to go off screen.
|
|---|
| 528 | . . set result=-1,abort=1
|
|---|
| 529 | . do fireEvent^TMGOOL(TMGthis,"LOOSING FOCUS",.cmdKey)
|
|---|
| 530 | if abort goto HMMDone
|
|---|
| 531 |
|
|---|
| 532 | HMM new flags set flags=$$getProp^TMGOOL(TMGthis,"RESIZING FLAGS")
|
|---|
| 533 | if flags="" goto HMMDone
|
|---|
| 534 | if flags="T" do proc^TMGOOL(TMGthis,"MOVE OBJ",.cmdKey) goto HMMDone
|
|---|
| 535 | do proc^TMGOOL(TMGthis,"RESIZE OBJ",flags,.cmdKey) goto HMMDone
|
|---|
| 536 | HMMDone
|
|---|
| 537 | set cmdKey("RESULT")=result
|
|---|
| 538 | quit ;"<-- required: NO return value for event handler
|
|---|
| 539 |
|
|---|
| 540 |
|
|---|
| 541 | HandleClick(LOC)
|
|---|
| 542 | ;"Purpose: do something here with a mouse click. Note: descendents can
|
|---|
| 543 | ;" overwrite this function to customize their control.
|
|---|
| 544 | ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
|
|---|
| 545 | ;" coordinates in LOCAL frame of refeernces.
|
|---|
| 546 | ;" LOC("TOP")=
|
|---|
| 547 | ;" LOC("LEFT")=
|
|---|
| 548 | ;" LOC("HEIGHT")= ;"optional
|
|---|
| 549 | ;" LOC("WIDTH")= ;"optional
|
|---|
| 550 | ;" LOC("BOTTOM")= ;"optional
|
|---|
| 551 | ;" LOC("RIGHT")= ;"optional
|
|---|
| 552 | ;"Note: It has already been determined that the click belongs to this window
|
|---|
| 553 | ;" (and not a child of this window), so it should be handled here.)
|
|---|
| 554 |
|
|---|
| 555 | ;"Click belongs to this window, so handle it.
|
|---|
| 556 |
|
|---|
| 557 | ;"Put default click handler code here...
|
|---|
| 558 | do FocusThis()
|
|---|
| 559 | new temp set temp=$$Conv2Frame(.LOC,TMGthis) ;"ensure coordinates in TMGthis's frame
|
|---|
| 560 |
|
|---|
| 561 | new checkFrame set checkFrame=$$ClickOnFrame(.LOC)
|
|---|
| 562 | if checkFrame'="" do goto HCDone
|
|---|
| 563 | . do fireEvent^TMGOOL(TMGthis,"FRAME CLICK",.LOC,.checkFrame)
|
|---|
| 564 |
|
|---|
| 565 | HCDone
|
|---|
| 566 | quit ;"<-- required: NO return value for event handler
|
|---|
| 567 |
|
|---|
| 568 |
|
|---|
| 569 |
|
|---|
| 570 | HandleSClick(LOC)
|
|---|
| 571 | ;"Purpose: do something here with a mouse shift click. Note: descendents can
|
|---|
| 572 | ;" overwrite this function to customize their control.
|
|---|
| 573 | ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
|
|---|
| 574 | ;" coordinates in LOCAL frame of refeernces.
|
|---|
| 575 | ;" LOC("TOP")=
|
|---|
| 576 | ;" LOC("LEFT")=
|
|---|
| 577 | ;" LOC("HEIGHT")= ;"optional
|
|---|
| 578 | ;" LOC("WIDTH")= ;"optional
|
|---|
| 579 | ;" LOC("BOTTOM")= ;"optional
|
|---|
| 580 | ;" LOC("RIGHT")= ;"optional
|
|---|
| 581 | ;"Note: It has already been determined that the click belongs to this window
|
|---|
| 582 | ;" (and not a child of this window), so it should be handled here.)
|
|---|
| 583 |
|
|---|
| 584 | ;"Click belongs to this window, so handle it.
|
|---|
| 585 |
|
|---|
| 586 | ;"Put default click handler code here...
|
|---|
| 587 | new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 588 | do proc^TMGOOL(parent,"SET FOCUSED",TMGthis)
|
|---|
| 589 |
|
|---|
| 590 | if $$getProp^TMGOOL(TMGthis,"STATE")="SELECTED" do
|
|---|
| 591 | . do setProp^TMGOOL(TMGthis,"STATE",0)
|
|---|
| 592 | else do setProp^TMGOOL(TMGthis,"STATE","SELECTED")
|
|---|
| 593 |
|
|---|
| 594 | ADCDone
|
|---|
| 595 | quit ;"<-- required: NO return value for event handler
|
|---|
| 596 |
|
|---|
| 597 |
|
|---|
| 598 | FmClick(LOC,flags)
|
|---|
| 599 | ;"Purpose: Handle a click on the frame.
|
|---|
| 600 | ;" This sets RESIZING FLAGS property for later
|
|---|
| 601 | ;" interpretation during window paints and mouse moves
|
|---|
| 602 | ;"Input: LOC -- the coordinates of the triggering click.
|
|---|
| 603 | ;" flags, containing:
|
|---|
| 604 | ;" "T" if on top of frame
|
|---|
| 605 | ;" "B" if on bottom of frame
|
|---|
| 606 | ;" "L" if on left of frame
|
|---|
| 607 | ;" "R" if on right of frame
|
|---|
| 608 | ;" "TL","TR","BL","BR" for the corners
|
|---|
| 609 | ;" note: no gaurantee regarding order: "TL" vs "LT"
|
|---|
| 610 |
|
|---|
| 611 | if $get(flags)="" goto AFMCDone
|
|---|
| 612 | if $$getProp^TMGOOL(TMGthis,"FRAME")'="SIZABLE" goto AFMCDone ;"If not resizable, abort
|
|---|
| 613 |
|
|---|
| 614 | new curFlags set curFlags=$$getProp^TMGOOL(TMGthis,"RESIZING FLAGS")
|
|---|
| 615 | if (curFlags'="") set flags="" ;"i.e. 2nd click on frame drops resizing
|
|---|
| 616 | do setProp^TMGOOL(TMGthis,"RESIZING FLAGS",flags)
|
|---|
| 617 | do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",1)
|
|---|
| 618 | new scrap set scrap=$$FlushMouseBuffer()
|
|---|
| 619 |
|
|---|
| 620 | AFMCDone
|
|---|
| 621 | quit
|
|---|
| 622 |
|
|---|
| 623 |
|
|---|
| 624 |
|
|---|
| 625 | ;"------------------------------------------
|
|---|
| 626 | ;"Property Getters & Setters below
|
|---|
| 627 | ;"------------------------------------------
|
|---|
| 628 |
|
|---|
| 629 | getLOC(TMGthis,PropName,outArray)
|
|---|
| 630 | ;"Purpose: to get LOC coordinates array of window
|
|---|
| 631 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 632 | ;" PropName -- the name of the property -- not used here
|
|---|
| 633 | ;" outArray -- PASSED BY REFERENCE. An standardized output array
|
|---|
| 634 | ;"Note: because sometimes the getters do special things, I will alter
|
|---|
| 635 | ;" this function so it doesn't bypass that code
|
|---|
| 636 | set outArray("TOP")=+$$getProp^TMGOOL(TMGthis,"TOP")
|
|---|
| 637 | set outArray("LEFT")=+$$getProp^TMGOOL(TMGthis,"LEFT")
|
|---|
| 638 | set outArray("WIDTH")=+$$getProp^TMGOOL(TMGthis,"WIDTH")
|
|---|
| 639 | set outArray("HEIGHT")=+$$getProp^TMGOOL(TMGthis,"HEIGHT")
|
|---|
| 640 | set outArray("STATE")=+$$getProp^TMGOOL(TMGthis,"STATE")
|
|---|
| 641 | ;"merge outArray=@TMGthis@("PROP","LOC")
|
|---|
| 642 | new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 643 | set outArray("FRAME")=parent
|
|---|
| 644 | quit 0 ;"discarable result.
|
|---|
| 645 |
|
|---|
| 646 | setTop(TMGthis,PropName,Top)
|
|---|
| 647 | ;"Purpose: to set TOP coordinates of window
|
|---|
| 648 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 649 | ;" PropName -- the name of the property -- not used here
|
|---|
| 650 | ;" Top -- the coordinates of the TOP. 0 is top of screen
|
|---|
| 651 | set Top=$get(Top,0)
|
|---|
| 652 | new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 653 | new height
|
|---|
| 654 | if parent'="SCREEN" set height=$$getProp^TMGOOL(parent,"HEIGHT")
|
|---|
| 655 | else set height=9999
|
|---|
| 656 | if (Top>-1)&(Top'>height) do
|
|---|
| 657 | . set @TMGthis@("PROP","LOC","TOP")=Top
|
|---|
| 658 | quit ;"<-- required not return value for property setter.
|
|---|
| 659 |
|
|---|
| 660 | getTop(TMGthis,PropName,outArray)
|
|---|
| 661 | ;"Purpose: to get TOP coordinates of window
|
|---|
| 662 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 663 | ;" PropName -- the name of the property -- not used here
|
|---|
| 664 | ;" outArray -- PASSED BY REFERENCE. An standardized output array
|
|---|
| 665 | new result set result=""
|
|---|
| 666 | new align set align=$$getProp^TMGOOL(TMGthis,"ALIGN")
|
|---|
| 667 | if (align="TOP")!(align="LEFT")!(align="RIGHT") do
|
|---|
| 668 | . set result=1
|
|---|
| 669 | else if (align="BOTTOM") do
|
|---|
| 670 | . new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 671 | . new PH set PH=$$getProp^TMGOOL(parent,"HEIGHT")
|
|---|
| 672 | . new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT")
|
|---|
| 673 | . set result=(PH-1)-H
|
|---|
| 674 | else do
|
|---|
| 675 | . set result=$get(@TMGthis@("PROP","LOC","TOP"))
|
|---|
| 676 |
|
|---|
| 677 | set outArray=result
|
|---|
| 678 | quit result
|
|---|
| 679 |
|
|---|
| 680 | setLeft(TMGthis,PropName,Left)
|
|---|
| 681 | ;"Window member function (with no return value, i.e. a procedure)
|
|---|
| 682 | ;"Purpose: to set LEFT coordinates of window
|
|---|
| 683 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 684 | ;" PropName -- the name of the property -- not used here
|
|---|
| 685 | ;" Left -- the coordinates of the LEFT. 0 is left of screen
|
|---|
| 686 | set Left=$get(Left,0)
|
|---|
| 687 | new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 688 | new width
|
|---|
| 689 | if parent'="SCREEN" set width=$$getProp^TMGOOL(parent,"WIDTH")
|
|---|
| 690 | else set width=9999
|
|---|
| 691 | ;"if (Left>-1)&(Left<IOM) do
|
|---|
| 692 | if (Left<width) do
|
|---|
| 693 | . set @TMGthis@("PROP","LOC","LEFT")=Left
|
|---|
| 694 | quit ;"<-- required not return value for property setter.
|
|---|
| 695 |
|
|---|
| 696 | getLeft(TMGthis,PropName,outArray)
|
|---|
| 697 | ;"Purpose: to get LEFT coordinates of window
|
|---|
| 698 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 699 | ;" PropName -- the name of the property -- not used here
|
|---|
| 700 | ;" outArray -- PASSED BY REFERENCE. An standardized output array
|
|---|
| 701 |
|
|---|
| 702 | new result set result=""
|
|---|
| 703 | new align set align=$$getProp^TMGOOL(TMGthis,"ALIGN")
|
|---|
| 704 | if (align="TOP")!(align="LEFT")!(align="BOTTOM") do
|
|---|
| 705 | . set result=1
|
|---|
| 706 | else if (align="RIGHT") do
|
|---|
| 707 | . new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 708 | . new PW set PW=$$getProp^TMGOOL(parent,"WIDTH")
|
|---|
| 709 | . new W set W=$$getProp^TMGOOL(TMGthis,"WIDTH")
|
|---|
| 710 | . set result=(PW-1)-W
|
|---|
| 711 | else do
|
|---|
| 712 | . set result=$get(@TMGthis@("PROP","LOC","LEFT"))
|
|---|
| 713 |
|
|---|
| 714 | set outArray=result
|
|---|
| 715 | quit result
|
|---|
| 716 |
|
|---|
| 717 |
|
|---|
| 718 | setWidth(TMGthis,PropName,Width)
|
|---|
| 719 | ;"Window member function (with no return value, i.e. a procedure)
|
|---|
| 720 | ;"Purpose: to set WIDTH coordinates of window
|
|---|
| 721 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 722 | ;" PropName -- the name of the property -- not used here
|
|---|
| 723 | ;" Width -- the coordinates of the WIDTH.
|
|---|
| 724 | ;"Note: Width means ADDITIONAL columns of size in addition to left column.
|
|---|
| 725 | ;" Thus a vertical sizer bar has a height of '0', which really
|
|---|
| 726 | ;" displays as a single column. Confusing, but necessary
|
|---|
| 727 | set Width=$get(Width,0)
|
|---|
| 728 | if (Width>-1) do
|
|---|
| 729 | . set @TMGthis@("PROP","LOC","WIDTH")=Width
|
|---|
| 730 | quit ;"<-- required not return value for property setter.
|
|---|
| 731 |
|
|---|
| 732 |
|
|---|
| 733 | getWidth(TMGthis,PropName,outArray)
|
|---|
| 734 | ;"Purpose: to get WIDTH coordinates of window
|
|---|
| 735 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 736 | ;" PropName -- the name of the property -- not used here
|
|---|
| 737 | ;" outArray -- PASSED BY REFERENCE. An standardized output array
|
|---|
| 738 |
|
|---|
| 739 | ;"NOTE: this doesn't account for overlapping alignments. For example, when
|
|---|
| 740 | ;" A Hscroll is aligned to the bottom, and a Vscroller is alligned to
|
|---|
| 741 | ;" the right, then they both think that they occupy the bottom-right
|
|---|
| 742 | ;" corner. I need to fix this later. It will need to take into account
|
|---|
| 743 | ;" the z-order (or something) of the children.
|
|---|
| 744 |
|
|---|
| 745 | new result set result=""
|
|---|
| 746 | new align set align=$$getProp^TMGOOL(TMGthis,"ALIGN")
|
|---|
| 747 | if (align="TOP")!(align="BOTTOM") do
|
|---|
| 748 | . new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 749 | . set result=$$getProp^TMGOOL(parent,"WIDTH")
|
|---|
| 750 | . set result=result-1 ;"shrink inside parent's frame (yes, 1 is correct)
|
|---|
| 751 | else do ;"(align="NONE")!(align="LEFT")!(align="RIGHT")
|
|---|
| 752 | . set result=$get(@TMGthis@("PROP","LOC","WIDTH"))
|
|---|
| 753 |
|
|---|
| 754 | set outArray=result
|
|---|
| 755 | quit result
|
|---|
| 756 |
|
|---|
| 757 |
|
|---|
| 758 | setHeight(TMGthis,PropName,Height)
|
|---|
| 759 | ;"Window member function (with no return value, i.e. a procedure)
|
|---|
| 760 | ;"Purpose: to set WIDTH coordinates of window
|
|---|
| 761 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 762 | ;" PropName -- the name of the property -- not used here
|
|---|
| 763 | ;" Height -- the coordinates of the HEIGHT.
|
|---|
| 764 | ;"Note: Height means ADDITIONAL rows of size in addition to top row.
|
|---|
| 765 | ;" Thus a horizontal sizer bar has a height of '0', which really
|
|---|
| 766 | ;" displays as a single row. Confusing, but necessary
|
|---|
| 767 | set Height=$get(Height)
|
|---|
| 768 | if (Height>-1) do
|
|---|
| 769 | . set @TMGthis@("PROP","LOC","HEIGHT")=Height
|
|---|
| 770 | quit ;"<-- required not return value for property setter.
|
|---|
| 771 |
|
|---|
| 772 |
|
|---|
| 773 | getHeight(TMGthis,PropName,outArray)
|
|---|
| 774 | ;"Purpose: to get HEIGHT coordinates of window
|
|---|
| 775 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 776 | ;" PropName -- the name of the property -- not used here
|
|---|
| 777 | ;" outArray -- PASSED BY REFERENCE. An standardized output array
|
|---|
| 778 | new result set result=""
|
|---|
| 779 | new align set align=$$getProp^TMGOOL(TMGthis,"ALIGN")
|
|---|
| 780 | if (align="LEFT")!(align="RIGHT") do
|
|---|
| 781 | . new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 782 | . new PH set PH=$$getProp^TMGOOL(parent,"HEIGHT")
|
|---|
| 783 | . ;"new H set H=$$getProp^TMGOOL(TMGthis,"HEIGHT")
|
|---|
| 784 | . ;"set result=PH-H-1
|
|---|
| 785 | . set result=PH-1
|
|---|
| 786 | else do ;"(align="NONE")!(align="TOP")!(align="BOTTOM")
|
|---|
| 787 | . set result=$get(@TMGthis@("PROP","LOC","HEIGHT"))
|
|---|
| 788 |
|
|---|
| 789 | set outArray=result
|
|---|
| 790 | quit result
|
|---|
| 791 |
|
|---|
| 792 |
|
|---|
| 793 | setTLBR(Top,Left,Bottom,Right)
|
|---|
| 794 | ;"Purpose to set the Top,Left,Bottom,Right vales for object
|
|---|
| 795 | new width,height
|
|---|
| 796 | set width=Right-Left
|
|---|
| 797 | set height=Bottom-Top
|
|---|
| 798 | new scrap set scrap=$$setTLHW(.Top,.Left,.height,.width)
|
|---|
| 799 | quit 0
|
|---|
| 800 |
|
|---|
| 801 | setTLHW(Top,Left,Height,Width)
|
|---|
| 802 | ;"Purpose: to set the Top,Left,Height,Width values for object
|
|---|
| 803 | ;"Results: 1 if change made, 0 if not change made
|
|---|
| 804 | new result set result=0
|
|---|
| 805 | if +$get(Width)<1 set Width=1
|
|---|
| 806 | if +$get(Height)<1 set Height=1
|
|---|
| 807 | new LOC set LOC=$$getProp^TMGOOL(TMGthis,"LOC",.LOC)
|
|---|
| 808 | if $get(LOC("TOP"))'=Top do setProp^TMGOOL(TMGthis,"TOP",.Top) set result=1
|
|---|
| 809 | if $get(LOC("LEFT"))'=Left do setProp^TMGOOL(TMGthis,"LEFT",.Left) set result=1
|
|---|
| 810 | if $get(LOC("WIDTH"))'=Width do setProp^TMGOOL(TMGthis,"WIDTH",Width) set result=1
|
|---|
| 811 | if $get(LOC("HEIGHT"))'=Height do setProp^TMGOOL(TMGthis,"HEIGHT",Height) set result=1
|
|---|
| 812 | quit result
|
|---|
| 813 |
|
|---|
| 814 | setState(TMGthis,PropName,State)
|
|---|
| 815 | ;"Purpose: to set STATE property of window
|
|---|
| 816 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 817 | ;" PropName -- the name of the property -- not used here
|
|---|
| 818 | ;" State -- object State
|
|---|
| 819 | set @TMGthis@("PROP","LOC","STATE")=$get(State)
|
|---|
| 820 | quit ;"<-- required not return value for property setter.
|
|---|
| 821 |
|
|---|
| 822 | getState(TMGthis,PropName,outArray)
|
|---|
| 823 | ;"Purpose: to get TOP coordinates of window
|
|---|
| 824 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 825 | ;" PropName -- the name of the property -- not used here
|
|---|
| 826 | ;" outArray -- PASSED BY REFERENCE. An standardized output array
|
|---|
| 827 | set outArray=$get(@TMGthis@("PROP","LOC","STATE"))
|
|---|
| 828 | quit $get(@TMGthis@("PROP","LOC","STATE"))
|
|---|
| 829 |
|
|---|
| 830 |
|
|---|
| 831 | setParent(TMGthis,PropName,Parent)
|
|---|
| 832 | ;"Purpose: to link this object to a parent object, setting PARENT property
|
|---|
| 833 | ;"Note: Do NOT set PARENT directly. Use this function, which will
|
|---|
| 834 | ;" perform additional tasks associated with linking.
|
|---|
| 835 | ;" Parents will OWN child (i.e. be responsible for their destruction), and
|
|---|
| 836 | ;" also manage the placement and painting of the children.
|
|---|
| 837 | ;"Input: Parent -- the NAME (e.g. pWin) of parent to link to
|
|---|
| 838 | do proc^TMGOOL(Parent,"ACCEPT CHILD",TMGthis)
|
|---|
| 839 | set @TMGthis@("PROP","PARENT")=Parent
|
|---|
| 840 | quit ;"<-- required not return value for property setter.
|
|---|
| 841 |
|
|---|
| 842 |
|
|---|
| 843 | getParent(TMGthis,PropName,outArray)
|
|---|
| 844 | ;"Purpose: to get TOP coordinates of window
|
|---|
| 845 | ;"Input: TMGthis -- a this pointer for properter setter.
|
|---|
| 846 | ;" PropName -- the name of the property -- not used here
|
|---|
| 847 | ;" outArray -- PASSED BY REFERENCE. An standardized output array
|
|---|
| 848 | set outArray=$get(@TMGthis@("PROP","PARENT"))
|
|---|
| 849 | if outArray="" set outArray="SCREEN"
|
|---|
| 850 | quit outArray
|
|---|
| 851 |
|
|---|
| 852 |
|
|---|
| 853 | getNeedsRepaint(TMGthis,PropName,outArray)
|
|---|
| 854 | ;"Purpose: To determine if this object, or any of it's children need repainting
|
|---|
| 855 | ;"results: 1 if TMGthis needs repainting. 2 if a child needs repainting.
|
|---|
| 856 |
|
|---|
| 857 | new result set result=""
|
|---|
| 858 | new num set num=""
|
|---|
| 859 | set result=$get(@TMGthis@("PROP","NEEDS REPAINT"))
|
|---|
| 860 | if result=1 set outArray(TMGthis)=1 goto GNRPDone
|
|---|
| 861 | ;"Here query any children and see if they need repainting
|
|---|
| 862 | for set num=$order(@TMGthis@("CHILDREN",num)) quit:(+num'>0)!(+result>0) do
|
|---|
| 863 | . new child set child=$order(@TMGthis@("CHILDREN",num,""))
|
|---|
| 864 | . if child="" quit
|
|---|
| 865 | . new tempResult
|
|---|
| 866 | . set tempResult=$$getNeedsRepaint(child,"NEEDS REPAINT",.outArray)
|
|---|
| 867 | . if tempResult>0 set result=2
|
|---|
| 868 | . if result>0 set outArray(child)=1
|
|---|
| 869 |
|
|---|
| 870 | GNRPDone
|
|---|
| 871 | set outArray=result
|
|---|
| 872 | quit result
|
|---|
| 873 |
|
|---|
| 874 | ;"------------------------------------------
|
|---|
| 875 | ;"Private functions below
|
|---|
| 876 | ;"------------------------------------------
|
|---|
| 877 |
|
|---|
| 878 | setLOC(LOC,T,L,W,H)
|
|---|
| 879 | ;"Purpose: to create a LOC array from T (top), L(left) ... coords
|
|---|
| 880 | ;"Input: LOC -- pass by reference. The output array
|
|---|
| 881 | ;" T --> "TOP" etc.
|
|---|
| 882 | ;"results: none
|
|---|
| 883 | kill LOC
|
|---|
| 884 | set LOC("TOP")=+$get(T)
|
|---|
| 885 | set LOC("LEFT")=+$get(L)
|
|---|
| 886 | set LOC("WIDTH")=+$get(W)
|
|---|
| 887 | set LOC("HEIGHT")=+$get(H)
|
|---|
| 888 | set LOC("BOTTOM")=+$get(T)++$get(H)
|
|---|
| 889 | set LOC("RIGHT")=+$get(L)++$get(W)
|
|---|
| 890 | quit
|
|---|
| 891 |
|
|---|
| 892 |
|
|---|
| 893 | getPCoords(TMGthis,PT,PL,PB,PR)
|
|---|
| 894 | ;"Purpose: to get, in screen coordinates, the coordinates of the parent of TMGthis
|
|---|
| 895 | ;"Input: TMGthis : the THIS reference
|
|---|
| 896 | ;" PT,PL,PR,PB -- PASS BY REFERENCE, these are OUT PARAMETERS
|
|---|
| 897 | ;" note: these coordinates are in the SCREEN frame of reference
|
|---|
| 898 | ;"results: none
|
|---|
| 899 |
|
|---|
| 900 | new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 901 | new pScrn set pScrn=$$GetScrn()
|
|---|
| 902 | set scrap=$$getProp^TMGOOL(parent,"LOC",.PLOC)
|
|---|
| 903 | set scrap=$$Conv2Frame(.PLOC,"SCREEN")
|
|---|
| 904 |
|
|---|
| 905 | set PT=+$get(PLOC("TOP")),PL=+$get(PLOC("LEFT"))
|
|---|
| 906 | set PR=+$get(PLOC("RIGHT")),PB=$get(PLOC("BOTTOM"))
|
|---|
| 907 | if parent'=pScrn do ;"scrink to INSIDE parent
|
|---|
| 908 | . set PT=PT+1,PL=PL+1,PR=PR-1,PB=PB-1
|
|---|
| 909 | if PT<0 set PT=0
|
|---|
| 910 | if PL<0 set PL=0
|
|---|
| 911 | quit
|
|---|
| 912 |
|
|---|
| 913 | ClickOnFrame(LOC)
|
|---|
| 914 | ;"Purpose: to determine IF click occured on the boundries (frame) of this object
|
|---|
| 915 | ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
|
|---|
| 916 | ;" coordinates in LOCAL frame of refeernces.
|
|---|
| 917 | ;" LOC("TOP")=
|
|---|
| 918 | ;" LOC("LEFT")=
|
|---|
| 919 | ;" LOC("HEIGHT")= ;"optional
|
|---|
| 920 | ;" LOC("WIDTH")= ;"optional
|
|---|
| 921 | ;" LOC("BOTTOM")= ;"optional
|
|---|
| 922 | ;" LOC("RIGHT")= ;"optional
|
|---|
| 923 | ;"Results: "" = not on frame
|
|---|
| 924 | ;" "T" if on top of frame
|
|---|
| 925 | ;" "B" if on bottom of frame
|
|---|
| 926 | ;" "L" if on left of frame
|
|---|
| 927 | ;" "R" if on right of frame
|
|---|
| 928 | ;" "TL","TR","BL","BR" for the corners
|
|---|
| 929 | ;" note: no gaurantee regarding order: "TL" vs "LT"
|
|---|
| 930 |
|
|---|
| 931 | ;"new scrap set scrap=$$ConvInsideSelf(.LOC)
|
|---|
| 932 | set result=""
|
|---|
| 933 | if LOC("TOP")=0 set result=result_"T"
|
|---|
| 934 | if LOC("TOP")=$$getProp^TMGOOL(TMGthis,"HEIGHT") set result=result_"B"
|
|---|
| 935 | if LOC("LEFT")=0 set result=result_"L"
|
|---|
| 936 | if LOC("LEFT")=$$getProp^TMGOOL(TMGthis,"WIDTH") set result=result_"R"
|
|---|
| 937 |
|
|---|
| 938 | quit result
|
|---|
| 939 |
|
|---|
| 940 | IsFocused(child)
|
|---|
| 941 | ;"Purpose: to determine if the specified child is the focused child
|
|---|
| 942 | ;"Input: child -- OPTIONAL. the name/ref of the child to compare
|
|---|
| 943 | ;" If child="" then function will return if TMGthis is focused
|
|---|
| 944 | ;" in parent's child list.
|
|---|
| 945 | ;"Results: 1 if child is currently the focused child, 0 otherwise.
|
|---|
| 946 | ;" if child="", then 1 if TMGthis is focused, 0 otherwise
|
|---|
| 947 |
|
|---|
| 948 | ;"Note: so there are two types of use:
|
|---|
| 949 | ;" $$IsFocused(child) <-- is child focused for TMGthis
|
|---|
| 950 | ;" $$IsFocused() <---- is TMGthis focused for it's parent
|
|---|
| 951 |
|
|---|
| 952 | set child=$get(child,"")
|
|---|
| 953 | new result set result=""
|
|---|
| 954 | if child="" do
|
|---|
| 955 | . new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 956 | . set child=TMGthis
|
|---|
| 957 | . new TMGthis set TMGthis=parent
|
|---|
| 958 | . set result=$$IsFocused(child)
|
|---|
| 959 | else do
|
|---|
| 960 | . set result=($$getFocused()=child)
|
|---|
| 961 |
|
|---|
| 962 | quit result
|
|---|
| 963 |
|
|---|
| 964 |
|
|---|
| 965 | setFocused(child)
|
|---|
| 966 | ;"Purpose: to set a child's status to focused, and effect it ensure visible
|
|---|
| 967 | ;" by bringing it to the top of the z-order
|
|---|
| 968 | ;"Input: child -- the name/ref of the child to set as focused
|
|---|
| 969 |
|
|---|
| 970 | if $get(child)="" goto SFDone
|
|---|
| 971 | if $$getFocused()=child goto SFDone ;"don't refocus if there already.
|
|---|
| 972 | do UnfocusCur()
|
|---|
| 973 |
|
|---|
| 974 | new curZ set curZ=$$GetNumChild(child)
|
|---|
| 975 | if curZ'>0 goto SFDone
|
|---|
| 976 |
|
|---|
| 977 | new num set num=""
|
|---|
| 978 | new lastValid set lastValid=0
|
|---|
| 979 | for do quit:(+num'>0)
|
|---|
| 980 | . set lastValid=+num
|
|---|
| 981 | . set num=$order(@TMGthis@("CHILDREN",num))
|
|---|
| 982 | set @TMGthis@("CHILDREN",lastValid+1,child)=""
|
|---|
| 983 | kill @TMGthis@("CHILDREN",curZ)
|
|---|
| 984 | do ListPack^TMGMISC($name(@TMGthis@("CHILDREN")))
|
|---|
| 985 | set @TMGthis@("CHILDREN","FOCUSED")=$$GetNumChild(child)
|
|---|
| 986 | do setProp^TMGOOL(child,"NEEDS REPAINT",1)
|
|---|
| 987 | SFDone
|
|---|
| 988 | quit 0
|
|---|
| 989 |
|
|---|
| 990 |
|
|---|
| 991 | getFocused()
|
|---|
| 992 | ;"returns currently focused child name/ref
|
|---|
| 993 | new focusNum
|
|---|
| 994 | set focusNum=+$get(@TMGthis@("CHILDREN","FOCUSED"))
|
|---|
| 995 | quit $$GetChild(focusNum)
|
|---|
| 996 |
|
|---|
| 997 |
|
|---|
| 998 | FocusThis()
|
|---|
| 999 | ;"Purpose: to set TMGthis as focused for parent
|
|---|
| 1000 | new parent set parent=$$getProp^TMGOOL(TMGthis,"PARENT")
|
|---|
| 1001 | do proc^TMGOOL(parent,"SET FOCUSED",TMGthis)
|
|---|
| 1002 | quit
|
|---|
| 1003 |
|
|---|
| 1004 |
|
|---|
| 1005 | UnfocusCur()
|
|---|
| 1006 | ;"returns: unfocuses currently focused object
|
|---|
| 1007 | new focusNum
|
|---|
| 1008 | set focusNum=+$get(@TMGthis@("CHILDREN","FOCUSED"))
|
|---|
| 1009 | if focusNum>0 do
|
|---|
| 1010 | . new child set child=$$GetChild(focusNum)
|
|---|
| 1011 | . do setProp^TMGOOL(child,"NEEDS REPAINT",1)
|
|---|
| 1012 | . set @TMGthis@("CHILDREN","FOCUSED")=""
|
|---|
| 1013 | quit
|
|---|
| 1014 |
|
|---|
| 1015 |
|
|---|
| 1016 | GetNumChild(child,objectName)
|
|---|
| 1017 | ;"Returns the z-order for the given child
|
|---|
| 1018 | ;"Input: child -- the name/ref of the child to seek
|
|---|
| 1019 | ;" objectName -- OPTIONAL. Default is 'TMGthis'
|
|---|
| 1020 | ;" The name of the object holding children
|
|---|
| 1021 | ;"Results: the z-order, or 0 if not found
|
|---|
| 1022 |
|
|---|
| 1023 | new num set num=""
|
|---|
| 1024 | new done set done=0
|
|---|
| 1025 | set objectName=$get(objectName,TMGthis)
|
|---|
| 1026 | if (objectName="")!(+objectName=objectName) do goto GNCDone
|
|---|
| 1027 | X1 . new temp set temp=1
|
|---|
| 1028 | for set num=$order(@objectName@("CHILDREN",num)) quit:(+num'>0) do quit:(done=1)
|
|---|
| 1029 | . if child=$order(@objectName@("CHILDREN",num,"")) set done=1
|
|---|
| 1030 | GNCDone
|
|---|
| 1031 | quit +num
|
|---|
| 1032 |
|
|---|
| 1033 |
|
|---|
| 1034 | GetChild(num)
|
|---|
| 1035 | ;"Returns child ref/name at num z-order
|
|---|
| 1036 | quit $order(@TMGthis@("CHILDREN",num,""))
|
|---|
| 1037 |
|
|---|
| 1038 |
|
|---|
| 1039 | GetContained(LOC)
|
|---|
| 1040 | ;"Purpose: To get the name/ref of the child containing coordinates
|
|---|
| 1041 | ;"Input: LOC -- a location array:
|
|---|
| 1042 | ;" LOC("TOP")=top
|
|---|
| 1043 | ;" LOC("LEFT")=left
|
|---|
| 1044 | ;"results: name/ref of the child containing coordinates
|
|---|
| 1045 |
|
|---|
| 1046 | new result set result=""
|
|---|
| 1047 | new num set num=""
|
|---|
| 1048 | for set num=$order(@TMGthis@("CHILDREN",num)) quit:(+num'>0)
|
|---|
| 1049 | ;"Now count backward
|
|---|
| 1050 | for set num=$order(@TMGthis@("CHILDREN",num),-1) quit:(+num'>0)!(result'="") do
|
|---|
| 1051 | . new child set child=$order(@TMGthis@("CHILDREN",num,""))
|
|---|
| 1052 | . if child="" quit
|
|---|
| 1053 | . if $$fn^TMGOOL(child,"CONTAINS COORDS",.LOC)=0 quit
|
|---|
| 1054 | . set result=child
|
|---|
| 1055 |
|
|---|
| 1056 | quit result
|
|---|
| 1057 |
|
|---|
| 1058 |
|
|---|
| 1059 | CheckPaint
|
|---|
| 1060 | ;"Purpose: to see if any children need repainting. If so, repaint.
|
|---|
| 1061 | ;"Note: Only MainWindow should be getting to this point.
|
|---|
| 1062 | ;" Also, Paint is not called for MainWindow (i.e. don't put a border on the main screen)
|
|---|
| 1063 |
|
|---|
| 1064 | ;"do SETCLIP^TMGXGF(0,0,IOSL,IOM)
|
|---|
| 1065 |
|
|---|
| 1066 | new paintAllChildren set paintAllChildren=0
|
|---|
| 1067 | ;"Note: Every time THIS is painted, all children are also painted.
|
|---|
| 1068 | ;" But there may be times with THIS doesn't need repainting, but
|
|---|
| 1069 | ;" just one of the children will need painting alone.
|
|---|
| 1070 | if $$getProp^TMGOOL(TMGthis,"NEEDS REPAINT")=1 do ;"1=paint this, 2=paint a child
|
|---|
| 1071 | . set paintAllChildren=1
|
|---|
| 1072 | . ;"Draw a frame to white out entire screen.
|
|---|
| 1073 | . do CLEAR^TMGXGF(0,0,IOSL,IOM) ;"clear screen portion TOP,LEFT,BOTTOM,RIGHT
|
|---|
| 1074 | . do setProp^TMGOOL(TMGthis,"NEEDS REPAINT",0) ;"flag screen as total repainted
|
|---|
| 1075 |
|
|---|
| 1076 | ;"Note: 0=back-most window (bigger numbers painted last)
|
|---|
| 1077 | new num set num=""
|
|---|
| 1078 | for set num=$order(@TMGthis@("CHILDREN",num)) quit:(+num'>0) do
|
|---|
| 1079 | . new child set child=$order(@TMGthis@("CHILDREN",num,""))
|
|---|
| 1080 | . if child="" quit
|
|---|
| 1081 | . new sameLoc,LOC,ldArray
|
|---|
| 1082 | . new scrap set scrap=$$getProp^TMGOOL(child,"LOC",.LOC)
|
|---|
| 1083 | . set scrap=$$getProp^TMGOOL(child,"LAST DRAW",.ldArray)
|
|---|
| 1084 | . set sameLoc=$$CompArray^TMGMISC("LOC","ldArray")
|
|---|
| 1085 | . new tempWho
|
|---|
| 1086 | . new needsPaint set needsPaint=$$getProp^TMGOOL(child,"NEEDS REPAINT",.tempWho)
|
|---|
| 1087 | . if (sameLoc=0)!(needsPaint>0)!(paintAllChildren=1) do
|
|---|
| 1088 | CP2 . . do proc^TMGOOL(child,"PAINT")
|
|---|
| 1089 | . . do setProp^TMGOOL(child,"LAST DRAW",.LOC)
|
|---|
| 1090 |
|
|---|
| 1091 | quit
|
|---|
| 1092 |
|
|---|
| 1093 |
|
|---|
| 1094 | parentPath(fromFrame,toFrame,outArray)
|
|---|
| 1095 | ;"Purpose: to enumerate the successive parent when going from 'from' frame
|
|---|
| 1096 | ;" to the 'to' frame.
|
|---|
| 1097 | ;"Input: fromFrame,toFrame -- the name/ref of TMGWGOJ objects for frames
|
|---|
| 1098 | ;" outArray -- PASS BY REFERENCE. See format below:
|
|---|
| 1099 | ;"Output: outArray is filled as below:
|
|---|
| 1100 | ;" outArray(1,fromFrame)=""
|
|---|
| 1101 | ;" outArray(2,parent of fromFrame)=""
|
|---|
| 1102 | ;" outArray(3,grandparent of fromFrame)=""
|
|---|
| 1103 | ;" outArray(4,greatgrandparent of fromFrame)=""
|
|---|
| 1104 | ;" ...
|
|---|
| 1105 | ;"results: none
|
|---|
| 1106 |
|
|---|
| 1107 | kill outArray
|
|---|
| 1108 | new num set num=2
|
|---|
| 1109 | new toFound set toFound=0
|
|---|
| 1110 | new curFrame set curFrame=fromFrame
|
|---|
| 1111 | for do quit:(curFrame="")!(curFrame=toFrame)!(curFrame="SCREEN")
|
|---|
| 1112 | . set curFrame=$$getProp^TMGOOL(curFrame,"PARENT")
|
|---|
| 1113 | . if curFrame="" quit
|
|---|
| 1114 | . if curFrame=toFrame set toFound=1
|
|---|
| 1115 | . set outArray(num,curFrame)="",num=num+1
|
|---|
| 1116 | if toFound=0 kill outArray
|
|---|
| 1117 | if $data(outArray)>0 set outArray(1,fromFrame)=""
|
|---|
| 1118 | quit
|
|---|
| 1119 |
|
|---|
| 1120 |
|
|---|
| 1121 | convPath(LOC,pathArray)
|
|---|
| 1122 | ;"Purpose: to succesively translate coordinate systems for each entry in the
|
|---|
| 1123 | ;" path array (as prepaired by parentPath)
|
|---|
| 1124 | ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
|
|---|
| 1125 | ;" LOC("TOP")=
|
|---|
| 1126 | ;" LOC("LEFT")=
|
|---|
| 1127 | ;" LOC("HEIGHT")= ;"optional
|
|---|
| 1128 | ;" LOC("WIDTH")= ;"optional
|
|---|
| 1129 | ;" LOC("BOTTOM")=
|
|---|
| 1130 | ;" LOC("RIGHT")=
|
|---|
| 1131 | ;" LOC("FRAME")=Frame of reference for these coordinates
|
|---|
| 1132 | ;" Note: frame should typically be the same as
|
|---|
| 1133 | ;" the PARENT of the current object
|
|---|
| 1134 | ;" targetFrame=the frame of refernce to change to.
|
|---|
| 1135 | ;"Input: pathArray -- PASS BY REFERENCE. format:
|
|---|
| 1136 | ;" pathArray(1,initialFrame)=""
|
|---|
| 1137 | ;" pathArray(2,parent of fromFrame)=""
|
|---|
| 1138 | ;" pathArray(3,grandparent of fromFrame)=""
|
|---|
| 1139 | ;" pathArray(4,greatgrandparent of fromFrame)=""
|
|---|
| 1140 | ;" ...
|
|---|
| 1141 | ;" ALSO: pathArray=direction (1 or -1) to effect translations
|
|---|
| 1142 | ;" towards a parent frame (1) vs. a child frame (-1)
|
|---|
| 1143 | ;"Results: none
|
|---|
| 1144 | ;"Output: Input variables are modified as OUT PARAMETERS
|
|---|
| 1145 | ;" LOC("TOP") is modified
|
|---|
| 1146 | ;" LOC("LEFT") is modified
|
|---|
| 1147 | ;" LOC("HEIGHT")=unchanged
|
|---|
| 1148 | ;" LOC("WIDTH")=unchanged
|
|---|
| 1149 | ;" LOC("BOTTOM") is updated
|
|---|
| 1150 | ;" LOC("RIGHT") is updated
|
|---|
| 1151 | ;" LOC("FRAME") is updated
|
|---|
| 1152 |
|
|---|
| 1153 | new curFrame set curFrame=$get(LOC("FRAME"))
|
|---|
| 1154 | if curFrame="" goto CpDone ;"unable to convert if not initial frame specified.
|
|---|
| 1155 | new direction set direction=+$get(pathArray)
|
|---|
| 1156 | if direction=0 goto CpDone
|
|---|
| 1157 |
|
|---|
| 1158 | new Top set Top=+$get(LOC("TOP"))
|
|---|
| 1159 | new Left set Left=+$get(LOC("LEFT"))
|
|---|
| 1160 |
|
|---|
| 1161 | new num set num=1
|
|---|
| 1162 | if direction=-1 set num=$order(pathArray(""),-1)
|
|---|
| 1163 | if $order(pathArray(num,""))'=curFrame goto CpStore ;"not in correct initial frame
|
|---|
| 1164 |
|
|---|
| 1165 | new lfTop,lfLeft,loopFrame
|
|---|
| 1166 | for do quit:(loopFrame="")
|
|---|
| 1167 | . set loopFrame=$order(pathArray(num,"")),num=num+direction
|
|---|
| 1168 | . if (loopFrame="") quit
|
|---|
| 1169 | . if (direction=-1)&(loopFrame=curFrame) quit
|
|---|
| 1170 | . set lfTop=$$getProp^TMGOOL(loopFrame,"TOP")*direction
|
|---|
| 1171 | . set lfLeft=$$getProp^TMGOOL(loopFrame,"LEFT")*direction
|
|---|
| 1172 | . set Top=Top+lfTop
|
|---|
| 1173 | . set Left=Left+lfLeft
|
|---|
| 1174 | . set LOC("FRAME")=loopFrame
|
|---|
| 1175 |
|
|---|
| 1176 | CpStore
|
|---|
| 1177 | ;"Store data back into array
|
|---|
| 1178 | set LOC("TOP")=Top
|
|---|
| 1179 | set LOC("LEFT")=Left
|
|---|
| 1180 | set LOC("BOTTOM")=Top+$get(LOC("HEIGHT"))
|
|---|
| 1181 | set LOC("RIGHT")=Left+$get(LOC("WIDTH"))
|
|---|
| 1182 |
|
|---|
| 1183 | CpDone
|
|---|
| 1184 | quit
|
|---|
| 1185 |
|
|---|
| 1186 |
|
|---|
| 1187 | getPath(LOC,targetFrame,pathArray)
|
|---|
| 1188 | ;"Purpose: to create a pathArray from current frame (stored in LOC) to
|
|---|
| 1189 | ;" the targetFrame. targetFrame may be an ancestor, or descendent
|
|---|
| 1190 | ;" of the current frame.
|
|---|
| 1191 | ;"Input: LOC -- PASS BY REFERNCE. Expected input format:
|
|---|
| 1192 | ;" LOC("TOP")=
|
|---|
| 1193 | ;" LOC("LEFT")=
|
|---|
| 1194 | ;" LOC("HEIGHT")= ;"optional
|
|---|
| 1195 | ;" LOC("WIDTH")= ;"optional
|
|---|
| 1196 | ;" LOC("BOTTOM")=
|
|---|
| 1197 | ;" LOC("RIGHT")=
|
|---|
| 1198 | ;" LOC("FRAME")=Frame of reference for these coordinates
|
|---|
| 1199 | ;" Note: frame should typically be the same as
|
|---|
| 1200 | ;" the PARENT of the current object
|
|---|
| 1201 | ;" targetFrame=the frame of refernce to change to.
|
|---|
| 1202 | ;" outArray -- PASS BY REFERENCE. See format below:
|
|---|
| 1203 | ;"Output: pathArray is filled as below:
|
|---|
| 1204 | ;" pathArray(1,curFrame)=""
|
|---|
| 1205 | ;" pathArray(2,next translation frame (child/parent of current))=""
|
|---|
| 1206 | ;" pathArray(3,next translation frame (child/parent of current))=""
|
|---|
| 1207 | ;" ...
|
|---|
| 1208 |
|
|---|
| 1209 | new curFrame set curFrame=$get(LOC("FRAME"))
|
|---|
| 1210 | if curFrame="" goto gpDone
|
|---|
| 1211 | ;"First see if targetFrame is an ancestor of curFrame
|
|---|
| 1212 | do parentPath(curFrame,targetFrame,.pathArray)
|
|---|
| 1213 | if ($data(pathArray)>0)!(curFrame=targetFrame) do goto gpDone ;"success
|
|---|
| 1214 | . set pathArray=1
|
|---|
| 1215 | ;"Now see if targetFrame is a descendent of curFrame
|
|---|
| 1216 | do parentPath(targetFrame,curFrame,.pathArray)
|
|---|
| 1217 | if $data(pathArray)=0 goto gpDone ;"failure
|
|---|
| 1218 | set pathArray=-1 ;"reverse direction
|
|---|
| 1219 | gpDone
|
|---|
| 1220 | quit
|
|---|
| 1221 |
|
|---|
| 1222 |
|
|---|
| 1223 |
|
|---|
