; $Id: dialog_write_image.pro,v 1.22 2001/01/15 22:28:03 scottm Exp $
;
; Copyright (c) 1998-2001, Research Systems, Inc.  All rights reserved.
;	Unauthorized reproduction prohibited.
;+
; NAME:
;	DIALOG_WRITE_IMAGE
;
; PURPOSE:
;       This routine creates a GUI dialog for writing images.
;
; CATEGORY:
;       Input/Output
;
; CALLING SEQUENCE:
;       Result = DIALOG_WRITE_IMAGE, Image [,R,G,B]
;
;		Result is a 1 if Save was clicked, 0 for Cancel.
;
; INPUTS:
;       [Image] - The data array to be written to the image file.
;	    R,G,B - Optional red,green,blue color vectors.
;
; OPTIONAL KEYWORDS:
;
;  DIALOG_PARENT - The widget ID of a widget that calls DIALOG_WRITE_IMAGE.
;	When this ID is specified, a death of the caller results in the
;   death of the DIALOG_WRITE_IMAGE dialog.
;
;  FILENAME - Set this keyword to a named variable to contain the name of the initial
;   file selection.
;
;  FIX_TYPE - When this keyword is set, only files that satisfy the type can be
;   selected.  The user has no ability to modify the type and the type field
;   is grayed out.
;
;  NOWRITE - Set this keyword to prevent the dialog from writing the file when Save
;            is clicked.  No data conversions will take place when the save type is chosen.
;
;  OPTIONS - Set this keyword to a named variable to contain a structure of the chosen
;            options by the user, including the filename and image type chosen.
;
;  PATH - Set this keyword to a string that contains the initial path
;	from which to select files.  If this keyword is not set,
;	the current working directory is used.
;
;  TITLE - Set this keyword to a scalar string to be used for the dialog
;	title.  If not specified, the default title is "Save Image File".
;
;  TYPE - Set this keyword to a scalar string containing the format type the
;   Save as type field should begin with.  The default is "TIFF".  The user
;   can modify the type unless the FIX_TYPE keyword is set.  Valid values
;   are obtained from the list of supported image types returned from
;   QUERY_IMAGE.
;
;  WARN_EXIST - If set, the user is warned if a filename is chosen
;      that matches an already existing file.
;
; OUTPUTS:
;	None.
;
; EXAMPLE:
;       DIALOG_WRITE_IMAGE, myData
;
; MODIFICATION HISTORY:
; 	Written by:	Scott Lasica, October, 1998
;   CT, RSI, July 2000: Force to be modal, even if no parent.
;             Added WARN_EXIST.
;-
;

pro dwi_options_event,ev

	COMPILE_OPT HIDDEN, STRICTARR

	WIDGET_CONTROL, ev.id, GET_UVALUE=uval
	WIDGET_CONTROL, ev.top, GET_UVALUE=options,/NO_COPY

	catch,error_status
	if (error_status ne 0) then begin
		result = DIALOG_MESSAGE(!ERROR_STATE.MSG,/ERROR)
		return
  	endif

	case uval of
	  'okBut': begin
	  	WIDGET_CONTROL, ev.top, /destroy
	  	return
	  end
	  'bmp4': begin
		(*options).FOUR_BIT = ev.select
	  end
	  'bmp8': begin
		(*options).FOUR_BIT = 0
	  end
	  'jpegOrder': begin
		(*options).ORDER = ev.select
	  end
	  'jpegProg': begin
		(*options).PROGRESSIVE = ev.select
	  end
	  'jpegQuality': begin
	  	(*options).QUALITY = ev.value
	  end
	  'ppmASCII': begin
		(*options).ASCII = ev.select
	  end
	  'srfOrder': begin
	  	(*options).ORDER = ev.select
	  end
	  'srf32bit': begin
	  	(*options).WRITE_32 = ev.select
	  end
	  'tifAppend': begin
		(*options).APPEND = ev.select
	  end
	  'tifXres': begin
		(*options).XRESOL = ev.value
	  end
	  'tifYres': begin
	  	(*options).YRESOL = ev.value
	  end
	  'tifComp': begin
	  	; Need to translate droplist value to compression flag.
	  	; (this is so LZW can be the last item).
	  	(*options).COMPRESSION = ([0,2,1])[ev.index]
	  end
	endcase
	WIDGET_CONTROL, ev.top, SET_UVALUE = options,/NO_COPY
