PRO box_cursor2, x0, y0, nx, ny, INIT = init, FIXED_SIZE = fixed_size, $
message = message, color = color, anywhere=anywhere, $
event_pro=event_pro, stc4event=event
DEVICE, get_graphics = old, set_graphics = 6 ; Set xor
IF N_ELEMENTS(color) EQ 0 THEN color = !d.table_size -1
IF N_ELEMENTS(event_pro) NE 0 THEN BEGIN
ok = datatype(event_pro) EQ 'STR'
IF NOT ok THEN MESSAGE, 'Error in compiling the event procedure.', /cont
ENDIF ELSE ok = 0
IF KEYWORD_SET(MESSAGE) THEN BEGIN
IF KEYWORD_SET(fixed_size) THEN BEGIN
PRINT, "Drag Left button to move box."
PRINT, "Right button when done."
ENDIF ELSE BEGIN
PRINT, "Drag Left button to move box."
PRINT, "Drag Middle button near a corner to resize box."
PRINT, "Right button when done."
ENDELSE
ENDIF
IF KEYWORD_SET(init) EQ 0 THEN BEGIN ;Supply default values for box:
IF KEYWORD_SET(fixed_size) EQ 0 THEN BEGIN
nx = !d.x_size/8 ;no fixed size.
ny = !d.x_size/8
ENDIF
x0 = !d.x_size/2-nx/2
y0 = !d.y_size/2-ny/2
ENDIF
button = 0
;----------------------------------------
; To make it work properly with widgets
IF widget_info(/active) THEN widget = find_draw_widget(!d.window) $
ELSE widget = -1L
IF widget NE -1L THEN BEGIN
IF NOT widget_info(widget,/draw_button_events) OR $
NOT widget_info(widget,/draw_motion_events) THEN BEGIN
message,"Motion/Button events turned on",/continue
message,"They may have to be turned off after returning from "+$
"BOX_CURSOR",/continue
widget_control,widget,/draw_button_events,$
/draw_motion_events
END
END
;----------------------------------------
GOTO, middle
WHILE 1 DO BEGIN
old_button = button
IF widget NE -1L THEN BEGIN
;----------------------------------------
; To make it work properly with widgets
ev = widget_event(widget)
x = ev.x
y = ev.y
IF ev.type EQ 0 THEN button = ev.press
IF ev.type EQ 1 THEN button = 0
!err = button
;----------------------------------------
END ELSE BEGIN
cursor, x, y, 2, /dev ;Wait for a button
button = !err
END
IF (old_button EQ 0) AND (button NE 0) THEN BEGIN
mx0 = x ;For dragging, mouse locn...
my0 = y
x00 = x0 ;Orig start of ll corner
y00 = y0
ENDIF
IF !err EQ 1 THEN BEGIN ;Drag entire box?
x0 = x00 + x - mx0
y0 = y00 + y - my0
ENDIF
IF (!err EQ 2) AND (KEYWORD_SET(fixed_size) EQ 0) THEN BEGIN ;New size?
IF old_button EQ 0 THEN BEGIN ;Find closest corner
min_d = 1e6
FOR i = 0,3 DO BEGIN
d = FLOAT(px(i)-x)^2 + FLOAT(py(i)-y)^2
IF d LT min_d THEN BEGIN
min_d = d
corner = i
ENDIF
ENDFOR
nx0 = nx ;Save sizes.
ny0 = ny
ENDIF
dx = x-mx0 & dy = y-my0 ;Distance dragged...
;---------------------------------------------------------------------------
; The major change was made here. After the closest corner is
; found, the opposite corner is fixed. This prevents the box
; from jumping around -- Liyun Wang, GSFC/ARC
;---------------------------------------------------------------------------
CASE corner OF
0: BEGIN
IF (dx GT nx0) THEN BEGIN
x0 = x00+nx0
nx = dx-nx0
ENDIF ELSE BEGIN
x0 = x00+dx
nx = nx0-dx
ENDELSE
IF (dy GT ny0) THEN BEGIN
y0 = y00+ny0
ny = dy-ny0
ENDIF ELSE BEGIN
y0 = y00+dy
ny = ny0-dy
ENDELSE
END
1: BEGIN
IF (dx LE -nx0) THEN BEGIN
nx = -(nx0+dx)
x0 = x00-nx
ENDIF ELSE BEGIN
nx = nx0+dx
x0 = x00
ENDELSE
IF (dy GT ny0) THEN BEGIN
y0 = y00+ny0
ny = dy-ny0
ENDIF ELSE BEGIN
y0 = y00+dy
ny = ny0-dy
ENDELSE
END
2: BEGIN
IF (dx LE -nx0) THEN BEGIN
nx = -(nx0+dx)
x0 = x00-nx
ENDIF ELSE BEGIN
nx = nx0+dx
x0 = x00
ENDELSE
IF (dy LE -ny0) THEN BEGIN
ny = -(ny0+dy)
y0 = y00-ny
ENDIF ELSE BEGIN
ny = ny0+dy
y0 = y00
ENDELSE
END
3: BEGIN
IF (dx GT nx0) THEN BEGIN
x0 = x00+nx0
nx = dx-nx0
ENDIF ELSE BEGIN
x0 = x00+dx
nx = nx0-dx
ENDELSE
IF (dy LE -ny0) THEN BEGIN
ny = -(ny0+dy)
y0 = y00-ny
ENDIF ELSE BEGIN
ny = ny0+dy
y0 = y00
ENDELSE
END
ENDCASE
ENDIF
PLOTS, px, py, col=color, /dev, thick=1, lines=0 ;Erase previous box
EMPTY ;Decwindow bug
;-- in case of a problem, set graphics device back (IDL ge 4)
if idl_release(lower=4,/inc) then begin
error_status=0
catch,error_status
if (error_status ne 0) and (n_elements(old) ne 0) then begin
device,set_graphics=old
return
endif
endif
IF !err EQ 4 THEN BEGIN ;Quitting?
DEVICE,set_graphics = old
RETURN
ENDIF
middle:
IF NOT KEYWORD_SET(anywhere) THEN BEGIN
;---------------------------------------------------------------------------
; Never allow the box to be outside window
;---------------------------------------------------------------------------
x0 = x0 > 0
y0 = y0 > 0
x0 = x0 < (!d.x_size-1 - nx)
y0 = y0 < (!d.y_size-1 - ny)
ENDIF ELSE BEGIN
x0 = x0 > (-nx)
y0 = y0 > (-ny)
x0 = x0 < (!d.x_size-1)
y0 = y0 < (!d.y_size-1)
ENDELSE
IF ok THEN BEGIN
event.x = x0
event.y = y0
CALL_PROCEDURE, event_pro, event
ENDIF
px = [x0, x0 + nx, x0 + nx, x0, x0] ;X points
py = [y0, y0, y0 + ny, y0 + ny, y0] ;Y values
PLOTS,px, py, col=color, /dev, thick=1, lines=0 ;Draw the box
wait, .1 ;Dont hog it all
ENDWHILE
END