Viewing contents of file '../idllib/contrib/fanning/xstretch.pro'
;+
; NAME:
; XSTRETCH
;
; PURPOSE:
; The purpose of this program is to interactively apply a simple
; linear stretch to an image by moving two lines on a histogram
; plot of the image. The portion of the image data between the
; two lines is stretched over the available colors in the color table.
;
; CATEGORY:
; Graphics, Widgets
;
; CALLING SEQUENCE:
; XSTRETCH, image
;
; INPUT PARAMETERS:
; image: The image data to be stretched.It must be 2D.
;
; KEYWORD PARAMETERS:
; COLORTABLE: The index of a colortable you would like to load.
; The current colortable is used if this keyword is undefined.
;
; _EXTRA: This keyword collects any keyword appropriate for the
; Plot command.
;
; GROUP_LEADER: Keyword to assign a group leader (so this program can be
; called from within another widget program).
;
; MAX_VALUE: Keyword to assign a maximun value for the Histogram Plot.
; Images with lots of pixels of one color (e.g. black) skew
; the histogram. This helps make a better looking plot.
;
; NCOLORS: Keyword to assign the number of colors used to display
; the image. The default is !D.N_Colors-4.
;
; OUTPUTS:
; None.
;
; COMMON BLOCKS:
; None.
;
; SIDE EFFECTS:
; None.
;
; RESTRICTIONS:
; None.
;
; EXAMPLE:
; If you have a 2D image in the variable "image", you can run this
; program like this:
;
; XSTRETCH, image
;
; MODIFICATION HISTORY:
; Written by: David Fanning, April 1996.
; October, 1996 Fixed a problem with not restoring the color
; table when the program exited. Substituted a call to XCOLORS
; instead of XLOADCT.
; October, 1998. Added NO_BLOCK keyword and modified to work with
; 24-bit color devices.
;-
PRO XSTRETCH_PROCESS_EVENTS, event
; This event handler ONLY responds to button down events from the
; draw widget. If it gets a DOWN event, it does two things: (1) finds
; out which threshold line is to be moved, and (2) changes the
; event handler for the draw widget to XSTRETCH_MOVELINE.
possibleEventTypes = [ 'DOWN', 'UP', 'MOTION', 'SCROLL' ]
thisEvent = possibleEventTypes(event.type)
IF thisEvent NE 'DOWN' THEN RETURN
; Must be DOWN event to get here, so get info structure.
Widget_Control, event.top, Get_UValue=info, /No_Copy
; Convert the device coordinates to data coordinates.
; Have to have scaling factors for conversion.
Wset, info.histo_wid
!X.S = info.xs
!Y.S = info.ys
coords = Convert_Coord(event.x, event.y, 0, /Device, /To_Data)
; Is this event close to a line? If not, ignore it.
; Click has to be inside the graph in the y direction.
IF coords(1) LT info.ymin OR coords(1) GT info.ymax THEN BEGIN
Widget_Control, event.top, Set_UValue=info, /No_Copy
RETURN
ENDIF
; How close to either line are you?
closemin = Abs(info.minthresh - coords(0))
closemax = Abs(info.maxthresh - coords(0))
IF closemin LE closemax THEN info.lineby = 'MIN' ELSE info.lineby = 'MAX'
; If you are not close to a line, goodbye!
CASE info.lineby OF
'MIN': BEGIN
IF closemin GT info.close THEN BEGIN
Widget_Control, event.top, Set_UValue=info, /No_Copy
RETURN
ENDIF
END
'MAX': BEGIN
IF closemax GT info.close THEN BEGIN
Widget_Control, event.top, Set_UValue=info, /No_Copy
RETURN
ENDIF
END
ENDCASE
; Change the event handler for the draw widget and turn MOTION
; events ON.
Widget_Control, event.id, Event_Pro='XSTRETCH_MOVELINE', $
Draw_Motion_Events=1
; Put the info structure back into its storage location.
Widget_Control, event.top, Set_UValue=info, /No_Copy
END ; of XSTRETCH_PROCESS_EVENTS *********************************************
PRO XSTRETCH_MOVELINE, event
; This event handler continuously draws and erases a threshold line
; until it receives an UP event from the draw widget. Then it turns
; draw widget motion events OFF and changes the event handler for the
; draw widget back to XSTRETCH_PROCESS_EVENTS.
; Get the info structure out of the top-level base.
Widget_Control, event.top, Get_UValue=info, /No_Copy
; What type of an event is this?
possibleEventTypes = [ 'DOWN', 'UP', 'MOTION', 'SCROLL' ]
thisEvent = possibleEventTypes(event.type)
IF thisEvent EQ 'UP' THEN BEGIN
; If this is an UP event, set the draw widget's event handler back
; to XSTRETCH_PROCESS_EVENTS, turn MOTION events OFF, and apply the
; new threshold parameters to the image.
; Erase the last theshold line drawn.
WSet, info.histo_wid
!X.S = info.xs
!Y.S = info.ys
Device, Copy = [0, 0, 300, 200, 0, 0, info.pixmap]
; Turn motion events off and redirect the events to XSTRETCH_PROCESS_EVENTS.
Widget_Control, event.id, Draw_Motion_Events=0, $
Event_Pro='XStretch_Process_Events'
; Convert the event device coordinates to data coordinates.
coord = Convert_Coord(event.x, event.y, /Device, /To_Data)
; Make sure the coordinate is between the other line and
; still inside the plot.
CASE info.lineby OF
'MIN': BEGIN
coord(0) = coord(0) > (info.xmin + 1)
coord(0) = coord(0) < (info.maxThresh - 1)
END
'MAX': BEGIN
coord(0) = coord(0) > (info.minThresh + 1)
coord(0) = coord(0) < (info.xmax - 1)
END
ENDCASE
; Draw both of the threshold lines again.
CASE info.lineby OF
'MIN': BEGIN
PlotS, [coord(0), coord(0)],[info.ymin, info.ymax], $
Color=info.minColor
PlotS, [info.maxThresh, info.maxThresh], $
[info.ymin, info.ymax], Color=info.maxColor
info.minthresh = coord(0)
END
'MAX': BEGIN
PlotS, [coord(0), coord(0)],[info.ymin, info.ymax], $
Color=info.maxColor
PlotS, [info.minThresh, info.minThresh], $
[info.ymin, info.ymax], Color=info.minColor
info.maxthresh = coord(0)
END
ENDCASE
; Update the image display by appling the threshold parameters.
; Be sure the image draw widget is still around. Make it if it isn't.
IF Widget_Info(info.image_draw, /Valid_ID) THEN BEGIN
WSet, info.windex
displayImage = BytScl(info.image, Top=info.ncolors-1, $
Max=info.maxThresh, Min=info.minThresh)
TV, displayImage
ENDIF ELSE BEGIN
Widget_Control, event.top, TLB_Get_Offset=offset
xoff = offset(0) + 200
yoff = offset(1) + 200
image_tlb = Widget_Base(Row=1, Group=event.top, Title='XStretch Image', $
XOffSet=xoff, YOffSet=yoff)
imageSize = Size(info.image)
xsize = imageSize(1)
ysize = imageSize(2)
image_draw = Widget_Draw(image_tlb, XSize=xsize, YSize=ysize)
Widget_Control, image_tlb, /Realize
Widget_Control, image_draw, Get_Value=windex
info.image_draw = image_draw
info.windex = windex
displayImage = BytScl(info.image, Top=info.ncolors-1, $
Max=info.maxThresh, Min=info.minThresh)
TV, displayImage
ENDELSE
; Update the pixmap with histogram with no threshold lines.
WSet, info.pixmap
Plot, Histogram(info.image), XRange=[info.minVal, info.maxVal], $
XStyle=1, Max_Value=info.maxValue, $
YTitle='Number of Pixels', XTitle='Pixel Intensity', $
Title='Image Histogram', $
Background=info.backColor, Color=info.drawColor, _Extra=info.extra
; Put the info structure back into its storage location and then,
; out of here!
Widget_Control, event.top, Set_UValue=info, /No_Copy
RETURN
ENDIF ; thisEvent = UP
; Most of the action in this event handler occurs here while we are waiting
; for an UP event to occur. As long as we don't get it, keep erasing the
; old threshold line and drawing a new one.
; Get current window and scaling parameters in order.
WSet, info.histo_wid
!X.S = info.xs
!Y.S = info.ys
coord = Convert_Coord(event.x, event.y, /Device, /To_Data)
; Draw the "other" line on the pixmap (so you don't have to draw
; it all the time).
WSet, info.pixmap
CASE info.lineby OF
'MIN': PlotS, [info.maxthresh, info.maxthresh],[info.ymin, info.ymax], $
Color=info.maxColor
'MAX': PlotS, [info.minthresh, info.minthresh],[info.ymin, info.ymax], $
Color=info.minColor
ENDCASE
; Erase the old threshold line.
WSet, info.histo_wid
Device, Copy = [0, 0, 300, 200, 0, 0, info.pixmap]
; Draw the new line at the new coordinate. Make sure the coordinate
; is inside the plot and doesn't go over the other line.
CASE info.lineby OF
'MIN': BEGIN
coord(0) = coord(0) > (info.xmin + 1)
coord(0) = coord(0) < (info.maxThresh - 1)
END
'MAX': BEGIN
coord(0) = coord(0) > (info.minThresh + 1)
coord(0) = coord(0) < (info.xmax - 1)
END
ENDCASE
CASE info.lineby OF
'MIN': PlotS, [coord(0), coord(0)],[info.ymin, info.ymax], $
Color=info.minColor
'MAX': PlotS, [coord(0), coord(0)],[info.ymin, info.ymax], $
Color=info.maxColor
ENDCASE
; Put the info structure back into its storage location.
Widget_Control, event.top, Set_UValue=info, /No_Copy
END ; of XSTRETCH_MOVELINE **************************************************
PRO XSTRETCH_QUIT, event
Widget_Control, event.top, /Destroy
END ; of XSTRETCH_QUIT ******************************************************
PRO XSTRETCH_COLORS, event
Widget_Control, event.top, Get_UValue=info, /No_Copy
thisEvent = Tag_Names(event, /Structure_Name)
CASE thisEvent OF
'WIDGET_BUTTON': BEGIN
XColors, Group=event.top, NColors=info.ncolors, $
NotifyID=[event.id, event.top]
END
'XCOLORS_LOAD': BEGIN
Device, Get_Visual_Depth=thisDepth
IF thisDepth GT 8 THEN BEGIN
WSet, info.windex
displayImage = BytScl(info.image, Top=info.ncolors-1, $
Max=info.maxThresh, Min=info.minThresh)
TV, displayImage
ENDIF
END
ENDCASE
Widget_Control, event.top, Set_UValue=info, /No_Copy
END ; of XSTRETCH_COLORS ****************************************************
PRO XSTRETCH, image, Group_Leader=group, NColors=ncolors, $
Max_Value=maxValue, Colortable=ctable, _EXTRA=extra
On_Error, 1
Device, Decomposed = 0
IF N_Params() NE 1 THEN Message, 'One positional parameter is required.'
imgsize = Size(image)
IF imgsize(0) NE 2 THEN $
Message, 'First positional parameter must be a 2D array.'
xsize = imgsize(1)
ysize = imgsize(2)
; Default values for keywords.
IF N_Elements(maxValue) EQ 0 THEN maxValue=5000
IF N_Elements(extra) EQ 0 THEN extra = {TITLE:''}
IF N_Elements(ncolors) EQ 0 THEN BEGIN
; Find out how many colors you have.
Window, /Pixmap, XSize=10, YSize=10
WDelete, !D. Window
ncolors=(!D.N_Colors < 256) - 4
IF ncolors LT 24 THEN BEGIN
Message, 'Not enough colors available to continue. Returning.'
RETURN
ENDIF
minColor = ncolors
maxColor = ncolors + 1
backColor = ncolors + 2
drawColor = ncolors + 3
ENDIF ELSE BEGIN
; We will scale to as many colors as we have, less 4 drawing colors.
; Must have at least 20 data colors.
Window, /Pixmap, /Free, XSize=10, YSize=10
WDelete, !D.Window
officialColors = !D.N_Colors < 256
ncolors = (ncolors-4) < (officialColors-4)
IF ncolors LT 24 THEN BEGIN
Message, 'Not enough colors available to continue. Returning.'
RETURN
ENDIF
minColor = ncolors
maxColor = ncolors + 1
backColor = ncolors + 2
drawColor = ncolors + 3
ENDELSE
; Create the histogram widget.
histo_tlb = Widget_Base(Row=1, Title='XStretch Histogram')
histo_draw = Widget_Draw(histo_tlb, XSize=300, YSize=200, $
Button_Events=1, Event_Pro='XStretch_Process_Events')
histo_but = Widget_Base(histo_tlb, Column=1)
colors = Widget_Button(histo_but, Value='Colors', $
Event_Pro='XStretch_Colors')
quitter = Widget_Button(histo_but, Value='Quit', $
Event_Pro='XStretch_Quit')
Widget_Control, histo_tlb, /Realize
; Create a pixmap window for moving and erasing the histogram
; threshold bars.
Window, Pixmap=1, XSize=300, YSize=200, /Free
pixmap = !D.Window
; Create an image window for displaying the image.
Widget_Control, histo_tlb, TLB_Get_Offset=offsets
xoff = offsets(0) + 200
yoff = offsets(1) + 200
image_tlb = Widget_Base(Row=1, Group=histo_tlb, Title='XStretch Image', $
XOffSet=xoff, YOffSet=yoff)
image_draw = Widget_Draw(image_tlb, XSize=xsize, YSize=ysize)
Widget_Control, image_tlb, /Realize
; Get window index numbers for the draw widgets.
Widget_Control, image_draw, Get_Value=windex
Widget_Control, histo_draw, Get_Value=histo_wid
; Load a colortable with the number of colors we are using.
; Get current colors.
TVLct, r, g, b, /Get
IF N_Elements(ctable) EQ 0 THEN BEGIN
; Scale into the proper number of colors.
red = Congrid(r, ncolors-1)
green = Congrid(g, ncolors-1)
blue = Congrid(b, ncolors-1)
; Load the users color table.
TVLct, red, green, blue
ENDIF ELSE LoadCt, ctable, NColors=ncolors
; Load drawing colors.
TVLct, 255b, 255b, 0b, minColor ; Yellow color.
TVLct, 0b, 255b, 0b, maxColor ; Green color
TVLct, 70b, 70b, 70b, backColor ; Charcoal color
TvLct, 255b, 255b, 255b, drawColor ; White color
; Start with 2% linear stretch on both ends.
maxVal = Max(image)
maxThresh = 0.98 * maxVal
minVal = Min(image)
minThresh = minVal + (0.02 * maxVal)
WSet, histo_wid
Plot, Histogram(image), XRange=[minVal, maxVal], XStyle=1, $
Max_Value=maxValue, YTitle='Number of Pixels', $
XTitle='Pixel Intensity', Title='Image Histogram', $
Background=backColor, Color=drawColor, _Extra=extra
; Put the same plot in the pixmap.
WSet, pixmap
Plot, Histogram(image), XRange=[minVal, maxVal], XStyle=1, $
Max_Value=maxValue, YTitle='Number of Pixels', $
XTitle='Pixel Intensity', Title='Image Histogram', $
Background=backColor, Color=drawColor, _Extra=extra
; Save the scaling factors for calculating data coordinates.
xs = !X.S
ys = !Y.S
WSet, histo_wid
; Draw threshold lines.
PlotS, [minThresh, minThresh], [!Y.CRange(0), !Y.CRange(1)], Color=minColor
PlotS, [maxThresh, maxThresh], [!Y.CRange(0), !Y.CRange(1)], Color=maxColor
; Display the image after thresholding.
WSet, windex
displayImage = BytScl(image, Top=ncolors-1, Max=maxThresh, Min=minThresh)
TV, displayImage
; Calculate a value to tell you if you are "close" to a threshold line.
close = 0.05 * (maxval-minval)
; Make an info structure with all info to run the program.
info = {image:image, $ ; The image data
minThresh:minThresh, $ ; The minimum threshold
maxThresh:maxThresh, $ ; The maximum threshold
ncolors:ncolors, $ ; The number of colors
minColor:minColor, $ ; The minimum drawing color index
maxColor:maxColor, $ ; The maximum drawing color index
backColor:backColor, $ ; The background drawing color index
drawColor:drawColor, $ ; The plot drawing color index
histo_wid:histo_wid, $ ; The histogram window index number
histo_draw:histo_draw, $ ; The histogram draw id
maxValue:maxValue, $ ; The maximum value of the plot
windex:windex, $ ; The image window index
image_draw:image_draw, $ ; The image draw widget id
ymin:!Y.Crange(0), $ ; The ymin in data coordinates
ymax:!Y.Crange(1), $ ; The ymax in data coordinates
xmin:!X.Crange(0), $ ; The xmin in data coordinates
xmax:!X.Crange(1), $ ; The xmax in data coordinates
lineby:'MIN', $ ; The line you are close to.
linex:minThresh, $ ; The x coordinate of line (data coords).
pixmap:pixmap, $ ; The pixmap window index
minval:minval, $ ; The minimum intensity value of the data
maxval:maxval, $ ; The maximum intensity value of the data
r:r, $ ; Original red colors to restore.
g:g, $ ; Original green colors to restore.
b:b, $ ; Original blue colors to restore.
extra:extra, $ ; The extra keywords for the Plot command.
xs:xs, $ ; Scaling x factors
ys:ys, $ ; Scaling y factors
close:close} ; A value to indicate closeness to line
; Save the info structure and bring the histogram window forward with SHOW.
Widget_Control, histo_tlb, Set_UValue=info, /No_Copy, /Show
XManager, 'xstretch', histo_tlb, Group=group, /No_Block
END