end

;; Options dialog
function dwi_options, parent, BMP=bmp, JPEG=jpeg, PPM=ppm, SRF=srf, TIFF=tiff

	COMPILE_OPT HIDDEN, STRICTARR

	dwi_options_base = WIDGET_BASE(TITLE='Image Options',/COLUMN, $
		/FLOATING, /MODAL, GROUP_LEADER=parent)
	center_base = WIDGET_BASE(dwi_options_base, /COLUMN)
	bottom_base = WIDGET_BASE(dwi_options_base, /COLUMN, /ALIGN_CENTER)
	okBut = WIDGET_BUTTON(bottom_base, VALUE='OK', UVALUE='okBut')

	if (keyword_set(bmp)) then begin
		placeholder = WIDGET_LABEL(center_base, VALUE='Bits per pixel')
		base = WIDGET_BASE(center_base, /COLUMN, /EXCLUSIVE)
		placeholder = WIDGET_BUTTON(base, VALUE='4',UVALUE='bmp4')
		placeholder = WIDGET_BUTTON(base, VALUE='8',UVALUE='bmp8')
		WIDGET_CONTROL, dwi_options_base, /REALIZE
		WIDGET_CONTROL, placeholder, /SET_BUTTON
		options = PTR_NEW({FOUR_BIT: 0})
	endif
	if (keyword_set(jpeg)) then begin
		base = WIDGET_BASE(center_base, /COLUMN, /NONEXCLUSIVE)
		placeholder = WIDGET_BUTTON(base, VALUE='Order', UVALUE='jpegOrder')
		placeholder = WIDGET_BUTTON(base, VALUE='Progressive',UVALUE='jpegProg')
		placeholder = WIDGET_SLIDER(center_base, VALUE=75,TITLE='Quality',UVALUE='jpegQuality')
		WIDGET_CONTROL, dwi_options_base, /REALIZE
		options = PTR_NEW({ORDER: 0, PROGRESSIVE: 0, QUALITY: 75})
	endif
	if (keyword_set(ppm)) then begin
		base = WIDGET_BASE(center_base, /COLUMN, /NONEXCLUSIVE)
		placeholder = WIDGET_BUTTON(base, VALUE='ASCII', UVALUE='ppmASCII')
		WIDGET_CONTROL, dwi_options_base, /REALIZE
		options = PTR_NEW({ASCII: 0})
	endif
	if (keyword_set(srf)) then begin
		base = WIDGET_BASE(center_base, /COLUMN, /NONEXCLUSIVE)
		placeholder = WIDGET_BUTTON(base, VALUE='Order', UVALUE='srfOrder')
		placeholder = WIDGET_BUTTON(base, VALUE='32 Bit', UVALUE='srf32bit')
		WIDGET_CONTROL, dwi_options_base, /REALIZE
		options = PTR_NEW({ORDER: 0, WRITE_32: 0})
	endif
	if (keyword_set(tiff)) then begin
		base = WIDGET_BASE(center_base, /COLUMN, /NONEXCLUSIVE)
		placeholder = WIDGET_BUTTON(base, VALUE='Append', UVALUE='tifAppend')
		placeholder = WIDGET_SLIDER(center_base, VALUE=100,TITLE='X Resolution',$
			UVALUE='tifXres')
		placeholder = WIDGET_SLIDER(center_base, VALUE=100,TITLE='Y Resolution',$
			UVALUE='tifYres')
		value = ['None','Packbits']
		; Add LZW option only if licensed...
		IF LMGR('idl_tifflzw',VERSION='1.0') THEN value = [value, 'LZW']
		placeholder=WIDGET_DROPLIST(center_base, VALUE=value, $
			TITLE='Compression',UVALUE='tifComp')
		WIDGET_CONTROL, dwi_options_base, /REALIZE
		options = PTR_NEW({APPEND: 0, COMPRESSION: 0, XRESOL: 100, YRESOL: 100})
	endif

	WIDGET_CONTROL, dwi_options_base, SET_UVALUE=options

	xmanager, 'dwi_options', dwi_options_base, EVENT_HANDLER='dwi_options_event'

	return,options
end

