PRO rubberline_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
		line={x0:event.x,y0:event.y,x1:0L,y1:0L}
		*(info.dataptr)=line
	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],$
			[(*(info.dataptr)).y0,event.y],COLOR=0,THICK=2,/DEVICE

		IF info.count GT 0 THEN BEGIN
			FOR k=0,info.count-1 DO BEGIN
				line=(*info.linePtr)[k]
				plots,[line.x0,line.x1],[line.y0,line.y1],$
				  COLOR=200,THICK=4,/DEVICE
			ENDFOR
		ENDIF
	ENDIF

	;Stop line tracing on button up.
	IF event.type EQ 1 THEN BEGIN
		info.btnstate=0
		line={ID:info.count,x0:(*(info.dataptr)).x0,$
			   y0:(*(info.dataptr)).y0,$
			   x1:event.x,y1:event.y}
		IF info.count EQ 0 THEN lines=[line] ELSE $
			lines=[*info.linePtr,line]
		*(info.lineptr)=lines
		info.count=info.count+1
	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 rubberline,image
;+
;Creates a widget in which a line can be drawn using the
;mouse. On exit the start and endpoints of the line 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'

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)
linePtr=ptr_new(/allocate_heap)
*linePtr=-1

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

lines=*linePtr
s=size(lines,/tname)
IF s EQ 'STRUCT' THEN BEGIN
n=n_elements(lines)-1
data=[[lines[0:n].x0],[lines[0:n].y0],[lines[0:n].x1],[lines[0:n].y1]]
data=transpose(data)
ENDIF ELSE data=-1
PTR_FREE,linePtr
PTR_FREE,dataPtr
RETURN,data

END