TMGWSCR ;TMG/kst/OO screen setup ;04/18/07 ;;1.0;TMG-LIB;**1**;04/18/07 ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"------------------------------------------ ;"Object oriented screen object setup code below ;"------------------------------------------ Constructor(TMGthis) ;"Module MUST have 'Constructor' procedure ;"Purpose -- A constructor for object Window ;"Input: TMGthis -- the NAME of the type of the object to be defined. ;" This should be a variable (global or otherwise) of the object. ;"Note: This function should NOT be called directly, but instead is called ;" via new^TMGOOL ;"Result: none <--- REQUIRED TO NOT RETURN A RESULT ;"Here we define the default values for vars and functions. ;"----------------All constructors should copy this format -------------------- new typeDef set typeDef=@TMGthis@("TYPEDEF") ;"--------------------------------------------------------------------- ;"register PROCEDURES/FUNCTIONS do regFn^TMGOOL(TMGthis,"RUN","Run^TMGWSCR()") do regFn^TMGOOL(TMGthis,"ACCEPT CHILD","AcceptChild^TMGWSCR(Child)") ;"--------------------------------------------------------------------- ;"Register Event Handlers ;"--------------------------------------------------------------------- ;"Register some Properties do regProp^TMGOOL(TMGthis,"WINDOW","","SetWindow^TMGWSCR") ;"-------------------------------------------------------------------------------- ;"Optional initialization of some instance-specific variables. set @TMGthis@("MOUSE","TOP")=5 set @TMGthis@("MOUSE","LEFT")=5 set @TMGthis@("MOUSE","VISIBLE")=1 ;"-------------------------------------------------------------------------------- ;"Startup code here... kill XGSCRN do PREP^TMGXGF ;"prepare environment for graphics functions do CLEAR^TMGXGF(0,0,150,150) quit Destructor(TMGthis) ;"Module MUST have 'Destructor' procedure ;"Purpose: A destructor for object Widget ;" any needed clean up code would go here first. ;"Input: TMGthis -- the name of the object instance to be deleted. ;" This should be the value returned from defWidget ;"Note: Don't actually delete the object here. Just perform code needed to ;" save the object variables etc. Anything neeed before the object ;" is deleted by delete^TMGOOL ;" Here I put code that needs to be called before destruction of the object. do . write IOCUON . xecute ^%ZOSF("EON") . do CLEAN^TMGXGF . kill ^TMP($J) . kill XGSCRN . write # quit ;"------------------------------------------ ;"Object Widget member functions below ;"------------------------------------------ ;"Note: All functions may depend on variable (with global scope) TMGthis, as ;" a 'this' pointer to object calling ;"Note: ALL members must have QUIT xx (even if xx is meaningless, as in a procedure) Run() ;"Purpose: This will be the main entry point. From here the keyboard will be ;" monitored and handled, and window management will occur. This ;" procedure will not exit until all the action of the windows is ;" complete. new count for quit:($$Tick(.count)=1) quit 0 Conv2Global(Top,Left,Bottom,Right) ;"Purpose: convert to a screen frame of reference ;"Input: Top,Left -- PASS BY REFERENCE. ;" Bottom,Right -- PASS BY REFERENCE. OPTIONAL ;"Results: none ;"NOTE: THIS FUNCTION IS DONE ;"It turns out that nothing more needs to done to convert to screen frame. ;"This function is left in for symmetry with Conv2Global^TMGWIN1 quit 0 ;"------------------------------------------ ;"Event handlers below ;"------------------------------------------ SetWindow(TMGthis,PropName,pWin) ;"Purpose: To set the main output window ;"Input: TMGthis -- a this pointer for properter setter. ;" PropName -- the name of the property -- not used here ;" pWin -- the name/ref of the window to use as main window set @TMGthis@("PROP","WINDOW")=pWin ;;"do setProp^TMGOOL(pWin,"SCREEN",TMGthis) ;"I'm not sure if this is right. ;"I am reinstating this line so that getScrn will return the top level window, ;"not a reference to TMGWSCR, which doesn't have coordinates property etc. do setProp^TMGOOL(pWin,"SCREEN",pWin) do setProp^TMGOOL(pWin,"MOUSE HOLDER",TMGthis) quit ;"<-- required: NO return value for event handler ;"------------------------------------------ ;"Private functions below ;"------------------------------------------ Tick(count) ;"Purpose: To handle one processing cycle for the screen (and all contained objects) ;"input: count -- a counter variable for occasional screen refreshing ;"Results: 0 is OK to continue, 1 is ABORT new result set result=0 set count=+$get(count)+1 if count<20 do . do CheckPaint ;"If repaint needed, do it here. . set count=count+1 else do . do FullPaint . set count=0 do DrawMouse ;"do after last draw so nothing overwrites it do CheckKeyboard TickDone quit result CheckKeyboard ;"Purpose: to check keyboard for user interaction, and handle if found new key kill XGRT ;"set key=$$READ^TMGXGF(1,1) ;"read 1 character, 1 sec time out. set key=$$READ^TMGXGF(1,1) ;"read 1 character, 0 sec time out. if $data(DTOUT) goto CKBDone ;"key read timed out if key="!" do CK1 . new temp set temp=1 ;"a debug stopping point if key="#" do goto CKBDone . set cmdKey="FULL PAINT" . new scrap set scrap=$$SendMsg(.cmdKey) if key="^" set result=1 goto CKBDone if key'="" do ProcessAlpha(key) if (key="")&(XGRT="") set key="ESC" if $length(XGRT)>0 do ProcessCmd(XGRT) CKBDone quit ProcessAlpha(key) ;"Purpose: to fire alpha-numeric input stream event new cmdKey set cmdKey="ALPHA KEY" set cmdKey("KEY")=key new scrap set scrap=$$SendMsg(.cmdKey) quit ProcessCmd(key) ;"Purpose: to handle command keys, as outlined below: ;"Input: cmdKey -- the command input. Examples: ;" UP, DOWN, LEFT, RIGHT ;" NEXT (page down), PREV (page up) ;" REMOVE (for delete) ;" note: HOME and END are NOT returned from $$READ^TMGXGF. ;" F1, F2, ... ;" ^A, ^B (ctrl-A, ctrl-B etc.) ;" CR (return/enter), TAB ;" KPENTER (shift-enter) <-- this will be used as a 'double click' signal ;" note: ESC is NOT returned from $$READ^TMGXGF. ;" ... but maybe I have captured [esc][esc] --> 'ESC' new cmdKey if $get(@TMGthis@("MOUSE","VISIBLE"))=0 do goto PCDone . if (key="CR")!(key="KPENTER") do ProcessAlpha("CR") . ;"I need to have a way here to send key movements to move around in an edit box... if key="CR" do goto PCDone PCMM . set cmdKey="MOUSE-CLICK" . new scrap set scrap=$$SendMsg(.cmdKey) if key="KPENTER" do goto PCDone . set cmdKey="MOUSE-SHIFT-CLICK" . new scrap set scrap=$$SendMsg(.cmdKey) if (key="UP")!(key="DOWN")!(key="LEFT")!(key="RIGHT") do goto PCDone . do ProcessMove(key) set cmdKey="COMMAND" set cmdKey("KEY")=key new scrap set scrap=$$SendMsg(.cmdKey) PCDone quit ProcessMove(dir) ;"Purpose: to move the mouse around and set status ;"Input: dir -- UP, DOWN etc. new cmdKey set cmdKey="MOVE REQUEST" new T,L,curT,curL,deltaT,deltaL set T=+$get(@TMGthis@("MOUSE","TOP")) set L=+$get(@TMGthis@("MOUSE","LEFT")) set curT=T,curL=L if dir="UP" set T=T-1 else if dir="DOWN" set T=T+1 else if dir="LEFT" set L=L-1 else if dir="RIGHT" set L=L+1 set cmdKey("DELTA","TOP")=(T-curT) set cmdKey("DELTA","LEFT")=(L-curL) merge cmdKey=@TMGthis@("MOUSE") set cmdKey("GLOBAL COORDS","TOP")=@TMGthis@("MOUSE","TOP") set cmdKey("GLOBAL COORDS","LEFT")=@TMGthis@("MOUSE","LEFT") new result set result=$$SendMsg(.cmdKey) if result'=-1 do ;"actually move mouse, because no problem. . set @TMGthis@("MOUSE","VISIBLE")=1 . set @TMGthis@("MOUSE","TOP")=T . set @TMGthis@("MOUSE","LEFT")=L ;"Note: mouse is NOT drawn here... quit SendMsg(cmdKey) ;"Purpose: to send out message to TOP LEVEL window child (an only child) ;"Input: cmdKey -- PASS BY REFERENCE. The message to send. ;"results: 0 if OK, or -1 if failed ;"Note: here are the messages that will be set through this fn: ;" MOVE REQUEST ;" MOUSE-CLICK ;" MOUSE-SHIFT-CLICK ;" ALPHA KEY (details in KEY) ;" COMMAND (details in KEY) new result,MainWin set MainWin=$$getProp^TMGOOL(TMGthis,"WINDOW") set cmdKey("TOP")=+$get(@TMGthis@("MOUSE","TOP")) set cmdKey("LEFT")=+$get(@TMGthis@("MOUSE","LEFT")) ;"set cmdKey("FRAME")=TMGthis ;"specifies which frame of ref are coordinates in. set cmdKey("FRAME")="SCREEN" ;"specifies which frame of ref are coordinates in. do fireEvent^TMGOOL(MainWin,"MSG",.cmdKey) new result set result=+$get(cmdKey("RESULT")) SMgDone quit result DrawMouse ;"Purpose: to draw the mouse, or hide it if it is not visible. do CLRCLIP^TMGXGF ;"clear clip area do HideMouse if $get(@TMGthis@("MOUSE","VISIBLE"))=1 do . new L,T . set L=@TMGthis@("MOUSE","LEFT"),T=@TMGthis@("MOUSE","TOP") . do SAVE^TMGXGF(T,L,T,L,$name(@TMGthis@("MOUSE","SAVE"))) . do CHGA^TMGXGF("B1") do SAY^TMGXGF(T,L,"*","R1") do CHGA^TMGXGF("B0") ;turn blink off quit CheckPaint ;"Purpose: to send a paint message to MainWindow new cmdKey set cmdKey="CHECK PAINT" new scrap set scrap=$$SendMsg(.cmdKey) quit FullPaint ;"Purpose: to send a FULL paint message to MainWindow new cmdKey set cmdKey="FULL PAINT" new scrap set scrap=$$SendMsg(.cmdKey) quit HideMouse ;"Purpose: Erase Mouse if $data(@TMGthis@("MOUSE","SAVE")) do . do RESTORE^TMGXGF($name(@TMGthis@("MOUSE","SAVE"))) quit