;; Event handler
pro dwi_event, ev

  COMPILE_OPT HIDDEN, STRICTARR

  catch,error_status
  if (error_status ne 0) then begin
		result = DIALOG_MESSAGE(!ERROR_STATE.MSG,/ERROR)
		return
  endif

  WIDGET_CONTROL, ev.top, GET_UVALUE=tlbStruct, /NO_COPY
  WIDGET_CONTROL, ev.id, GET_UVALUE=uval

  case uval of
    'filesel': begin
      WIDGET_CONTROL, ev.id, GET_VALUE=filenameRet

	  writeType = STRMID(ev.filter, 1)
	  stripCheck = STRPOS(ev.filter,',')
	  if (stripCheck gt 0) then writeType = STRMID(writeType, 0, (stripCheck-1))
	  (*tlbStruct).type = writeType

	  if (ev.done gt 0) then begin
	    if (ev.done eq 2) then (*tlbStruct).success=0L else begin
			if ((*tlbStruct).nowrite eq 0) then begin
      			WIDGET_CONTROL, /HOURGLASS
				;; If the called routine throws an error, we have to make sure
				;; the UVALUE pointer was secured.
				if (N_ELEMENTS(*(*tlbStruct).image) ne 0) then $
					tImage = (*(*tlbStruct).image)
				if (N_ELEMENTS(*(*tlbStruct).options) ne 0) then $
					tOptions = (*(*tlbStruct).options)
				if (N_ELEMENTS(*(*tlbStruct).red) ne 0) then $
					tRed = (*(*tlbStruct).red)
				if (N_ELEMENTS(*(*tlbStruct).green) ne 0) then $
					tGreen = (*(*tlbStruct).green)
				if (N_ELEMENTS(*(*tlbStruct).blue) ne 0) then $
					tBlue = (*(*tlbStruct).blue)
				tRGBvalid = (*tlbStruct).rgbValid
				WIDGET_CONTROL,ev.top,SET_UVALUE=tlbStruct, /NO_COPY

				if (tRGBvalid) then begin
					WRITE_IMAGE,filenameRet, writeType, tImage, tRed, tGreen, tBlue,$
						_EXTRA=tOptions
				endif else begin
					WRITE_IMAGE,filenameRet, writeType, tImage, _EXTRA=tOptions
				endelse
				WIDGET_CONTROL,ev.top,GET_UVALUE=tlbStruct, /NO_COPY
				(*tlbStruct).success=1L
			endif
		endelse
        WIDGET_CONTROL, ev.top, /destroy
        return
      endif else begin   ; done EQ 0
        IF (TAG_NAMES(ev,/STRUC) EQ 'FILESEL_EVENT') THEN BEGIN
        	SWITCH writeType OF
        	; all of the following have no options, make button insensitive
        	'GIF': ; fall thru
        	'PNG': BEGIN
        		WIDGET_CONTROL, (*tlbStruct).optionbut, SENSITIVE=0
        		BREAK
        		END
        	ELSE: $  ; anything else has an options page, make sensitive
        		WIDGET_CONTROL, (*tlbStruct).optionbut, /SENSITIVE
        	ENDSWITCH
        ENDIF
      endelse
    end
    'optionbut': begin
    	writeType = (*tlbStruct).type
    	WIDGET_CONTROL, ev.top, SET_UVALUE=tlbStruct, /NO_COPY

		case (writeType) of
			'BMP': options = dwi_options(ev.top, /BMP)
			'JPEG': options = dwi_options(ev.top, /JPEG)
			'PPM': options = dwi_options(ev.top, /PPM)
			'SRF': options = dwi_options(ev.top, /SRF)
			'TIFF': options = dwi_options(ev.top, /TIFF)
			'': options = dwi_options(ev.top, /TIFF)
			else:
		endcase
		WIDGET_CONTROL, ev.top, GET_UVALUE=tlbStruct, /NO_COPY
		if (N_ELEMENTS(options) gt 0) then begin
			PTR_FREE, (*tlbStruct).options
			(*tlbStruct).options = PTR_NEW(*options)
		endif
    end
    else:
  endcase

  WIDGET_CONTROL, ev.top, SET_UVALUE=tlbStruct, /NO_COPY
end

;------------------------------------------------------------------
function DIALOG_WRITE_IMAGE, image, red, green, blue, $
                            DIALOG_PARENT = parent, $
                            FILENAME = filename, $
                            FIX_TYPE = fixt, $
                            NOWRITE = noWrite, $
                            OPTIONS = options, $
                            PATH = path, $
                            TITLE = title, $
                            TYPE = type, $
                            WARN_EXIST = warn_exist
