% % ClassTrackingCanvas, a tnt canvas with external tracking properties % /ClassTrackingCanvas ClassCanvas [] classbegin /Trackable? true def /track_time 0 def /track_lev 0 def % % subclasses responsibility % /onselect nullproc def /onadjust nullproc def % % send an event to the tracking process % /track_send { % event action -- 1 index begin /ClientData exch def /Canvas self def /Name /tRackEvent def end sendevent } def % % tracking service interface % /TrackStart { % event -- list true .1 blockinputqueue % determine multi click dup /TimeStampMS get track_time sub UserProfile /MultiClickThresh get le {track_lev} 0 ifelse 1 add /track_lev exch promote /track_time 1 index /TimeStampMS get promote { newprocessgroup currentprocess /ProcessName (HyperNeWS tracker) put currentprocess /track_evt 3 -1 roll put clear createevent dup begin /Name /tRackEvent def end expressinterest unblockinputqueue InteractionLock { self setcanvas currentprocess /track_state null put currentprocess /track_evt get /Name get AdjustButton eq {onadjust} {onselect} ifelse } monitor currentprocess /track_evt undef } fork soften /tracker exch promote pop /Default true } def /TrackStop { % event -- { currentprocess /track_evt 3 -1 roll put currentprocess /track_mvd known /mouse_up /mouse_click ifelse exit } track_send /tracker unpromote } def /TrackCancel { % event -- {pop /mouse_cancel exit} track_send /tracker unpromote } def /TrackMotion { % event -- {currentprocess /track_mvd true put $track_proc} track_send } def classend def % % Track utillities % /mouseevent { % -- event currentprocess /track_evt 2 copy known {get} {pop pop createevent} ifelse } def /eventxy { % event -- x y begin XLocation YLocation end } def /mousexy { % -- x y mouseevent eventxy } def /mouselevel { % -- multi-click-level mouseevent /Canvas get dup null ne { /track_lev 2 copy known {get} {pop pop 0} ifelse } {pop 0} ifelse } def % % low level track procedure % /trackable { % -- boolean currentprocess /track_state known } def /track_state { % -- status trackable { currentprocess /track_state get null eq { 10 dict begin currentprocess /track_state undef /$track_proc { currentprocess /track_state 3 -1 roll put /mouse_drag exit } def {awaitevent dup /ClientData get exec} loop end } {/mouse_drag} ifelse } {/mouse_cancel} ifelse } def /track { % proc -- status trackable { 10 dict begin /$track_proc exch cvx def currentprocess /track_evt get $track_proc currentprocess /track_state get dup null ne {$track_proc} {pop} ifelse currentprocess /track_state undef {awaitevent dup /ClientData get exec} loop end } {pop /mouse_cancel} ifelse } def /track_overlay { % proc -- status trackable { gsave matrix currentmatrix currentcanvas createoverlay setcanvas setmatrix [exch /erasepage load exch /exec load] track erasepage grestore } {pop /mouse_cancel} ifelse } def