;+ ; ; @hidden ; ;- ; PRO xlct_psave ;Save/Restore our plotting state. ; Swaps our state with the current state each time its called. ; compile_opt idl2, strictarrsubs ; COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $ top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $ gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $ updt_callback, updt_cb_data tmp = { xlct_psave, win: !d.window, x: !x.s, y: !y.s , xtype: !x.type, $ ytype: !y.type, clip: !p.clip } wset, psave.win !x.type = psave.xtype !y.type = psave.ytype !x.s = psave.x !y.s = psave.y !p.clip = psave.clip psave = tmp end ;+ ; @hidden ;- pro xlct_alert_caller ; compile_opt idl2, strictarrsubs ; COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $ top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $ gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $ updt_callback, p_updt_cb_data ErrorStatus = 0 CATCH, ErrorStatus if (ErrorStatus NE 0) then begin CATCH, /CANCEL v = DIALOG_MESSAGE(['Unexpected error in XLCT:', $ '!ERR_STRING = ' + !ERR_STRING], $ /ERROR) return endif if (STRLEN(updt_callback) gt 0) then begin if (PTR_VALID(p_updt_cb_data)) then begin CALL_PROCEDURE, updt_callback, DATA=*(p_updt_cb_data) endif else begin CALL_PROCEDURE, updt_callback endelse endif end ; Redraw the ramp image. ;+ ; @hidden ;- PRO xlct_show ; compile_opt idl2, strictarrsubs ; COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $ top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $ gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $ updt_callback, p_updt_cb_data cur_win = !D.WINDOW WSET, show_win TV, BYTE((FLOAT(ncolors)*FINDGEN(siz)/FLOAT(siz-1)) # $ REPLICATE(1, w_height)) + BYTE(cbot) WSET, cur_win ; Let the caller of XLCT know that the color table was modified xlct_alert_caller END ;+ ; @hidden ; @param i ; ??? ; @param c ; ??? ;- PRO xlct_draw_cps, i, c ; compile_opt idl2, strictarrsubs ; COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $ top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $ gamma, color, use_values, ncolors, cbot tc = color if n_elements(c) gt 0 then begin tc = c if c ne 0 then color = c endif if i[0] eq -1 then j = indgen(n_elements(cps)) else j = i plots, cps[j], tfun[j], /noclip, color = tc plots, cps[j], tfun[j], /noclip, psym=6, color = tc end ;+ ; @hidden ; @keyword UPDATE ; ??? ;- PRO xlct_transfer, UPDATE=update ; compile_opt idl2, strictarrsubs ; COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $ top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $ gamma, color, use_values, ncolors, cbot l = lonarr(ncolors) ;Subscripts m = n_elements(cps) for i=0, m-2 do begin n = cps[i+1]-cps[i] ;Interval b = (tfun[i+1]-tfun[i])/float(n) l[cps[i]] = findgen(n) * b + (tfun[i] + cbot) endfor l[ncolors-1] = tfun[m-1] ;Last point if use_values then begin r_curr[cbot] = (r = l[r_orig]) g_curr[cbot] = (g = l[g_orig]) b_curr[cbot] = (b = l[b_orig]) endif else begin r_curr[cbot] = (r = r_orig[l]) g_curr[cbot] = (g = g_orig[l]) b_curr[cbot] = (b = b_orig[l]) endelse tvlct, r,g,b, cbot if (keyword_set( update )) then $ xlct_show end ;+ ; @hidden ; @param event ; ??? ;- PRO xlct_event, event ; compile_opt idl2, strictarrsubs ; COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $ top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $ gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $ updt_callback, p_updt_cb_data IF event.id eq state.draw THEN BEGIN ;** PROCESS DRAWABLE EVENTS ** if event.press ne 0 then begin ;Pressed button? dmin = 1.0e8 ;Find closest control pnt xlct_psave ;Remove old p = convert_coord(event.x, event.y, /TO_DATA, /DEVICE) xlct_psave ;Restore old x = fix(p[0]) y = fix(p[1]) for i=0, n_elements(cps)-1 do begin d = (p[0]-cps[i])^2 + (p[1]-tfun[i])^2 ; dist ^ 2 if d lt dmin then begin dmin = d pnt = i endif endfor return endif if event.release ne 0 then begin ;Released button? pnt = -1 xlct_transfer, /update return endif if pnt lt 0 then return ;Don't care here... xlct_psave ;Remove old ; For visuals with static colormaps, erase plot before drawing new if ((COLORMAP_APPLICABLE(redrawRequired) GT 0) and $ (redrawRequired GT 0)) then begin ERASE, color=0 endif p = convert_coord(event.x, event.y, /TO_DATA, /DEVICE) ;Coord of mouse n = ncolors -1 ;Into range.... m = n_elements(cps)-1 x = fix(p[0]) > 0 < n if pnt eq 0 then x = 0 else $ ;1st & last are fixed if pnt eq m then x = n else $ x = x > (cps[pnt-1] + 1) < (cps[pnt+1]-1) ;Others must be between if pnt eq 0 then xlct_draw_cps, [0, 1],0 $ ;Erase old segment else if pnt eq m then xlct_draw_cps, [m-1, m],0 $ else xlct_draw_cps, [pnt-1, pnt, pnt+1],0 cps[pnt] = x tfun[pnt] = fix(p[1]) > 0 < n xlct_transfer b = r_curr * .3 + g_curr * .586 + b_curr * .114 ;Ntsc colors c = max(abs(b-b[cbot]), j) ; *** J is color index furthest from 0 if pnt eq 0 then xlct_draw_cps, [0, 1], j $ else if pnt eq m then xlct_draw_cps, [m-1, m], j $ else xlct_draw_cps, [pnt-1, pnt, pnt+1], j xlct_psave ;Remove old return ENDIF WIDGET_CONTROL, event.id, GET_UVALUE = eventval abstop = NCOLORS -1 if event.id eq state.name_list then begin LOADCT, silent=silent, event.index, FILE=filename, NCOLORS=ncolors, $ BOTTOM=cbot goto, set_gamma ENDIF CASE eventval OF "TOP": BEGIN WIDGET_CONTROL, top, GET_VALUE = vtop if lock ne 0 then begin vbot = (vtop - lock) > 0 < 100 widget_control, bot, SET_VALUE=vbot endif GOTO, set_gamma END "BOTTOM": BEGIN WIDGET_CONTROL, bot, GET_value = vbot if lock ne 0 then begin vtop = (vbot + lock) > 0 < 100 widget_control, top, SET_VALUE=vtop ENDIF set_gamma: if use_values then nc = 256 else nc = ncolors s = (nc-1)/100. x0 = vbot * s x1 = vtop * s if x0 ne x1 then s = (nc-1.0)/(x1 - x0) else s = 1.0 int = -s * x0 if gamma eq 1.0 then s = round(findgen(nc) * s + int > 0.0) $ else s = ((findgen(nc) * (s/nc) + (int/nc) > 0.0) ^ gamma) * nc if chop ne 0 then begin too_high = where(s ge nc, n) if n gt 0 then s[too_high] = 0L endif if use_values then begin s = s < 255L l = lindgen(ncolors) + cbot r_curr[cbot] = (r = s[r_orig[l]]) g_curr[cbot] = (g = s[g_orig[l]]) b_curr[cbot] = (b = s[b_orig[l]]) endif else begin s = s + cbot r_curr[cbot] = (r = r_orig[s]) g_curr[cbot] = (g = g_orig[s]) b_curr[cbot] = (b = b_orig[s]) endelse tvlct, r,g,b, cbot xlct_show ENDCASE "GAMMA": BEGIN WIDGET_CONTROL, g_slider, GET_VALUE = gamma gamma = 10^((gamma/50.) - 1) WIDGET_CONTROL, g_lbl, SET_VALUE = $ STRING(gamma, format='(f6.3)') goto, set_gamma ENDCASE "GANG" : IF event.value eq 0 then lock = 0 else lock = vtop - vbot "CHOP" : BEGIN chop = event.value goto, set_gamma ;And redraw ENDCASE "VALUES": BEGIN use_values = event.value ENDCASE "HELP" : XDisplayFile, FILEPATH("xlct.txt", subdir=['help', 'widget']), $ TITLE = "Xlct Help", $ GROUP = event.top, $ WIDTH = 55, $ HEIGHT = 16 "RESTORE" : BEGIN ;Restore the original tables r_curr = (r_orig = r0) g_curr = (g_orig = g0) b_curr = (b_orig = b0) tvlct, r_curr, g_curr, b_curr xlct_show ENDCASE "OVERWRITE" : BEGIN ;overwrite original tables r0 = (r_orig = r_curr) g0 = (g_orig = g_curr) b0 = (b_orig = b_curr) reset_all: WIDGET_CONTROL, top, SET_VALUE = 100 WIDGET_CONTROL, bot, SET_VALUE = 0 WIDGET_CONTROL, g_slider, SET_VALUE = 50 vbot = 0 vtop = 100 gamma = 1.0 GOTO, set_gamma ENDCASE "REVERSE" : BEGIN ;Reverse the table l = lindgen(ncolors) + cbot r_orig[cbot] = reverse(r_orig[l]) g_orig[cbot] = reverse(g_orig[l]) b_orig[cbot] = reverse(b_orig[l]) goto, set_gamma ;And redraw ENDCASE "DONE": BEGIN WIDGET_CONTROL, event.top, /DESTROY r0 = 0 & g0 = 0 & b0 = 0 ;Free common if PTR_VALID(p_updt_cb_data) then PTR_FREE, p_updt_cb_data ENDCASE "NEWBASE": BEGIN mode = event.value b = ([0, 0, 1])[mode] ;Top base to map: 0 or 1. for i=0,1 do WIDGET_CONTROL, state.bases[i], MAP=i eq b if b eq 0 then begin ;table or option mode? b = ([2,3,0])[mode] ;bottom base to map (mode eq 0 or 1) for i=2,3 do WIDGET_CONTROL, state.bases[i], MAP=i eq b endif if mode eq 2 then begin reset_all = 1 xlct_psave ;Save old state plot, [0, ncolors-1], [0, ncolors-1], xstyle=3, $ ystyle=3, xmargin = [1,1], ymargin=[1,1], ticklen = -0.03, $ /NODATA, $ xtickname = replicate(' ', 10), ytickname = replicate(' ', 10) goto, interp_cps endif ENDCASE "TFUNR": BEGIN reset_tfun: xlct_psave xlct_draw_cps, -1, 0 ;Erase all tfun = cps ;Linear ramp goto, interp_cps ENDCASE "REMCP": BEGIN n = n_elements(cps) if n gt 2 then begin xlct_psave xlct_draw_cps, -1, 0 igap = 0 for i=0, n-2 do $ if (cps[i+1] - cps[i]) lt (cps[igap+1]-cps[igap]) then $ igap = i keep = where(indgen(n) ne (igap > 1)) cps = cps[keep] tfun = tfun[keep] goto, interp_cps ENDIF ENDCASE "ADDCP": BEGIN xlct_psave xlct_draw_cps, -1, 0 igap = 0 ;Find largest gap for i=0, n_elements(cps)-2 do $ if (cps[i+1] - cps[i]) gt (cps[igap+1]-cps[igap]) then $ igap = i cps = [ cps[0:igap], (cps[igap]+cps[igap+1])/2, cps[igap+1:*]] tfun = [ tfun[0:igap], (tfun[igap]+tfun[igap+1])/2, tfun[igap+1:*]] interp_cps: xlct_draw_cps, -1 ;Redraw new xlct_transfer, /update xlct_psave ;Restore old points if n_elements(reset_all) then goto, reset_all ENDCASE ENDCASE END ;+ ; ; @file_comments ; Like XLOADCT but fastest to write and call by default ; the palette palette.tbl which can be in any directory ; ; @categories ; Widget, Color ; ; @keyword FILE {default='palette.tbl'} ; If this keyword is set, the file by the given name is used ; instead of the file colors1.tbl in the IDL directory. This ; allows multiple IDL users to have their own color table file. ; ; @keyword GROUP ; The widget ID of the widget that calls Xlct. When this ID is ; specified, a death of the caller results in a death of Xlct ; @keyword NCOLORS {default=!D.TABLE_SIZE = all available colors} ; number of colors to use. Use color indexes from BOTTOM to the ; smaller of !D.TABLE_SIZE-1 and NCOLORS-1. ; ; @keyword BOTTOM {default=0.} ; first color index to use. Use color indexes from BOTTOM to ; BOTTOM+NCOLORS-1. ; ; @keyword SILENT ; Normally, no informational message is printed when a color map ; is loaded. If this keyword is present and zero, this message is printed. ; ; @keyword USE_CURRENT ; If set, use the current color tables, regardless of ; the contents of the COMMON block COLORS. ; ; @keyword MODAL {default=not run in modal mode} ; If set, then XLCT runs in "modal" mode, meaning that ; all other widgets are blocked until the user quits XLCT. ; A group leader must be specified (via the GROUP keyword) ; for the MODAL keyword to have any effect. ; ; @keyword BLOCK ; Set this keyword to have XMANAGER block when this ; application is registered. By default the Xmanager ; keyword NO_BLOCK is set to 1 to provide access to the ; command line if active command line processing is available. ; Note that setting BLOCK for this application will cause ; all widget applications to block, not only this ; application. For more information see the NO_BLOCK keyword ; to XMANAGER. ; ; @keyword UPDATECALLBACK ; Set this keyword to a string containing the name of ; a user-supplied procedure that will be called when the color ; table is updated by XLCT. The procedure may optionally ; accept a keyword called DATA, which will be automatically ; set to the value specified by the optional UPDATECBDATA keyword. ; ; @keyword UPDATECBDATA ; Set this keyword to a value of any type. It will be ; passed via the DATA keyword to the user-supplied procedure ; specified via the UPDATECALLBACK keyword, if any. If the ; UPDATECBDATA keyword is not set the value accepted by the ; DATA keyword to the procedure specified by UPDATECALLBACK ; will be undefined. ; ; @history ; 5/5/1999 copy of xloadct par Sebastien Masson (smasson\@lodyc.jussieu.fr) ; ; @version ; $Id$ ; ;- ; PRO xlct, SILENT=silent_f, GROUP=group, FILE=file, $ USE_CURRENT=use_current, NCOLORS = nc, BOTTOM=bottom, $ MODAL=modal, BLOCK=block, UPDATECALLBACK=updt_cb_name, $ UPDATECBDATA=updt_cb_data ; compile_opt idl2, strictarrsubs ; COMMON colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr COMMON xlct_com, r0, g0, b0, tfun, state, filename, cps, psave, pnt, $ top, bot, silent, chop, lock, g_lbl, vbot, vtop, g_slider, $ gamma, color, use_values, ncolors, cbot, siz, w_height, show_win, $ updt_callback, p_updt_cb_data IF(XRegistered("xlct") NE 0) THEN return IF N_ELEMENTS(block) EQ 0 THEN block=0 IF N_ELEMENTS(updt_cb_name) EQ 0 THEN updt_callback="" $ ELSE updt_callback=updt_cb_name IF N_ELEMENTS(updt_cb_data) GT 0 THEN p_updt_cb_data=PTR_NEW(updt_cb_data) $ ELSE p_updt_cb_data=PTR_NEW() values_button = lonarr(2) IF KEYWORD_SET(SILENT_f) THEN silent = SILENT_F ELSE silent = 1 ;----------------------------------------------------------------------------- ; Changes made by S.Masson ;----------------------------------------------------------------------------- IF N_ELEMENTS(file) GT 0 THEN filename = file ELSE BEGIN filename = (find('palette.tbl', /firstfound, /nopro))[0] if filename EQ 'NOT FOUND' then filename=filepath('colors1.tbl',subdir=['resource', 'colors']) ENDELSE file = filename ;----------------------------------------------------------------------------- siz = 256 ;Basic width of tool names = 0 LOADCT, GET_NAMES = names, FILE = file ;Get table names w_height = 50 ;Height of ramp cur_win = !D.WINDOW lock = 0 chop = 0 vbot = 0 vtop = 100 gamma = 1.0 use_values=0 ; Bases: ; 0 = slider base (stretch bottom, stretch top, gamma) ; 1 = transfer function drawable + buttons ; 2 = color table list ; 3 = options base (sliders. top, stretch) state = { bases: lonarr(4), draw: 0L, name_list: 0L } ; DJC - Added modal keyword. ; Moved "group_leader" keyword from XMANAGER to WIDGET_BASE. ; Ignore modal keyword if a group leader is not supplied. if (N_ELEMENTS(group) GT 0L) then $ base = WIDGET_BASE(TITLE="Xlct", /COLUMN, GROUP_LEADER=group, $ MODAL=KEYWORD_SET(modal)) $ else $ base = WIDGET_BASE(TITLE="Xlct", /COLUMN) ; Setting the managed attribute indicates our intention to put this app ; under the control of XMANAGER, and prevents our draw widgets from ; becoming candidates for becoming the default window on WSET, -1. XMANAGER ; sets this, but doing it here prevents our own WSETs at startup from ; having that problem. WIDGET_CONTROL, /MANAGED, base show = WIDGET_DRAW(base, YSIZE=w_height, XSIZE=siz, /FRAME, RETAIN = 2) junk = WIDGET_BASE(base, /ROW) done = WIDGET_BUTTON(junk, VALUE=' Done ', UVALUE = "DONE") junk1 = WIDGET_BUTTON(junk, VALUE=' Help ', UVALUE = "HELP") junk = CW_BGROUP(base, /ROW, /EXCLUSIVE, /NO_REL, $ ['Tables', 'Options', 'Function'], $ UVALUE='NEWBASE', SET_VALUE=0) junk = widget_base(base) for i=0,1 do state.bases[i] = WIDGET_BASE(junk, /COLUMN) sbase=WIDGET_BASE(state.bases[0], /COLUMN) bot = WIDGET_SLIDER(sbase, TITLE = "Stretch Bottom", MINIMUM = 0, $ MAXIMUM = 100, VALUE = 0, /DRAG, UVALUE = "BOTTOM", xsize=siz) top = WIDGET_SLIDER(sbase, TITLE = "Stretch Top", MINIMUM = 0, $ MAXIMUM = 100, VALUE = 100, /DRAG, UVALUE = "TOP", xsize=siz) g_lbl = WIDGET_LABEL(sbase, VALUE = STRING(1.0)) g_slider = WIDGET_slider(sbase, TITLE = "Gamma Correction", $ MINIMUM = 0, MAXIMUM = 100, VALUE = 50, UVALUE = "GAMMA", $ /SUPPRESS_VALUE, /DRAG, xsize=siz) junk = WIDGET_BASE(sbase) for i=2,3 do state.bases[i] = WIDGET_BASE(junk, /COLUMN) DEVICE, GET_SCREEN = junk if junk[1] le 768 then junk = 8 else junk = 16 state.name_list = WIDGET_LIST(state.bases[2], VALUE = names, ysize = junk) ; Drawable for transfer function junk = WIDGET_BASE(state.bases[1], /COLUMN, /FRAME) junk1 = WIDGET_BUTTON(junk, VALUE = 'Reset Transfer Function', $ UVALUE='TFUNR') junk1 = WIDGET_BUTTON(junk, VALUE='Add Control Point', UVALUE='ADDCP') junk1 = WIDGET_BUTTON(junk, VALUE='Remove Control Point', UVALUE='REMCP') state.draw = WIDGET_DRAW(state.bases[1], xsize = siz, ysize = siz, $ /BUTTON_EVENTS, /MOTION_EVENTS) opt_id = state.bases[3] junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT='Sliders:', /EXCLUSIVE, /NO_REL, $ ['Independent', 'Gang'], UVALUE='GANG', SET_VALUE=lock) junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT = 'Top:', /EXCLUSIVE, /NO_REL, $ ['Clip', 'Chop'], SET_VALUE=chop, UVALUE='CHOP') junk = CW_BGROUP(opt_id, /ROW, LABEL_LEFT='Stretch:', /EXCLUSIVE, /NO_REL, $ ['Indices', 'Intensity'], UVALUE='VALUES', $ SET_VALUE=use_values) junk = WIDGET_BUTTON(opt_id, VALUE='Reverse Table', $ UVALUE="REVERSE", /NO_REL) junk = WIDGET_BUTTON(opt_id, VALUE='REPLACE Original Table', $ UVALUE = "OVERWRITE", /NO_REL) junk = WIDGET_BUTTON(opt_id, VALUE='RESTORE Original Table', $ UVALUE="RESTORE", /NO_REL) WIDGET_CONTROL, state.bases[1], MAP=0 ;Tfun is not visible WIDGET_CONTROL, state.bases[3], MAP=0 ;options are not visible WIDGET_CONTROL, base, /REALIZE WIDGET_CONTROL, state.draw, GET_VALUE=tmp if n_elements(bottom) gt 0 then cbot = bottom else cbot = 0 ncolors = !d.table_size - cbot if n_elements(nc) gt 0 then ncolors = ncolors < nc if ncolors le 0 then message,'Number of colors is 0 or negative' psave = { xlct_psave, win: !d.window, x: !x.s, y: !y.s , xtype: !x.type, $ ytype: !y.type, clip: !p.clip } ;Our initial state wset, tmp ;Initial graph xlct_psave ;Save original scaling & window plot, [0, ncolors-1], [0, ncolors-1], xstyle=3, ystyle=3, $ xmargin = [1,1], ymargin=[1,1], ticklen = -0.03, /NODATA xlct_psave ;Restore original scaling & window ;If no common, use current colors IF KEYWORD_SET(use_current) or N_ELEMENTS(r_orig) LE 0 THEN BEGIN TVLCT, r_orig, g_orig, b_orig, /GET r_curr = r_orig b_curr = b_orig g_curr = g_orig ENDIF r0 = r_curr ;Save original colors g0 = g_curr b0 = b_curr color = ncolors + cbot -1 cps = [0, ncolors-1] tfun = cps pnt = -1 WIDGET_CONTROL, show, GET_VALUE=show_win WSET, show_win ; DJC - fixed color bar display bug. ;TVSCL, BYTSCL(INDGEN(siz) # REPLICATE(1, w_height), top = ncolors-1) TV, BYTE((FLOAT(ncolors)*FINDGEN(siz)/FLOAT(siz-1)) # $ REPLICATE(1, w_height)) + BYTE(cbot) WSET, cur_win ; DJC - moved GROUP_LEADER keyword to WIDGET_BASE. XManager, "xlct", base, NO_BLOCK=(NOT(FLOAT(block))), $ MODAL=KEYWORD_SET(modal) END