COMPILE_OPT strictarr

  ; Check input parameters
  if (N_ELEMENTS(image) eq 0) then begin
	result=DIALOG_MESSAGE('Missing image data.',/ERROR)
	return,0
  endif

  rgbTest = ((N_ELEMENTS(red) gt 0) and (N_ELEMENTS(green) gt 0) and $
  	(N_ELEMENTS(blue) gt 0))

  if (rgbTest) then begin
	sRed = red
	sGreen = green
	sBlue = blue
  endif

  if (N_ELEMENTS(noWrite) eq 0) then noWrite=0

  if (N_ELEMENTS(title) eq 0) then $
    title = 'Save Image File' $
  else $
    if (SIZE(title,/TYPE) ne 7) then $
      title = STRTRIM(STRING(title),2)


  has_parent = (N_ELEMENTS(parent) gt 0)
  if has_parent then begin
      if (not WIDGET_INFO(parent, /VALID_ID)) then $
        noth=DIALOG_MESSAGE('Invalid widget identifier.',/ERROR)
  endif else begin
  	parent = WIDGET_BASE(TITLE=title)   ; create a dummy parent base
  endelse

  base = WIDGET_BASE(TITLE=title, /COLUMN, GROUP_LEADER=parent, $
  	/FLOATING, /MODAL)

  sType = ''

  if (N_ELEMENTS(type) gt 0) then begin
  	if (strpos(type,'.') eq -1) then $
		type = '.' + STRUPCASE(type)
	if (type eq '.JPEG') then type = '.JPEG,.JPG'
	if (type eq '.TIFF') then type = '.TIFF,.TIF'
  endif else begin
	noth = QUERY_IMAGE(SUPPORTED_WRITE=type)
	type = '.' + STRUPCASE(type)
	loc = where(type eq '.JPEG')
	if (loc[0] ge 0) then $
		type[loc] = '.JPEG,.JPG'
	loc = where(type eq '.TIFF')
	if (loc[0] ge 0) then $
		;; Make Tiff the default
		type[loc] = type[0]
		type[0] = '.TIFF,.TIF'
		sType = 'TIFF'
  endelse

  filesel = CW_FILESEL(base, FILENAME=filename, FILTER=type, $
                       FIX_FILTER=fixt, PATH=path, UVALUE='filesel',/SAVE, $
                       WARN_EXIST=KEYWORD_SET(warn_exist))

  optionBase = WIDGET_BASE(base)
  optionbut = WIDGET_BUTTON(optionBase, VALUE='Options...',UVALUE='optionbut',xoffset=185)

  WIDGET_CONTROL, base, /REALIZE

  tlbStruct = PTR_NEW({dwi_Struct, $
               	filesel: filesel, $
               	optionbut: optionbut, $
               	nowrite: nowrite, $
				image: PTR_NEW(image), $
				red: PTR_NEW(sRed), $
				green: PTR_NEW(sGreen), $
				blue: PTR_NEW(sBlue), $
				options: PTR_NEW(placeholder), $
              	success: 1, $
				rgbValid: rgbTest, $
              	type: sType $
              })

  WIDGET_CONTROL, base, SET_UVALUE = tlbStruct

  XMANAGER, 'DIALOG_WRITE_IMAGE', base, EVENT_HANDLER='dwi_event', $
  	GROUP_LEADER=parent

  IF (NOT has_parent) THEN WIDGET_CONTROL, parent, /DESTROY

  ;; Grab the output info
  if (N_ELEMENTS(*((*tlbStruct).options)) gt 0) then $
  	options = *((*tlbStruct).options) $
  else $
  	options = -1
  retVal = (*tlbStruct).success

  if (PTR_VALID((*tlbStruct).image)) then $
	  PTR_FREE, (*tlbStruct).image
  if (PTR_VALID((*tlbStruct).red)) then $
	  PTR_FREE, (*tlbStruct).red
  if (PTR_VALID((*tlbStruct).green)) then $
	  PTR_FREE, (*tlbStruct).green
  if (PTR_VALID((*tlbStruct).blue)) then $
	  PTR_FREE, (*tlbStruct).blue
  if (PTR_VALID((*tlbStruct).options)) then $
	  PTR_FREE, (*tlbStruct).options
  if (PTR_VALID(tlbStruct)) then $
	  PTR_FREE, tlbStruct

  return,retVal
end