;+ ; NAME: ; XCOLORS ; ; PURPOSE: ; ; The purpose of this routine is to interactively change color tables ; in a manner similar to XLOADCT. No common blocks are used so ; multiple copies of XCOLORS can be on the display at the same ; time (if each has a different TITLE). XCOLORS has the ability ; to notify a widget event handler, an object method, or an IDL ; procedure if and when a new color table has been loaded. The ; event handler, object method, or IDL procedure is then responsibe ; for updating the program's display on 16- or 24-bit display systems. ; ; AUTHOR: ; ; FANNING SOFTWARE CONSULTING ; David Fanning, Ph.D. ; 1645 Sheely Drive ; Fort Collins, CO 80526 USA ; Phone: 970-221-0438 ; E-mail: davidf@dfanning.com ; Coyote's Guide to IDL Programming: http://www.dfanning.com ; ; CATEGORY: ; ; Widgets, Object, Command line. ; ; CALLING SEQUENCE: ; ; XCOLORS ; ; INPUTS: ; ; None. ; ; KEYWORD PARAMETERS: ; ; BLOCK: If this keyword is set, the program will try to block the ; IDL command line. Note that this is only possible if no other ; widget program is currently blocking the IDL command line. It ; is much more reliable to make XCOLORS a modal widget (see the MODAL ; keyword), although this can generally only be done when XCOLORS ; is called from another widget program. ; ; BOTTOM: The lowest color index of the colors to be changed. ; ; COLORINFO: This output keyword will return either a pointer to ; a color information structure (if the program is called in ; a non-modal fashion) or a color information structure (if the program ; is called in modal or blocking fashion). The color information ; structure is an anonymous structure defined like this: ; ; struct = { R: BytArr(!D.Table_Size), $ ; The current R color vector. ; G: BytArr(!D.Table_Size), $ ; The current G color vector. ; B: BytArr(!D.Table_Size), $ ; The current B color vector. ; NAME: "", $ ; The name of the current color table. ; INDEX: 0 } ; The index number of the current color table. ; ; If a pointer to the structure is obtained, you will be responsible ; for freeing it to prevent memory leakage: ; ; XColors, ColorInfo=colorInfoPtr ; Print, "Color Table Name: ", (*colorInfoPtr).Name ; Ptr_Free, colorInfoPtr ; ; Note that that Name field will be "Unknown" and the Index field will ; be -1 until a color table is actually selected by the user. You are ; responsible for checking this value before you use it. ; ; When called in modal or blocking fashion, you don't have to worry about freeing ; the pointer, since no pointer is involved: ; ; XColors, /Block, ColorInfo=colorInfoData ; Help, colorInfoData, /Structure ; Print, "Color Table Name: ", colorInfoData.Name ; ; DATA: This keyword can be set to any valid IDL variable. If ; the variable is defined, the specified object method or notify ; procedure will be passed this variable via a DATA keyword. This ; keyword is defined primarily so that Notify Procedures are compatible ; with the XLOADCT way of passing data. It is not strictly required, ; since the _EXTRA keyword inheritance mechanism will allow passing ; of *any* keyword parameter defined for the object or procedure that is ; to be notified. ; ; DRAG: Set this keyword if you want colors loaded as you drag ; the sliders. Default is to update colors only when you release ; the sliders. ; ; _EXTRA: This keyword inheritance mechanism will pick up and ; pass along to any method or procedure to be notified and keywords ; that are defined for that procedure. Note that you should be sure ; that keywords are spelled correctly. Any mis-spelled keyword will ; be ignored. ; ; FILE: A string variable pointing to a file that holds the ; color tables to load. The normal colors1.tbl file is used by default. ; ; GROUP_LEADER: The group leader for this program. When the group ; leader is destroyed, this program will be destroyed. ; ; MODAL: Set this keyword (along with the GROUP_LEADER keyword) to ; make the XCOLORS dialog a modal widget dialog. Note that NO ; other events can occur until the XCOLORS program is destroyed ; when in modal mode. ; ; NCOLORS: This is the number of colors to load when a color table ; is selected. ; ; NOTIFYID: A 2-column by n-row array that contains the IDs of widgets ; that should be notified when XCOLORS loads a color table. The first ; column of the array is the widgets that should be notified. The ; second column contains IDs of widgets that are at the top of the ; hierarchy in which the corresponding widgets in the first column ; are located. (The purpose of the top widget IDs is to make it ; possible for the widget in the first column to get the "info" ; structure of the widget program.) An XCOLORS_LOAD event will be ; sent to the widget identified in the first column. The event ; structure is defined like this: ; ; event = {XCOLORS_LOAD, ID:0L, TOP:0L, HANDLER:0L, $ ; R:BytArr(!D.TABLE_SIZE < 256), G:BytArr(!D.TABLE_SIZE < 256), $ ; B:BytArr(!D.TABLE_SIZE < 256), INDEX:0, NAME:""} ; ; The ID field will be filled out with NOTIFYID[0, n] and the TOP ; field will be filled out with NOTIFYID[1, n]. The R, G, and B ; fields will have the current color table vectors, obtained by ; exectuing the command TVLCT, r, g, b, /Get. The INDEX field will ; have the index number of the just-loaded color table. The name ; field will have the name of the currently loaded color table. ; ; Note that XCOLORS can't initially tell *which* color table is ; loaded, since it just uses whatever colors are available when it ; is called. Thus, it stores a -1 in the INDEX field to indicate ; this "default" value. Programs that rely on the INDEX field of ; the event structure should normally do nothing if the value is ; set to -1. This value is also set to -1 if the user hits the ; CANCEL button. (Note the NAME field will initially be "Unknown"). ; ; Typically the XCOLORS button will be defined like this: ; ; xcolorsID = Widget_Button(parentID, Value='Load New Color Table...', $ ; Event_Pro='Program_Change_Colors_Event') ; ; The event handler will be written something like this: ; ; PRO Program_Change_Colors_Event, event ; ; ; Handles color table loading events. Allows colors be to changed. ; ; Widget_Control, event.top, Get_UValue=info, /No_Copy ; thisEvent = Tag_Names(event, /Structure_Name) ; CASE thisEvent OF ; ; 'WIDGET_BUTTON': BEGIN ; ; ; Color table tool. ; ; XColors, NColors=info.ncolors, Bottom=info.bottom, $ ; Group_Leader=event.top, NotifyID=[event.id, event.top] ; ENDCASE ; ; 'XCOLORS_LOAD': BEGIN ; ; ; Update the display for 24-bit displays. ; ; Device, Get_Visual_Depth=thisDepth ; IF thisDepth GT 8 THEN BEGIN ; WSet, info.wid ; ; ...Whatever display commands are required go here. For example... ; ; TV, info.image ; ; ENDIF ; ENDCASE ; ; ENDCASE ; ; Widget_Control, event.top, Set_UValue=info, /No_Copy ; END ; ; NOTIFYOBJ: A vector of structures (or a single structure), with ; each element of the vector defined as follows: ; ; struct = {XCOLORS_NOTIFYOBJ, object:Obj_New(), method:''} ; ; where the Object field is an object reference, and the Method field ; is the name of the object method that should be called when XCOLORS ; loads its color tables. ; ; ainfo = {XCOLORS_NOTIFYOBJ, a, 'Draw'} ; binfo = {XCOLORS_NOTIFYOBJ, b, 'Display'} ; XColors, NotifyObj=[ainfo, binfo] ; ; Note that the XColors program must be compiled before these structures ; are used. Alternatively, you can put this program, named ; "xcolors_notifyobj__define.pro" (*three* underscore characters in this ; name!) in your PATH: ; ; PRO XCOLORS_NOTIFYOBJ__DEFINE ; struct = {XCOLORS_NOTIFYOBJ, OBJECT:Obj_New(), METHOD:''} ; END ; ; Or, you can simply define this structure as it is shown here in your code. ; ; "Extra" keywords added to the XCOLORS call are passed along to ; the object method, which makes this an alternative way to get information ; to your methods. If you expect such keywords, your methods should be defined ; with an _Extra keyword. ; ; NOTIFYPRO: The name of a procedure to notify or call when the color ; tables are loaded. If the DATA keyword is also defined, it will ; be passed to this program via an DATA keyword. But note that *any* ; keyword appropriate for the procedure can be used in the call to ; XCOLORS. For example, here is a procedure that re-displays and image ; in the current graphics window: ; ; PRO REFRESH_IMAGE, Image=image, _Extra=extra, WID=wid ; IF N_Elements(wid) NE 0 THEN WSet, wid ; TVIMAGE, image, _Extra=extra ; END ; ; This program can be invoked with this series of commands: ; ; IDL> Window, /Free ; IDL> TVImage, image, Position=[0.2, 0.2, 0.8, 0.8] ; IDL> XColors, NotifyPro='Refresh_Image', Image=image, WID=!D.Window ; ; Note that "extra" keywords added to the XCOLORS call are passed along to ; your procedure, which makes this an alternative way to get information ; to your procedure. If you expect such keywords, your procedure should ; be defined with an _Extra keyword as illustrated above. ; ; TITLE: This is the window title. It is "Load Color Tables" by ; default. The program is registered with the name 'XCOLORS:' plus ; the TITLE string. The "register name" is checked before the widgets ; are defined. If a program with that name has already been registered ; you cannot register another with that name. This means that you can ; have several versions of XCOLORS open simultaneously as long as each ; has a unique title or name. For example, like this: ; ; IDL> XColors, NColors=100, Bottom=0, Title='First 100 Colors' ; IDL> XColors, NColors=100, Bottom=100, Title='Second 100 Colors' ; ; XOFFSET: This is the X offset of the program on the display. The ; program will be placed approximately in the middle of the display ; by default. ; ; YOFFSET: This is the Y offset of the program on the display. The ; program will be placed approximately in the middle of the display ; by default. ; ; COMMON BLOCKS: ; ; None. ; ; SIDE EFFECTS: ; ; Colors are changed. Events are sent to widgets if the NOTIFYID ; keyword is used. Object methods are called if the NOTIFYOBJ keyword ; is used. This program is a non-blocking widget. ; ; RESTRICTIONS: ; ; None. ; ; EXAMPLE: ; ; To load a color table into 100 colors, starting at color index ; 50 and send an event to the widget identified at info.drawID ; in the widget heirarchy of the top-level base event.top, type: ; ; XCOLORS, NCOLORS=100, BOTTOM=50, NOTIFYID=[info.drawID, event.top] ; ; MODIFICATION HISTORY: ; Written by: David W. Fanning, 15 April 97. Extensive modification ; of an older XCOLORS program with excellent suggestions for ; improvement by Liam Gumley. Now works on 8-bit and 24-bit ; systems. Subroutines renamed to avoid ambiguity. Cancel ; button restores original color table. ; 23 April 1997, added color protection for the program. DWF ; 24 April 1997, fixed a window initialization bug. DWF ; 18 June 1997, fixed a bug with the color protection handler. DWF ; 18 June 1997, Turned tracking on for draw widget to fix a bug ; in TLB Tracking Events for WindowsNT machines in IDL 5.0. DWF ; 20 Oct 1997, Changed GROUP keyword to GROUP_LEADER. DWF ; 19 Dec 1997, Fixed bug with TOP/BOTTOM reversals and CANCEL. DWF. ; 9 Jun 1998, Fixed bug when using BOTTOM keyword on 24-bit devices. DWF ; 9 Jun 1998, Added Device, Decomposed=0 for TrueColor visual classes. DWF ; 9 Jun 1998, Removed all IDL 4 compatibility. ; 21 Oct 1998, Fixed problem with gamma not being reset on CANCEL. DWF ; 5 Nov 1998. Added the NotifyObj keyword, so that XCOLORS would work ; interactively with objects. DWF. ; 9 Nov 1998. Made slider reporting only at the end of the drag. If you ; want continuous updating, set the DRAG keyword. DWF. ; 9 Nov 1998. Fixed problem with TOP and BOTTOM sliders not being reset ; on CANCEL. DWF. ; 10 Nov 1998. Fixed fixes. Sigh... DWF. ; 5 Dec 1998. Added INDEX field to the XCOLORS_LOAD event structure. This ; field holds the current color table index number. DWF. ; 5 Dec 1998. Modified the way the colorbar image was created. Results in ; greatly improved display for low number of colors. DWF. ; 6 Dec 1998. Added the ability to notify an unlimited number of objects. DWF. ; 12 Dec 1998. Removed obsolete Just_Reg keyword and improved documetation. DWF. ; 30 Dec 1998. Fixed the way the color table index was working. DWF. ; 4 Jan 1999. Added slightly modified CONGRID program to fix floating divide ; by zero problem. DWF ; 2 May 1999. Added code to work around a Macintosh bug in IDL through version ; 5.2 that tries to redraw the graphics window after a TVLCT command. DWF. ; 5 May 1999. Restore the current window index number after drawing graphics. ; Not supported on Macs. DWF. ; 9 Jul 1999. Fixed a couple of bugs I introduced with the 5 May changes. Sigh... DWF. ; 13 Jul 1999. Scheesh! That May 5th change was a BAD idea! Fixed more bugs. DWF. ; 31 Jul 1999. Substituted !D.Table_Size for !D.N_Colors. DWF. ; 1 Sep 1999. Got rid of the May 5th fixes and replaced with something MUCH simpler. DWF. ; 14 Feb 2000. Removed the window index field from the object notify structure. DWF. ; 14 Feb 2000. Added NOTIFYPRO, DATA, and _EXTRA keywords. DWF. ; 20 Mar 2000. Added MODAL, BLOCK, and COLORINFO keywords. DWF ; 20 Mar 2000. Fixed a slight problem with color protection events triggering ; notification events. DWF. ; 31 Mar 2000. Fixed a problem with pointer leakage on Cancel events, and improved ; program documentation. DWF. ; 17 Aug 2000. Fixed a problem with CANCEL that occurred only if you first ; changed the gamma settings before loading a color table. DWF. ; 10 Sep 2000. Removed the requirement that procedures and object methods must ; be written with an _Extra keyword. DWF. ; 5 Oct 2000. Added the File keyword to LOADCT command, as I was suppose to. DWF. ; 5 Oct 2000. Now properly freeing program pointers upon early exit from program. DWF. ; 7 Mar 2001. Fixed a problem with the BLOCK keyword. DWF. ; 12 Nov 2001. Renamed Congrid to XColors_Congrid. DWF. ; 14 Aug 2002. Moved the calculation of NCOLORS to after the draw widget creation ; to fix a problem with !D.TABLE_SIZE having a correct value when no windows had ; been opened in the current IDL session. DWF. ; 14 Aug 2002. Fixed a documentation problem in the NOTIFYID keyword documentation ; that still referred to !D.N_COLORS instead of the current !D.TABLE_SIZE. DWF. ;- ; ;########################################################################### ; ; LICENSE ; ; This software is OSI Certified Open Source Software. ; OSI Certified is a certification mark of the Open Source Initiative. ; ; Copyright © 1997-2002 Fanning Software Consulting. ; ; This software is provided "as-is", without any express or ; implied warranty. In no event will the authors be held liable ; for any damages arising from the use of this software. ; ; Permission is granted to anyone to use this software for any ; purpose, including commercial applications, and to alter it and ; redistribute it freely, subject to the following restrictions: ; ; 1. The origin of this software must not be misrepresented; you must ; not claim you wrote the original software. If you use this software ; in a product, an acknowledgment in the product documentation ; would be appreciated, but is not required. ; ; 2. Altered source versions must be plainly marked as such, and must ; not be misrepresented as being the original software. ; ; 3. This notice may not be removed or altered from any source distribution. ; ; For more information on Open Source Software, visit the Open Source ; web site: http://www.opensource.org. ; ;########################################################################### Function XColors_Congrid, arr, x, y, z, INTERP=int, MINUS_ONE=m1, CUBIC = cubic ON_ERROR, 2 ;Return to caller if error s = Size(arr) if ((s[0] eq 0) or (s[0] gt 3)) then $ Message, 'Array must have 1, 2, or 3 dimensions.' ;; Supply defaults = no interpolate, and no minus_one. if (N_ELEMENTS(int) le 0) then int = 0 else int = KEYWORD_SET(int) if (N_ELEMENTS(m1) le 0) then m1 = 0 else m1 = KEYWORD_SET(m1) if (N_ELEMENTS(cubic) eq 0) then cubic = 0 if (cubic ne 0) then int = 1 ;Cubic implies interpolate case s[0] of 1: begin ; *** ONE DIMENSIONAL ARRAY ; DWF modified: Check divide by zero. srx = float(s[1] - m1)/((x-m1) > 1e-6) * findgen(x) ;subscripts if (int) then $ return, INTERPOLATE(arr, srx, CUBIC = cubic) else $ return, arr[ROUND(srx)] endcase 2: begin ; *** TWO DIMENSIONAL ARRAY if (int) then begin srx = float(s[1] - m1) / ((x-m1) > 1e-6) * findgen(x) sry = float(s[2] - m1) / ((y-m1) > 1e-6) * findgen(y) return, INTERPOLATE(arr, srx, sry, /GRID, CUBIC=cubic) endif else $ return, POLY_2D(arr, $ [[0,0],[(s[1]-m1)/(float(x-m1) > 1e-6),0]], $ ;Use poly_2d [[0,(s[2]-m1)/(float(y-m1) > 1e-6)],[0,0]],int,x,y) endcase 3: begin ; *** THREE DIMENSIONAL ARRAY srx = float(s[1] - m1) / ((x-m1) > 1e-6) * findgen(x) sry = float(s[2] - m1) / ((y-m1) > 1e-6) * findgen(y) srz = float(s[3] - m1) / ((z-m1) > 1e-6) * findgen(z) return, interpolate(arr, srx, sry, srz, /GRID) endcase endcase return, arr_r END ; *************************************************************** PRO XColors_NotifyObj__Define ; Structure definition module for object notification. struct = { XColors_NotifyObj, $ ; The structure name. object:Obj_New(), $ ; The object to notify. method:'' } ; The name of the object method to call. END ; *************************************************************** PRO XColors_Set, info TVLCT, r, g, b, /Get ; Make sure the current bottom index is less than the current top index. IF info.currentbottom GE info.currenttop THEN BEGIN temp = info.currentbottom info.currentbottom = info.currenttop info.currenttop = temp ENDIF r(info.bottom:info.currentbottom) = info.bottomcolor(0) g(info.bottom:info.currentbottom) = info.bottomcolor(1) b(info.bottom:info.currentbottom) = info.bottomcolor(2) r(info.currenttop:info.top) = info.topcolor(0) g(info.currenttop:info.top) = info.topcolor(1) b(info.currenttop:info.top) = info.topcolor(2) red = info.r green = info.g blue = info.b number = ABS((info.currenttop-info.currentbottom) + 1) gamma = info.gamma index = Findgen(info.ncolors) distribution = index^gamma > 10e-6 index = Round(distribution * (info.ncolors-1) / (Max(distribution) > 10e-6)) IF info.currentbottom GE info.currenttop THEN BEGIN temp = info.currentbottom info.currentbottom = info.currenttop info.currenttop = temp ENDIF IF info.reverse EQ 0 THEN BEGIN r(info.currentbottom:info.currenttop) = XColors_Congrid(red(index), number, /Minus_One) g(info.currentbottom:info.currenttop) = XColors_Congrid(green(index), number, /Minus_One) b(info.currentbottom:info.currenttop) = XColors_Congrid(blue(index), number, /Minus_One) ENDIF ELSE BEGIN r(info.currentbottom:info.currenttop) = $ Reverse(XColors_Congrid(red(index), number, /Minus_One)) g(info.currentbottom:info.currenttop) = $ Reverse(XColors_Congrid(green(index), number, /Minus_One)) b(info.currentbottom:info.currenttop) = $ Reverse(XColors_Congrid(blue(index), number, /Minus_One)) ENDELSE TVLct, r, g, b WSet, info.windowindex TV, info.colorimage WSet, info.thisWindow (*info.colorInfoPtr).R = r (*info.colorInfoPtr).G = g (*info.colorInfoPtr).B = b (*info.colorInfoPtr).name = info.ctname (*info.colorInfoPtr).index = info.index ; Don't bother with notification if this is just a color ; protection event. IF info.from EQ 'PROTECT' THEN RETURN ; Are there widgets to notify? s = SIZE(info.notifyID) IF s(0) EQ 1 THEN count = 0 ELSE count = s(2)-1 FOR j=0,count DO BEGIN colorEvent = { XCOLORS_LOAD, $ ; ID:info.notifyID(0,j), $ ; TOP:info.notifyID(1,j), $ HANDLER:0L, $ R:r, $ G:g, $ B:b, $ index:info.index, $ name:info.ctname } IF Widget_Info(info.notifyID(0,j), /Valid_ID) THEN $ Widget_Control, info.notifyID(0,j), Send_Event=colorEvent ENDFOR ; Is there an object to notify? nelements = SIZE(info.notifyobj, /N_Elements) FOR j=0,nelements-1 DO BEGIN IF Obj_Valid((info.notifyobj)[j].object) THEN BEGIN IF N_Elements(*info.xcolorsData) EQ 0 THEN BEGIN s = Size(*info.extra) IF s[s[0]+1] EQ 0 THEN BEGIN Call_Method, (info.notifyobj)[j].method, (info.notifyobj)[j].object ENDIF ELSE BEGIN Call_Method, (info.notifyobj)[j].method, (info.notifyobj)[j].object,$ _Extra=*info.extra ENDELSE ENDIF ELSE BEGIN s = Size(*info.extra) IF s[s[0]+1] EQ 0 THEN BEGIN Call_Method, (info.notifyobj)[j].method, (info.notifyobj)[j].object, $ DATA=*info.xcolorsData ENDIF ELSE BEGIN Call_Method, (info.notifyobj)[j].method, (info.notifyobj)[j].object, $ DATA=*info.xcolorsData, _Extra=*info.extra ENDELSE ENDELSE ENDIF ENDFOR ; Is there a procedure to notify? IF info.notifyPro NE "" THEN BEGIN IF N_Elements(*info.xcolorsData) EQ 0 THEN BEGIN s = Size(*info.extra) IF s[s[0]+1] EQ 0 THEN BEGIN Call_Procedure, info.notifyPro ENDIF ELSE BEGIN Call_Procedure, info.notifyPro, _Extra=*info.extra ENDELSE ENDIF ELSE BEGIN s = Size(*info.extra) IF s[s[0]+1] EQ 0 THEN BEGIN Call_Procedure, info.notifyPro, DATA=*info.xcolorsData ENDIF ELSE BEGIN Call_Procedure, info.notifyPro, DATA=*info.xcolorsData, _Extra=*info.extra ENDELSE ENDELSE ENDIF END ; *************************************************************** PRO XCOLORS_TOP_SLIDER, event ; Get the info structure from storage location. Widget_Control, event.top, Get_UValue=info, /No_Copy ; Update the current top value of the slider. currentTop = event.value Widget_Control, info.botSlider, Get_Value=currentBottom currentBottom = currentBottom + info.bottom currentTop = currentTop + info.bottom ; Error handling. Is currentBottom = currentTop? IF currentBottom EQ currentTop THEN BEGIN currentBottom = (currentTop - 1) > 0 thisValue = (currentBottom-info.bottom) IF thisValue LT 0 THEN BEGIN thisValue = 0 currentBottom = info.bottom ENDIF Widget_Control, info.botSlider, Set_Value=thisValue ENDIF ; Error handling. Is currentBottom > currentTop? IF currentBottom GT currentTop THEN BEGIN bottom = currentTop top = currentBottom bottomcolor = info.topColor topcolor = info.bottomColor reverse = 1 ENDIF ELSE BEGIN bottom = currentBottom top = currentTop bottomcolor = info.bottomColor topcolor = info.topColor reverse = 0 ENDELSE ; Create a pseudo structure. pseudo = {currenttop:top, currentbottom:bottom, reverse:reverse, $ bottomcolor:bottomcolor, topcolor:topcolor, gamma:info.gamma, index:info.index, $ top:info.top, bottom:info.bottom, ncolors:info.ncolors, r:info.r, $ g:info.g, b:info.b, notifyID:info.notifyID, colorimage:info.colorimage, $ windowindex:info.windowindex, from:'TOP', notifyObj:info.notifyObj, extra:info.extra, $ thisWindow:info.thisWindow, notifyPro:info.notifyPro, xcolorsData:info.xcolorsData, $ colorInfoPtr:info.colorInfoPtr, colornames:info.colornames, ctname:info.ctname, $ needColorInfo:info.needColorInfo} ; Update the colors. XColors_Set, pseudo info.currentTop = currentTop ; Put the info structure back in storage location. Widget_Control, event.top, Set_UValue=info, /No_Copy END ; ************************************************************************ PRO XCOLORS_BOTTOM_SLIDER, event ; Get the info structure from storage location. Widget_Control, event.top, Get_UValue=info, /No_Copy ; Update the current bottom value of the slider. currentBottom = event.value + info.bottom Widget_Control, info.topSlider, Get_Value=currentTop ;currentBottom = currentBottom + info.bottom currentTop = currentTop + info.bottom ; Error handling. Is currentBottom = currentTop? IF currentBottom EQ currentTop THEN BEGIN currentBottom = currentTop Widget_Control, info.botSlider, Set_Value=(currentBottom-info.bottom) ENDIF ; Error handling. Is currentBottom > currentTop? IF currentBottom GT currentTop THEN BEGIN bottom = currentTop top = currentBottom bottomcolor = info.topColor topcolor = info.bottomColor reverse = 1 ENDIF ELSE BEGIN bottom = currentBottom top = currentTop bottomcolor = info.bottomColor topcolor = info.topColor reverse = 0 ENDELSE ; Create a pseudo structure. pseudo = {currenttop:top, currentbottom:bottom, reverse:reverse, $ bottomcolor:bottomcolor, topcolor:topcolor, gamma:info.gamma, index:info.index, $ top:info.top, bottom:info.bottom, ncolors:info.ncolors, r:info.r, $ g:info.g, b:info.b, notifyID:info.notifyID, colorimage:info.colorimage, $ windowindex:info.windowindex, from:'BOTTOM', notifyObj:info.notifyObj, extra:info.extra, $ thisWindow:info.thisWindow, notifyPro:info.notifyPro, xcolorsData:info.xcolorsData, $ colorInfoPtr:info.colorInfoPtr, colornames:info.colornames, ctname:info.ctname, $ needColorInfo:info.needColorInfo} ; Update the colors. XColors_Set, pseudo info.currentBottom = currentBottom ; Put the info structure back in storage location. Widget_Control, event.top, Set_UValue=info, /No_Copy END ; ************************************************************************ PRO XCOLORS_GAMMA_SLIDER, event ; Get the info structure from storage location. Widget_Control, event.top, Get_UValue=info, /No_Copy ; Get the gamma value from the slider. Widget_Control, event.id, Get_Value=gamma gamma = 10^((gamma/50.0) - 1) ; Update the gamma label. Widget_Control, info.gammaID, Set_Value=String(gamma, Format='(F6.3)') ; Make a pseudo structure. IF info.currentBottom GT info.currentTop THEN $ pseudo = {currenttop:info.currentbottom, currentbottom:info.currenttop, $ reverse:1, bottomcolor:info.topcolor, topcolor:info.bottomcolor, $ gamma:gamma, top:info.top, bottom:info.bottom, index:info.index, $ ncolors:info.ncolors, r:info.r, g:info.g, b:info.b, $ notifyID:info.notifyID, colorimage:info.colorimage, extra:info.extra, $ windowindex:info.windowindex, from:'SLIDER', notifyObj:info.notifyObj, $ thisWindow:info.thisWindow, notifyPro:info.notifyPro, xcolorsData:info.xcolorsData, $ colorInfoPtr:info.colorInfoPtr, colornames:info.colornames, ctname:info.ctname, $ needColorInfo:info.needColorInfo} $ ELSE $ pseudo = {currenttop:info.currenttop, currentbottom:info.currentbottom, $ reverse:0, bottomcolor:info.bottomcolor, topcolor:info.topcolor, $ gamma:gamma, top:info.top, bottom:info.bottom, index:info.index, $ ncolors:info.ncolors, r:info.r, g:info.g, b:info.b, $ notifyID:info.notifyID, colorimage:info.colorimage, extra:info.extra, $ windowindex:info.windowindex, from:'SLIDER', notifyObj:info.notifyObj, $ thisWindow:info.thisWindow, notifyPro:info.notifyPro, xcolorsData:info.xcolorsData, $ colorInfoPtr:info.colorInfoPtr, colornames:info.colornames, ctname:info.ctname, $ needColorInfo:info.needColorInfo} ; Load the colors. XColors_Set, pseudo info.gamma = gamma ; Put the info structure back in storage location. Widget_Control, event.top, Set_UValue=info, /No_Copy END ; ************************************************************************ PRO XCOLORS_COLORTABLE, event ; Get the info structure from storage location. Widget_Control, event.top, Get_UValue=info, /No_Copy LoadCT, event.index, File=info.file, /Silent, $ NColors=info.ncolors, Bottom=info.bottom TVLct, r, g, b, /Get info.r = r(info.bottom:info.top) info.g = g(info.bottom:info.top) info.b = b(info.bottom:info.top) info.topcolor = [r(info.top), g(info.top), b(info.top)] info.bottomcolor = [r(info.bottom), g(info.bottom), b(info.bottom)] ; Update the slider positions and values. Widget_Control, info.botSlider, Set_Value=0 Widget_Control, info.topSlider, Set_Value=info.ncolors-1 Widget_Control, info.gammaSlider, Set_Value=50 Widget_Control, info.gammaID, Set_Value=String(1.0, Format='(F6.3)') info.currentBottom = info.bottom info.currentTop = info.top info.gamma = 1.0 info.index = event.index info.ctname = info.colornames[event.index] ; Create a pseudo structure. pseudo = {currenttop:info.currenttop, currentbottom:info.currentbottom, $ reverse:info.reverse, windowindex:info.windowindex, index:event.index, $ bottomcolor:info.bottomcolor, topcolor:info.topcolor, gamma:info.gamma, $ top:info.top, bottom:info.bottom, ncolors:info.ncolors, r:info.r, $ g:info.g, b:info.b, notifyID:info.notifyID, colorimage:info.colorimage, $ from:'LIST', notifyObj:info.notifyObj, thisWindow:info.thisWindow, $ notifyPro:info.notifyPro, xcolorsData:info.xcolorsData, extra:info.extra, $ colorInfoPtr:info.colorInfoPtr, colornames:info.colornames, ctname:info.ctname, $ needColorInfo:info.needColorInfo} ; Update the colors. XColors_Set, pseudo ; Put the info structure back in storage location. Widget_Control, event.top, Set_UValue=info, /No_Copy END ; ************************************************************************ PRO XCOLORS_PROTECT_COLORS, event ; Get the info structure from storage location. Widget_Control, event.top, Get_UValue=info, /No_Copy ; Create a pseudo structure. pseudo = {currenttop:info.currenttop, currentbottom:info.currentbottom, $ reverse:info.reverse, $ bottomcolor:info.bottomcolor, topcolor:info.topcolor, gamma:info.gamma, $ top:info.top, bottom:info.bottom, ncolors:info.ncolors, r:info.r, index:info.index, $ g:info.g, b:info.b, notifyID:info.notifyID, colorimage:info.colorimage, $ windowindex:info.windowindex, from:'PROTECT', notifyObj:info.notifyObj, extra:info.extra, $ thisWindow:info.thisWindow, notifyPro:info.notifyPro, xcolorsData:info.xcolorsData, $ colorInfoPtr:info.colorInfoPtr, colornames:info.colornames, ctname:info.ctname, $ needColorInfo:info.needColorInfo} ; Update the colors. XColors_Set, pseudo ; Put the info structure back in storage location. Widget_Control, event.top, Set_UValue=info, /No_Copy END ; ************************************************************************ PRO XCOLORS_CANCEL, event Widget_Control, event.top, Get_UValue=info, /No_Copy ; Update the colors. XColors_Set, info.cancelStruct Widget_Control, event.top, Set_UValue=info, /No_Copy Widget_Control, event.top, /Destroy END ; ************************************************************************ PRO XCOLORS_DISMISS, event Widget_Control, event.top, /Destroy END ; ************************************************************************ PRO XCOLORS_CLEANUP, tlb Widget_Control, tlb, Get_UValue=info, /No_Copy IF N_Elements(info) NE 0 THEN BEGIN Ptr_Free, info.xcolorsData Ptr_Free, info.extra IF info.needColorInfo EQ 0 THEN Ptr_Free, info.colorInfoPtr ENDIF END ; ************************************************************************ PRO XCOLORS, NColors=ncolors, Bottom=bottom, Title=title, File=file, $ Group_Leader=group, XOffset=xoffset, YOffset=yoffset, Block=block, $ NotifyID=notifyID, NotifyObj=notifyObj, Drag=drag, NotifyPro=notifyPro, $ Data=xColorsData, _Extra=extra, Modal=modal, ColorInfo=colorinfoPtr ; This is a procedure to load color tables into a ; restricted color range of the physical color table. ; It is a highly simplified, but much more powerful, ; version of XLoadCT. On_Error, 1 ; Current graphics window. thisWindow = !D.Window ; Check keyword parameters. Define defaults. IF N_Elements(title) EQ 0 THEN title = 'Load Color Tables' IF N_Elements(drag) EQ 0 THEN drag = 0 IF N_ELements(file) EQ 0 THEN $ file = Filepath(SubDir=['resource','colors'], 'colors1.tbl') IF N_Elements(notifyID) EQ 0 THEN notifyID = [-1L, -1L] IF N_Elements(notifyObj) EQ 0 THEN BEGIN notifyObj = {object:Obj_New(), method:'', wid:-1} ENDIF IF Size(notifyObj, /Type) NE 8 THEN BEGIN ok = Dialog_Message(['Arguments to the NotifyObj keyword must', $ 'be structures. Returning...']) RETURN END nelements = Size(notifyObj, /N_Elements) FOR j=0,nelements-1 DO BEGIN tags = Tag_Names(notifyObj[j]) check = Where(tags EQ 'OBJECT', count1) check = Where(tags EQ 'METHOD', count2) IF (count1 + count2) NE 2 THEN BEGIN ok = Dialog_Message('NotifyObj keyword has incorrect fields. Returning...') RETURN ENDIF ENDFOR IF N_Elements(notifyPro) EQ 0 THEN notifyPro = "" IF N_Elements(xcolorsData) EQ 0 THEN xdata = Ptr_New(/Allocate_Heap) ELSE $ xdata = Ptr_New(xcolorsData) IF N_Elements(extra) EQ 0 THEN extra = Ptr_New(/Allocate_Heap) ELSE $ extra = Ptr_New(extra) IF Arg_Present(colorinfoPtr) THEN needcolorInfo = 1 ELSE needcolorInfo = 0 noblock = 1 - Keyword_Set(block) ; Create a pointer to the color information. TVLCT, rr, gg, bb, /Get colorInfoPtr = Ptr_New({R:rr, G:gg, B:bb, Name:'Unknown', Index:-1}) ; Find the center of the display. DEVICE, GET_SCREEN_SIZE=screenSize xCenter = FIX(screenSize(0) / 2.0) yCenter = FIX(screenSize(1) / 2.0) IF N_ELEMENTS(xoffset) EQ 0 THEN xoffset = xCenter - 150 IF N_ELEMENTS(yoffset) EQ 0 THEN yoffset = yCenter - 200 registerName = 'XCOLORS:' + title ; Only one XCOLORS with this title. IF XRegistered(registerName) GT 0 THEN BEGIN Ptr_Free, xdata Ptr_Free, extra Ptr_Free, colorInfoPtr RETURN ENDIF ; Create the top-level base. No resizing. IF Keyword_Set(modal) AND N_Elements(group) NE 0 THEN BEGIN tlb = Widget_Base(Column=1, Title=title, TLB_Frame_Attr=1, $ XOffSet=xoffset, YOffSet=yoffset, Base_Align_Center=1, $ Modal=1, Group_Leader=group) ENDIF ELSE BEGIN tlb = Widget_Base(Column=1, Title=title, TLB_Frame_Attr=1, $ XOffSet=xoffset, YOffSet=yoffset, Base_Align_Center=1) ENDELSE ; Create a draw widget to display the current colors. IF !D.NAME NE 'MAC' THEN BEGIN draw = Widget_Draw(tlb, XSize=256, YSize=40, Expose_Events=0, $ Retain=0, Event_Pro='XCOLORS_PROTECT_COLORS') ENDIF ELSE BEGIN draw = Widget_Draw(tlb, XSize=256, YSize=40, Retain=1) ENDELSE ; Find the top and bottom of the color table. This must be done ; AFTER the draw widget is created to make sure !D.TABLE_SIZE is ; accurate. IF N_Elements(bottom) EQ 0 THEN bottom = 0 IF N_Elements(ncolors) EQ 0 THEN ncolors = (256 < !D.Table_Size) - bottom IF (ncolors + bottom) GT 256 THEN ncolors = 256 - bottom ; Calculate top parameter. top = ncolors + bottom - 1 ; Create sliders to control stretchs and gamma correction. sliderbase = Widget_Base(tlb, Column=1, Frame=1) botSlider = Widget_Slider(sliderbase, Value=0, Min=0, $ Max=ncolors-1, XSize=256,Event_Pro='XColors_Bottom_Slider', $ Title='Stretch Bottom', Drag=drag) topSlider = Widget_Slider(sliderbase, Value=ncolors-1, Min=0, $ Max=ncolors-1, XSize=256, Event_Pro='XColors_Top_Slider', $ Title='Stretch Top', Drag=drag) gammaID = Widget_Label(sliderbase, Value=String(1.0, Format='(F6.3)')) gammaSlider = Widget_Slider(sliderbase, Value=50.0, Min=0, Max=100, $ Drag=drag, XSize=256, /Suppress_Value, Event_Pro='XColors_Gamma_Slider', $ Title='Gamma Correction') ; Get the colortable names for the list widget. colorNames='' LoadCT, Get_Names=colorNames, File=file colorNamesIndex = StrArr(N_Elements(colorNames)) FOR j=0,N_Elements(colorNames)-1 DO $ colorNamesIndex(j) = StrTrim(j,2) + ' - ' + colorNames(j) filebase = Widget_Base(tlb, Column=1, /Frame) listlabel = Widget_Label(filebase, Value='Select Color Table...') list = Widget_List(filebase, Value=colorNamesIndex, YSize=8, Scr_XSize=256, $ Event_Pro='XColors_ColorTable') ; Dialog Buttons dialogbase = WIDGET_BASE(tlb, Row=1) cancel = Widget_Button(dialogbase, Value='Cancel', $ Event_Pro='XColors_Cancel', UVALUE='CANCEL') dismiss = Widget_Button(dialogbase, Value='Accept', $ Event_Pro='XColors_Dismiss', UVALUE='ACCEPT') Widget_Control, tlb, /Realize ; Get window index number of the draw widget. Widget_Control, draw, Get_Value=windowIndex ; Is this a 24-bit TrueColor device? If so, turn ; color decomposition OFF. thisRelease = Float(!Version.Release) IF thisRelease GE 5.1 THEN BEGIN Device, Get_Visual_Name=thisVisual IF thisVisual EQ 'TrueColor' THEN Device, Decomposed=0 ENDIF ELSE Device, Decomposed=0 ; Put a picture of the color table in the window. bar = BINDGEN(ncolors) # REPLICATE(1B, 10) bar = BYTSCL(bar, TOP=ncolors-1) + bottom bar = XColors_Congrid(bar, 256, 40, /INTERP) WSet, windowIndex TV, bar ; Get the colors that make up the current color table ; in the range that this program deals with. TVLCT, rr, gg, bb, /Get r = rr(bottom:top) g = gg(bottom:top) b = bb(bottom:top) topColor = [rr(top), gg(top), bb(top)] bottomColor = [rr(bottom), gg(bottom), bb(bottom)] ; Create a cancel structure. cancelstruct = {currenttop:top, currentbottom:bottom, $ reverse:0, windowindex:windowindex, $ bottomcolor:bottomcolor, topcolor:topcolor, gamma:1.0, $ top:top, bottom:bottom, ncolors:ncolors, r:r, $ g:g, b:b, notifyID:notifyID, index:-1, $ colorimage:bar, from:'CANCEL', notifyObj:notifyObj, extra:extra, $ thisWindow:thisWindow, notifyPro:notifyPro, xcolorsData:xData, $ colorInfoPtr:colorInfoPtr, colornames:colornames, ctname:"Unknown", $ needColorInfo:needColorInfo} ; Create an info structure to hold information to run the program. info = { windowIndex:windowIndex, $ ; The WID of the draw widget. botSlider:botSlider, $ ; The widget ID of the bottom slider. currentBottom:bottom, $ ; The current bottom slider value. currentTop:top, $ ; The current top slider value. topSlider:topSlider, $ ; The widget ID of the top slider. gammaSlider:gammaSlider, $ ; The widget ID of the gamma slider. gammaID:gammaID, $ ; The widget ID of the gamma label ncolors:ncolors, $ ; The number of colors we are using. gamma:1.0, $ ; The current gamma value. file:file, $ ; The name of the color table file. bottom:bottom, $ ; The bottom color index. top:top, $ ; The top color index. topcolor:topColor, $ ; The top color in this color table. bottomcolor:bottomColor, $ ; The bottom color in this color table. reverse:0, $ ; A reverse color table flag. notifyID:notifyID, $ ; Notification widget IDs. notifyObj:notifyObj, $ ; An vector of structures containng info about objects to notify. notifyPro:notifyPro, $ ; The name of a procedure to notify. r:r, $ ; The red color vector. g:g, $ ; The green color vector. b:b, $ ; The blue color vector. extra:extra, $ ; A pointer to extra keywords. oindex:-1, $ ; The original color table number. index:-1, $ ; The current color table number. thisWindow:thisWindow, $ ; The current graphics window when this program is called. xcolorsData:xdata, $ ; A pointer to the xcolorData variable passed into the program. rstart:r, $ ; The original red color vector. gstart:g, $ ; The original green color vector. bstart:b, $ ; The original blue color vector. colorInfoPtr:colorInfoPtr, $ ; A pointer to the color information. colornames:colornames, $ ; The names of the color tables. ctname:"Unknown", $ ; The current color table name. needColorInfo:needColorInfo, $ ; A flag that indicates color information is requested. cancelStruct:cancelStruct, $ ; The cancel structure. colorimage:bar } ; The color table image. ; Turn color protection on. IF !D.NAME NE 'MAC' THEN Widget_Control, draw, Draw_Expose_Events=1 ; Store the info structure in the user value of the top-level base. Widget_Control, tlb, Set_UValue=info, /No_Copy Widget_Control, tlb, /Managed WSet, thisWindow XManager, registerName, tlb, Group=group, No_Block=noblock, Cleanup="XColors_Cleanup" ; Return the colorInfo information as a structure if this program ; was called as a modal widget. IF (Keyword_Set(modal) AND N_Elements(group) NE 0 AND needColorInfo) OR (noblock EQ 0 AND needColorInfo)THEN BEGIN stuff = *colorInfoPtr Ptr_Free, colorInfoPtr colorInfoPtr = stuff ENDIF END ; ************************************************************************