PRO rubberbox_event,event
WIDGET_CONTROL,event.top,GET_UVALUE=info

CASE event.id OF
info.done: BEGIN
	WIDGET_CONTROL,event.top,/DESTROY
	END

info.draw: BEGIN
	IF event.type EQ 0 AND info.btnstate EQ 0 THEN BEGIN
		info.btnstate=1
		box={x0:event.x,y0:event.y,x1:0L,y1:0L}
		*(info.dataptr)=box
	ENDIF
	IF event.type EQ 2 AND info.btnstate EQ 1 THEN BEGIN
		(*(info.dataptr)).x1=event.x
		(*(info.dataptr)).y1=event.y
		WSET,info.win1
		DEVICE,COPY=[0,0,info.width,info.height,0,0,info.win0]
		plots,[(*(info.dataptr)).x0,event.x,event.x,$
			(*(info.dataptr)).x0,(*(info.dataptr)).x0],$
			[(*(info.dataptr)).y0,(*(info.dataptr)).y0,$
			event.y,event.y,(*(info.dataptr)).y0],$
				COLOR=info.color,THICK=1,linestyle=2,/DEVICE
	ENDIF

	;Stop tracing on button up.
	IF event.type EQ 1 THEN BEGIN
		info.btnstate=0
		box={x0:(*(info.dataptr)).x0,$
			   y0:(*(info.dataptr)).y0,$
			   x1:event.x,y1:event.y}
		*(info.boxPtr)=box
	ENDIF

	;Save the info structure with revised line data
	WIDGET_CONTROL,event.top,SET_UVALUE=info

	END ;End of info.draw case

ELSE: ;Do nothing
ENDCASE

END ;End of procedure

FUNCTION rubberbox,image,COLOR=color
;+
;Creates a widget in which a box can be drawn using the
;mouse. On exit the opposite corners of the box are
;returned
;
;RESTRICTIONS
;Works only with monochrome images.
;
;Does not rescale the brightness range.
;
;H. Rhody
;July, 2004
;-

sz=size(image)
IF sz[0] NE 2 THEN MESSAGE,'Image must be a 2D array'

IF NOT KEYWORD_SET(color) THEN color=!D.TABLE_SIZE/2

w=sz[1]
h=sz[2]

;Render the pixmap
window,/free,xs=w,ys=h,/PIXMAP
win0=!D.Window
TV,image

tlb=Widget_Base(COLUMN=1)
draw1=WIDGET_DRAW(tlb,/BUTTON_EVENTS,/MOTION_EVENTS,XSIZE=w,YSIZE=h)
btnbase=WIDGET_BASE(tlb,ROW=1)
donebtn=WIDGET_BUTTON(btnbase,VALUE='Done')

WIDGET_CONTROL,tlb,/REALIZE
WIDGET_CONTROL,draw1,GET_VALUE=win1
WSET,win1
DEVICE,COPY=[0,0,w,h,0,0,win0]

dataPtr=ptr_new(/allocate_heap)
boxPtr=ptr_new(/allocate_heap)
*boxPtr=-1

info={win0:win0,win1:win1,draw:draw1,done:donebtn,$
	dataPtr:dataPtr,boxPtr:boxPtr,btnstate:0,$
	width:w,height:h,color:color}
Widget_Control,tlb,set_uvalue=info
Xmanager,'rubberbox',tlb

box=*boxPtr
s=size(box,/tname)
IF s EQ 'STRUCT' THEN BEGIN
sx=box.x0 & sy=box.y0 & dx=box.x1 & dy=box.y1
x0=sx<dx & x1=sx>dx
y0=sy<dy & y1=sy>dy
data=[[x0,y0],[x1,y1]]
ENDIF ELSE data=-1
PTR_FREE,boxPtr
PTR_FREE,dataPtr
RETURN,data

END