; Copyright (c) 1995, Research Systems, Inc. All rights reserved. ; Unauthorized reproduction prohibited. ;+ ; NAME: GWindow ; ; PURPOSE: This is a widget program that is a resizeable graphics window. ; ; MAJOR TOPICS: Widget Programs, Graphics ; ; CALLING SEQUENCE: GWindow, 'graphics_command', data ; ; HELP: GWindow, /Help ; ; PROCEDURE: This program is meant to be called alone or from another widget program. ; ; MAJOR FUNCTIONS and PROCEDURES: PS_FORM ; ; MODIFICATION HISTORY: Written by: David Fanning, RSI, March 1995 ; Modified to use the Oct 95 PS_Form. Oct 1995 ; 4/3/96 Fixed a bug that occured when PS_Form was called, cancelled, then ; then called again. ; 4/22/96 Made the call to PS_FORM come up with INCHES selected by default. ; ; EXAMPLE: GWindow, 'Surface', Dist(20), Charsize=1.5 ;- Function What_Button_Type, event ; Checks event.type to find out what kind of button ; was clicked in a draw widget. This is NOT an event handler. type = ['DOWN', 'UP', 'MOTION', 'SCROLL'] Return, type(event.type) END ;******************************************************************* Function WhatTypeVar, variable ; Use SIZE function to get variable info. varInfo = Size(variable) ; How long is the returned vector? lengthOfVariable = N_Elements(varInfo) ; The next to last element in varInfo has the data type. typeIndex = varInfo(lengthOfVariable - 2) dataTypes = ['UNDEFINED', 'BYTE', 'INTEGER', 'LONG', 'FLOATING', $ 'DOUBLE', 'COMPLEX', 'STRING', 'STRUCTURE', 'DCOMPLEX'] thisType = dataTypes(typeIndex) RETURN, thisType END ; ********************** of WhatTypeVar ********************************* Pro GWindow_Clean_Up, tlb ; Called if top-level base dies. Want to free up pointer space. Widget_Control, tlb, Get_UValue=info IF N_Elements(info) NE 0 THEN BEGIN IF Handle_Info(info.ptr, /Valid) THEN Handle_Free, info.ptr ENDIF END ;******************************************************************* Pro Mapper_Event, event ; Event here just means map and unmap control button base, ; which is stored in the info stucture of the TLB. Widget_Control, event.top, Get_UValue=info ; Get info structure buttontype = What_Button_Type(event) IF buttontype EQ 'DOWN' THEN BEGIN ; Switch controlmap flag IF info.controlmap EQ 0 THEN BEGIN Widget_Control, info.controlbase, Map=1, Sensitive=1 info.controlmap = 1 ENDIF ELSE BEGIN Widget_Control, info.controlbase, Map=0 info.controlmap = 0 ENDELSE ENDIF Widget_Control, event.top, Set_UValue=info ; Put info structure back. END ;******************************************************************* Pro Control_Event, event ; This is the event handler for the pop-up control panel in the ; graphics window. Widget_Control, event.top, Get_UValue=info ; Get info structure Handle_Value, info.ptr, object, /No_Copy ; Get object from pointer ; Catch errors here. Catch, error IF error NE 0 THEN BEGIN ; Put object structure back in the pointer location, report the error to ; the user, and RETURN. Widget_Control, event.top, Set_UValue=info Handle_Value, info.ptr, object, /Set, /No_Copy ok = Widget_Message(!Err_String) RETURN ENDIF Widget_Control, event.id, Get_Value=test ; Which button was pressed? CASE test OF 'Close Window': BEGIN Handle_Free, info.ptr ; Free the pointer and its data Widget_Control, event.top, /Destroy ; Destroy the widget END 'PostScript Output': BEGIN ; Get current offsets of this window. Pass them to PS_Form Widget_Control, event.top, TLB_Get_Offset=offsets ; Have we already called PS_FORM and stored the return value in psPointer? check = Handle_Info(info.psPointer) IF check EQ 0 THEN BEGIN ; Call PS_FORM to collect information about configuing the PostScipt device. ; Store info when you get it back in pointer location. fileInfo = PS_Form(offsets(0)+75, offsets(1)+50, Cancel=cancelButton, /Inches) info.psPointer = Handle_Create(Value=fileInfo) ENDIF ELSE BEGIN ; Get the old fileInfo and pass it in as the starting point defaults. Handle_Value, info.psPointer, fileInfo varType = WhatTypeVar(fileInfo) IF varType EQ 'STRUCTURE' THEN $ fileInfo = PS_Form(offsets(0)+75, offsets(1)+50, Cancel=cancelButton, $ Defaults=fileInfo) ELSE $ fileInfo = PS_Form(offsets(0)+75, offsets(1)+50, Cancel=cancelButton, /Inches) Handle_Value, info.psPointer, fileInfo, /Set ENDELSE ; Check the cancelButton flag to see if the user canceled out of the form. ; If CANCEL button was selected, put the object back into the top-level base. IF cancelButton EQ 1 THEN GoTo, stuff_object ; OK, the user clicked the ACCEPT button. ; Get the current graphics device so you can reset it later oldgraphicdevice = !D.Name ; Change the graphics device to PostScript Set_Plot, 'PS' ; Configure the PostScript device with the information obtained from the form Device, _Extra=fileInfo ; Does this graphics object have an "extra" field? names = Tag_Names(object) ; Get the field names of the structure testextra = Where (names EQ 'EXTRA', count) ; Test for an "EXTRA" field. testextra = count ; Is this data image data? testimage = object.image ; 0 if NOT image data, 1 if image data ; How may data parameters in this graphics object? testnp = object.np CASE testnp OF 1: BEGIN IF testextra EQ 1 AND testimage EQ 1 THEN $ Call_Procedure, object.cmd, object.data1, _Extra=object.extra, $ XSize=fileInfo.xsize, YSize=fileInfo.ysize, Inches=fileInfo.inches IF testextra EQ 0 AND testimage EQ 1 THEN $ Call_Procedure, object.cmd, object.data1, $ XSize=fileInfo.xsize, YSize=fileInfo.ysize, Inches=fileInfo.inches IF testextra EQ 0 AND testimage EQ 0 THEN $ Call_Procedure, object.cmd, object.data1 IF testextra EQ 1 AND testimage EQ 0 THEN $ Call_Procedure, object.cmd, object.data1, _Extra=object.extra END 2: BEGIN IF testextra EQ 1 THEN $ Call_Procedure, object.cmd, object.data1, object.data2, _Extra=object.extra ELSE $ Call_Procedure, object.cmd, object.data1, object.data2 END 3: BEGIN IF testextra EQ 1 THEN $ Call_Procedure, object.cmd, object.data1, object.data2, object.data3, _Extra=object.extra ELSE $ Call_Procedure, object.cmd, object.data1, object.data2, object.data3 END ENDCASE ; Close the PostScript file Device, /Close ; Set the graphics device back to the old graphics device Set_Plot, oldgraphicdevice END 'Change Colors': BEGIN Widget_Control, event.top, TLB_Get_Offset=tlbOffsets XColors, NColors=object.ncolors, Bottom=object.bottom, $ Title=object.wtitle + ' Colors', Group=object.draw, $ XOffSet=tlbOffsets(0)+50, YOffset=tlbOffsets(1)+75 END ENDCASE ; Unmap the buttons ; Put the info structure back into to the top-level base ; Put the graphics object back into the pointer location Stuff_Object: IF Widget_Info(event.top, /Valid) THEN BEGIN Widget_Control, info.controlbase, Map=0 info.controlmap = 0 Widget_Control, event.top, Set_UValue=info ; Put info structure back. Handle_Value, info.ptr, object, /Set, /No_Copy ENDIF END ;******************************************************************* Pro GWindow_Event, event ; This is the main event handler for GWINDOW. It's only purpose ; is to respond to resize events. All other possible events are ; dispatched to other event handlers. Widget_Control, event.top, Get_UValue=info ; Get info structure Handle_Value, info.ptr, object, /No_Copy ; Get object from pointer ; Resize the draw widget fill up the new window ; The keywords will be DRAW_XSIZE and DRAW_YSIZE in IDL 4.0 Widget_Control, object.draw, XSize=event.x, YSize=event.y ; Make the draw widget the current graphics window, after saving the current window id oldwindow = !D.Window WSet, object.wid ; Does this object have an "extra" field? names = Tag_Names(object) ; Get the fields in this structure testextra = Where (names EQ 'EXTRA', count) ; Is there an EXTRA field? testextra = count ; Is this data image data? testimage = object.image ; 0 if NOT image data, 1 if image data ; How may data parameters in this graphics object? testnp = object.np CASE testnp OF 1: BEGIN IF testextra EQ 1 AND testimage EQ 1 THEN $ Call_Procedure, object.cmd, Congrid(object.data1, event.x, event.y), _Extra=object.extra IF testextra EQ 0 AND testimage EQ 1 THEN $ Call_Procedure, object.cmd, Congrid(object.data1, event.x, event.y) IF testextra EQ 0 AND testimage EQ 0 THEN $ Call_Procedure, object.cmd, object.data1 IF testextra EQ 1 AND testimage EQ 0 THEN $ Call_Procedure, object.cmd, object.data1, _Extra=object.extra END 2: BEGIN IF testextra EQ 1 THEN $ Call_Procedure, object.cmd, object.data1, object.data2, $ _Extra=object.extra ELSE $ Call_Procedure, object.cmd, object.data1, object.data2 END 3: BEGIN IF testextra EQ 1 THEN $ Call_Procedure, object.cmd, object.data1, object.data2, $ object.data3, _Extra=object.extra ELSE $ Call_Procedure, object.cmd, object.data1, object.data2, object.data3 END ENDCASE WSet, oldwindow ; Restore current graphics window Handle_Value, info.ptr, object, /Set, /No_Copy ; Put object back in pointer END ;******************************************************************* Pro GWindow, command, data1, data2, data3, _Extra=extra, WTitle=wtitle, $ WXSize=wxsize, WYSize=wysize, Pointer=ptr, Group=group, Help=help, $ NColors=ncolors, Bottom=bottom, NoColorButton=noColorButton IF Keyword_Set(help) THEN BEGIN Print, '' Print, 'CALLING SEQUENCE' Print, '' Print, " GWindow, 'graphics_command', data1, data2, data3" Print, '' Print, 'PARAMETERS:' Print, '' Print, ' graphics_command -- The graphics procedure you wish to implement. For example, ' Print, ' Surface, Contour, etc. The procedure is always passed as a STRING. ' Print, ' You may call a user-written procedure if it is defined with an _Extra ' Print, ' keyword and has no more than three positional parameters. (You may use ' Print, ' an unlimited number of keywords in user-written procedures.)' Print, '' Print, ' data1 -- The first data parameter (required)' Print, '' Print, ' data2 -- The second data parameter (optional)' Print, '' Print, ' data3 -- The third data parameter (optional)' Print, '' Print, 'KEYWORDS:' Print, '' Print, ' Bottom -- The starting color index where the window colors should be loaded. Print, '' Print, ' _Extra -- A structure that holds "extra keywords" associated with the graphics command' Print, '' Print, ' Group -- The group leader of the graphics window' Print, '' Print, ' Pointer -- An output keyword that will return the pointer to ' Print, ' the "graphics object" stored in the window' Print, '' Print, ' NColors -- The number of color indices associated with the window. Print, '' Print,' NoColorButton -- Set this keyword if you would NOT like to have a Print,' "Change Colors" button. Print, '' Print, ' WTitle -- The title of the graphics window' Print, '' Print, ' WXSize -- The XSize of the graphics window. Default: 300' Print, '' Print, ' WYSize -- The YSize of the graphics window. Default: 300' Print, '' Print, 'INFORMATION:' Print, '' Print, ' The window created by GWindow is completely resizeable. If it is resized it will Print, ' re-display whatever is currently in the window. It stores its "window information" Print, ' in a "graphics object" that is attached to the window. Print, '' Print, ' The window has pop-up controls (click in the window to activate them)' Print, ' to send the window output to a PostScript file and to close the window.' Print, ' If you select the PostScript Output button, the function PS_FORM is ' Print, ' called to allow you to configure the PostScript device graphically. ' Print, '' Print, 'RESTRICTIONS: ' Print, '' Print, ' The function PS_FORM and the procedure XCOLORS are required. Print, '' Print, 'EXAMPLE:' Print, '' Print, ' GWindow, "Surface", Dist(20, 30), CharSize=1.5, WXSize=300, WYSize=250 ' Print, '' ; Return from the Help information RETURN ENDIF ; Define default values for keywords IF N_Elements(wxsize) EQ 0 THEN wxsize = 300 IF N_Elements(wysize) EQ 0 THEN wysize = 300 IF N_Elements(ncolors) EQ 0 THEN ncolors = !D.N_Colors IF N_Elements(bottom) EQ 0 THEN bottom = 0 ; Were extra keywords passed into GWindow? extratest = N_Elements(extra) On_Error, 1 ; Return to main IDL level if there is an error ; Check for number of positional parameters np = N_Params() ; Must have at least two parameters IF np LT 2 THEN Message,'Incorrect number of arguments: Two parameters required.' ; Check first parameter to be sure it's string command. ; If it is, make it UPPERCASE string. cmdsize = Size(command) IF cmdsize(0) NE 0 AND cmdsize(2) NE 7 THEN $ Message, 'First parameter must be a command string.' ELSE $ command = StrUpCase(command) ; Create a title for the window if one is not already defined IF N_Elements(wtitle) EQ 0 THEN wtitle = 'Resizeable ' + command + ' Window' ; Do some error checking for some of the common graphics commands. CASE command OF 'PLOT': BEGIN IF np EQ 2 THEN BEGIN ; Construct the graphics command gcommand = 'Plot, data1, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, image:0, np:1, draw:0L, wid:0L, $ ncolors:ncolors, bottom:bottom, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, image:0, np:1, extra:extra, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ENDIF IF np EQ 3 THEN BEGIN IF N_Elements(data1) NE N_Elements(data2) THEN $ Message, 'Data parameters in the PLOT command must be the same size.' ; Construct the graphics command gcommand = 'Plot, data1, data2, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, data2:data2, image:0, np:2, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, data2:data2, image:0, np:2, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, extra:extra, wtitle:wtitle} ENDIF IF np EQ 4 THEN Message, 'Too many data parameters for PLOT command' END 'SURFACE': BEGIN IF np EQ 2 THEN BEGIN ; Construct the graphics command gcommand = 'Surface, data1, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, image:0, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, image:0, np:1, $ ncolors:ncolors, bottom:bottom, extra:extra, draw:0L, wid:0L, wtitle:wtitle} ENDIF IF np EQ 3 THEN Message, 'Wrong number of data parameters for SURFACE command' IF np EQ 4 THEN BEGIN ; Be sure data2 and data3 correspond to size of data1 datasize = Size(data1) IF datasize(0) NE 2 THEN Message, 'First data parameter for SURFACE not 2D' IF N_Elements(data2) NE datasize(1) OR N_Elements(data3) NE datasize(2) THEN $ Message, 'Optional data parameters in the SURFACE command must correspond to 2D data size.' gcommand = 'Surface, data1, data2, data3, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, data2:data2, data3:data3, image:0, np:3, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, data2:data2, data3:data3, image:0, np:3, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, extra:extra, wtitle:wtitle} ENDIF END 'CONTOUR': BEGIN IF np EQ 2 THEN BEGIN ; Construct the graphics command gcommand = 'Contour, data1, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, image:0, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, image:0, np:1, $ ncolors:ncolors, bottom:bottom, extra:extra, draw:0L, wid:0L, wtitle:wtitle} ENDIF IF np EQ 3 THEN Message, 'Wrong number of data parameters for CONTOUR command' IF np EQ 4 THEN BEGIN ; Be sure data2 and data3 correspond to size of data1 datasize = Size(data1) IF datasize(0) NE 2 THEN Message, 'First data parameter for CONTOUR not 2D' IF N_Elements(data2) NE datasize(1) OR N_Elements(data3) NE datasize(2) THEN $ Message, 'Optional data parameters in the CONTOUR command must correspond to 2D data size.' gcommand = 'Contour, data1, data2, data3, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, data2:data2, data3:data3, image:0, np:3, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, data2:data2, data3:data3, image:0, np:3, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, extra:extra, wtitle:wtitle} ENDIF END 'TV': BEGIN ; Get some information about the image imgsize = Size(data1) IF imgsize(0) NE 2 THEN Message, 'Data must be 2D' IF np EQ 2 THEN BEGIN ; Construct the graphics command gcommand = 'TV, data1, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, image:1, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, image:1, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, extra:extra, wtitle:wtitle} ENDIF ; Although the TV command can take 3 positional parameters, only one ; is allowed in GWindow. IF np GT 2 THEN Message, 'Too many data parameters for the TV command in GWindow' END 'TVSCL': BEGIN ; Get some information about the image imgsize = Size(data1) IF imgsize(0) NE 2 THEN Message, 'Data must be 2D' IF np EQ 2 THEN BEGIN ; Construct the graphics command gcommand = 'TVSCL, data1, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, image:1, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, image:1, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, extra:extra, wtitle:wtitle} ENDIF ; Although the TVSCL command can take 3 positional parameters, only one ; is allowed in GWindow. IF np GT 2 THEN Message, 'Too many data parameters for the TVSCL command in GWindow' END ELSE: BEGIN ; If the command is not one of these commands, the user is on his or her ; own to be sure that the data is appropriate for the command used. There ; are a maximun of three data parameters allowed. All user routines must be ; written to accept an _Extra keyword, whether it is used or not. CASE np OF 1: Message, 'Wrong number of data parameters. At least two parameters required.' 2: BEGIN ; Construct graphics command gcommand = command + ', data1, _Extra=extra' ; Construct graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, image:0, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, image:0, np:1, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, extra:extra, wtitle:wtitle} END 3: BEGIN ; Construct graphics command gcommand = command + ', data1, data2, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, data2:data2, image:0, np:2, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, data2:data2, image:0, np:2, $ ncolors:ncolors, bottom:bottom, draw:0L, wid:0L, extra:extra, wtitle:wtitle} END 4: BEGIN ; Construct graphics command gcommand = command + ', data1, data2, data3, _Extra=extra' ; Construct the graphics object IF extratest EQ 0 THEN $ object = {cmd:command, data1:data1, data2:data2, data3:data3, $ ncolors:ncolors, bottom:bottom, image:0, np:3, draw:0L, wid:0L, wtitle:wtitle} ELSE $ object = {cmd:command, data1:data1, data2:data2, data3:data3, $ ncolors:ncolors, bottom:bottom, image:0, np:3, draw:0L, wid:0L, extra:extra, wtitle:wtitle} END ENDCASE END ; Of ELSE Statement ENDCASE ; Top-level base is resizable and is bulletin board tlb = Widget_Base(Title=wtitle, TLB_Size_Event=1) ; Create a "Control Panel" that will pop up ; if graphics window is clicked in. controlbase = Widget_Base(tlb, Column=1, Map=0, Event_Pro='Control_Event') ps = Widget_Button(controlbase, Value='PostScript Output') IF NOT Keyword_Set(noColorButton) THEN colors = Widget_Button(controlbase, Value='Change Colors') quitter = Widget_Button(controlbase, Value='Close Window') drawbase = Widget_Base(tlb, Row=1, Map=1) ; Draw widget will have its own event handler to map ; and unmap control button. Store controlbase in UValue of ; draw widget. draw = Widget_Draw(drawbase, XSize=wxsize, YSize=wysize, $ Event_Pro='Mapper_Event', UValue=controlbase, Button_Events=1) Widget_Control, tlb, /Realize Widget_Control, draw, Get_Value=wid WSet, wid ; Fill out correct fields in the graphics object object.draw = draw object.wid = wid ; Store the graphics object in a pointer ptr = Handle_Create(Value=object) info = {ptr:ptr, controlbase:controlbase, controlmap:0, psPointer:-1} ; Put the info structure in the top-level base Widget_Control, tlb, Set_UValue=info ; Execute the graphics command you built previously. dummy = Execute(gcommand) XManager, 'GWindow', tlb, Group=group, Event_Handler='GWindow_Event', Cleanup = 'GWindow_Clean_Up' END ; ******************* END of GWindow Code ************************************************************* Pro UserPlot, x, y, _Extra=extra ; Example of a user written procedure to be used with GWindow ; Colors 200-211 are loaded with drawing colors from GetColor. ; Draw the axes in one color. Plot, Sin(x * !DtoR), _Extra=extra, Linestyle=1, Position=[0.15, 0.3, 0.9, 0.9], $ /NoData, Color=204, Background=211 ; Overplot the data in two other colors. OPlot, Sin(x * !DtoR), Linestyle=1, Color=205, Thick=3 OPlot, Cos(y * !DtoR), Linestyle=2, Color=209, Thick=3 ; Draw a legend for the plot. XYOuts, 0.62, 0.18, /Normal, 'Sine Plot', Color=207, Size=1.5 XYouts, 0.62, 0.08, /normal, 'Cosine Plot', Color=207, Size=1.5 Plots, [0.2, 0.6], [0.2, 0.2], /Normal, Linestyle=1, Color=205, Thick=3 Plots, [0.2, 0.6], [0.1, 0.1], /Normal, Linestyle=2, Color=209, Thick=3 END ; of USERPLOT code ************************************************************************** PRO ShowColors ; BLACK WHITE RED ORANGE YELLOW GREEN TURQUOISE LIGHTBLUE BLUE PINK PURPLE CHARCOAL red = [ 0B, 255B, 255B, 255B, 255B, 0B, 0B, 0B, 0B, 255B, 80B, 70B ] green = [ 0B, 255B, 0B, 100B, 255B, 255B, 255B, 200B, 0B, 168B, 50B, 70B ] blue = [ 0B, 255B, 0B, 0B, 0B, 0B, 200B, 255B, 255B, 182B, 150B, 70B ] drawColors = ['BLACK', 'WHITE', 'RED', 'ORANGE', 'YELLOW', 'GREEN', 'TURQUOISE', $ 'LIGHTBLUE', 'BLUE', 'PINK', 'PURPLE', 'CHARCOAL'] TVLCT, red, green, blue, 201 ; Display the colors in a window on the display Window, /Free, YSize=30, XSize=60*12 FOR j=0,11 DO TV, Replicate(201 + j, 60, 30), j*60, 0 FOR j=0,11 DO BEGIN y = 10 x = 30 + (j*60) IF j EQ 0 OR j EQ 2 OR j EQ 8 OR j EQ 10 OR j EQ 11 THEN $ XYOuts, x, y, /Device, drawColors(j), Align=0.5, Color=202 ELSE $ XYOuts, x, y, /Device, drawColors(j), Align=0.5, Color=201 ENDFOR END ; ********************* of ShowColors ***************************************************** Function Color24, number ; This FUNCTION accepts a [red, green, blue] triple that ; describes a particular color and returns a 24-bit long ; integer that is equivalent to that color. The color is ; described in terms of a hexidecimal number (e.g., FF206A) ; where the left two digits represent the blue color, the ; middle two digits represent the green color, and the right ; two digits represent the red color. ; ; The triple can be either a row or column vector of 3 elements. On_Error, 1 IF N_Elements(number) NE 3 THEN $ Message, 'Augument must be a three-element vector.' IF Max(number) GT 255 OR Min(number) LT 0 THEN $ Message, 'Argument values must be in range of 0-255' base16 = [[1L, 16L], [256L, 4096L], [65536L, 1048576L]] num24bit = 0L FOR j=0,2 DO num24bit = num24bit + ((number(j) MOD 16) * base16(0,j)) + $ (Fix(number(j)/16) * base16(1,j)) RETURN, num24bit END ; ****************************** of Color24 *********************************** Function GetColor, color, All=all, True=need24bit, Show=show ;+ ; The GetColor function returns the (x,y,z) triple that describes ; a particular color. The following 12 colors are available: ; ; Color Name Red Green Blue ; ---------- --- ----- ---- ; BLACK 0 0 0 ; WHITE 255 255 255 ; RED 255 0 0 ; ORANGE 255 100 0 ; YELLOW 255 255 0 ; GREEN 0 255 0 ; TURQUOISE 0 255 200 ; LIGHTBLUE 0 200 255 ; BLUE 0 0 255 ; PINK 255 168 182 ; PURPLE 78 0 182 ; CHARCOAL 70 70 70 ; ; The ALL keyword returns all 12 colors in a named (12,3) variable. ; ; The TRUE keyword returns a 24-bit LONG integer that ; is the 24-bit equivalent of the (r,g,b) triple. If the ALL ; keyword is used in conjuction with this keyword, the ALL ; keyword returns a 12 element LONG vector. ; ; The SHOW keyword puts up a window with the colors display in it. ; The colors are loaded into indices 201-213. ; ; USAGE: ; ; To load a yellow color at color index 12: ; ; yellow = GetColor('yellow') ; TVLct, yellow, 12 ; ; To load all 12 colors starting a color index 120: ; ; dummy = GetColor(All=drawColors) ; TVLct, drawColors, 120 ; ; To draw in a yellow color on a 24-bit system: ; ; yellow = GetColor('yellow', /True) ; Plot, Findgen(11), Color=yellow ;- ; Error handling. Return to main-level. On_Error, 1 ; Set up colors and indices. drawColors = ['BLACK', 'WHITE', 'RED', 'ORANGE', 'YELLOW', 'GREEN', 'TURQUOISE', 'LIGHTBLUE', 'BLUE', 'PINK', 'PURPLE', 'CHARCOAL'] red = [ 0B, 255B, 255B, 255B, 255B, 0B, 0B, 0B, 0B, 255B, 78B, 70B ] green = [ 0B, 255B, 0B, 100B, 255B, 255B, 255B, 200B, 0B, 168B, 0B, 70B ] blue = [ 0B, 255B, 0B, 0B, 0B, 0B, 200B, 255B, 255B, 182B, 182B, 70B ] ; If no color parameter is specified, return a green color. IF N_Params() EQ 0 THEN BEGIN returnColor = Reform([red(5), green(5), blue(5)], 1, 3) IF Keyword_Set(need24bit) THEN returnColor = Color24(returnColor) IF Keyword_Set(show) THEN ShowColors ; The user may want all 12 colors. Indicated by using the ALL keyword. IF Keyword_Set(need24bit) THEN BEGIN all = LonArr(12) FOR j=0,11 DO all(j) = Color24([red(j), green(j), blue(j)]) ENDIF ELSE BEGIN all = BytArr(12,3) all(*,0) = red all(*,1) = green all(*,2) = blue ENDELSE RETURN, returnColor ENDIF ; If the parameter is not a string variable this is an error. paramType = WhatTypeVar(color) IF paramType NE 'STRING' THEN Message,'Augument must be STRING type.' ; Get color name in UPPERCASE characters. strColor = StrUpCase(color) ; Can you find this name in drawColors array? If not, use GREEN. colorIndex = Where(drawColors EQ strColor, count) IF count EQ 0 THEN BEGIN messageText = "Can't find color " + '"' + color + '"' + " in color list." ok = Widget_Message([messageText,"Returning a GREEN color."]) colorIndex = 5 ENDIF ; The user may want all 12 colors. Indicated by using the ALL keyword. IF Keyword_Set(need24bit) THEN BEGIN all = LonArr(12) FOR j=0,11 DO all(j) = Color24([red(j), green(j), blue(j)]) ENDIF ELSE BEGIN all = BytArr(12,3) all(*,0) = red all(*,1) = green all(*,2) = blue ENDELSE ; OK, return the color triple corresponding to this color. ; Return a [1,3] array so we can send it directly to TvLct. returnColor = Reform([red(colorIndex), green(colorIndex), blue(colorIndex)], 1, 3) ; Get a True value if one is required. IF Keyword_Set(need24bit) THEN returnColor = Color24(returnColor) RETURN, returnColor END ; of GETCOLOR code ************************************************************* Function MakePeak, size IF (N_Elements(size) EQ 0) THEN size=40 peak = Shift(Dist(size),size/2+5, size/2-5) peak = Exp(-(peak/15)^2) RETURN, peak END ; of MAKEPEAK code ************************************************************* PRO Example_Event, event ; Get the data out of the TLB Widget_Control, event.top, Get_UValue=info, /No_Copy ; What button was clicked? Widget_Control, event.id, Get_Value=buttonValue CASE buttonValue OF 'Surface Plot': BEGIN peak = Makepeak() GWindow, 'Surface', peak, charsize=1.5, Group=event.top, Color=205, $ Background=211, Shades=BytScl(peak, Top=49)+150, NColors=50, Bottom=150 END 'Contour Plot': BEGIN GWindow, 'Contour', MakePeak(), Group=event.top, Title='Contour Plot', $ NLevels=15, CharSize=1.5, /Follow, Color=204, Background=200, $ Position=[0.15, 0.15, 0.95, 0.85], /NoColorButton END 'Line Plot': BEGIN GWindow, 'Plot', Findgen(101)*6/100., info.curve, Group=event.top, $ Title='!17Transformer Signal!X', XTitle='Seconds', Color=209, $ Background=211, /NoColorButton, Charsize=1.5, WXSize=350, WYSize=200, $ Position=[0.15, 0.25, 0.95, 0.80] END 'Galaxy Image': BEGIN GWindow, 'TV', info.image1, Group=event.top, $ WTitle='Galaxy Image', WXSize=256, WYSize=256, NColors=75, Bottom=0 END 'World Image': BEGIN GWindow, 'TV', info.image2, Group=event.top, $ WTitle='World Image', WXSize=360, WYSize=360, NColors=75, Bottom=75 END 'Shaded Surface Plot': BEGIN Set_Shading, Values=[150,199] GWindow, 'Shade_Surf', MakePeak(), charsize=1.5, Group=event.top, $ NColors=50, Bottom=150, WTitle='Shaded Surface Plot' END 'User Written Plot': BEGIN GWindow, 'UserPlot', Findgen(101), Findgen(101), $ WTitle='User Written Plot', Group=event.top, /NoColorButton END 'Quit': BEGIN Set_Shading, Values=[0,!D.N_Colors-1] Widget_Control, event.top, /Destroy END ENDCASE ; Put the info structure back in the TLB IF Widget_Info(event.top, /Valid) THEN $ Widget_Control, event.top, Set_UValue=info, /No_Copy END PRO EXAMPLE ; This is an example program that exercises GWINDOW in various ways. ; Colors 0-74 are reserved for the Galaxy image. Colors 75-149 are ; reserved for the World Elevation image. Colors 150-199 are reserved ; for shaded surfaces. Colors 200-211 are drawing colors (obtained by ; using the GetColor program). ; Make a series of buttons. Each button has an event handler that calls ; GWINDOW in different ways. base = Widget_Base(Column=1, Title='Exercise GWINDOW') surf = Widget_Button(base, Value='Surface Plot') cont = Widget_Button(base, Value='Contour Plot') line = Widget_Button(base, Value='Line Plot') shade = Widget_Button(base, Value='Shaded Surface Plot') image1 = Widget_Button(base, Value='Galaxy Image') image2 = Widget_Button(base, Value='World Image') user = Widget_Button(base, Value='User Written Plot') quitter = Widget_Button(base, Value='Quit') ; Create some data for the plots curve = findgen(101) curve = Sin(curve/5)/Exp(curve/50) ; Read the galaxy data. openr, lun, /get, Filepath(Root_Dir=!Dir, Subdir=['examples', 'data'], 'galaxy.dat') image1 = bytarr(256,256) readu, lun, image1 image1 = BytScl(image1, Top=74) free_lun, lun ; Read the world elevation data. openr, lun, /get, Filepath(Root_Dir=!Dir, Subdir=['examples', 'data'], 'worldelv.dat') image2 = bytarr(360,360) readu, lun, image2 image2 = BytScl(image2, Top=74) + 75B free_lun, lun ; Load colors in the color table. Loadct, 13, NColors=75, Bottom=0 ; Colors for galaxy data. Loadct, 35, NColors=75, Bottom=75 ; Colors for world elevation data. Loadct, 5, Ncolors=50, Bottom=150 ; Colors for shaded surface. ; Use colors 200-211 for drawing colors color = GetColor(All=allcolors) TvLct, allcolors, 200 ; Store the info structure in the User Value of the TLB info = {curve:curve, image1:image1, image2:image2} Widget_Control, base, Set_UValue=info, /No_Copy Widget_Control, base, /Realize XManager, 'Example', base, Event_Handler='Example_Event' END