;
;+
;NAME:
;	LASER8
;
;PURPOSE:
;	This procedure generates a "nice" layout for printing images
;	using an interactive menu system.
;
;CATEGORY:
;	UTIL
;
;CALLING SEQUENCE:
;	LASER8
;
;INPUTS:
;	None
;
;OUTPUTS:
;	None, File written to disk
;
;AUTHOR:
;	Eric T. Swanson, NRL Summer Student, Aug, 1991
;
;	@(#)laser8.pro	1.2 05/14/97 LASCO IDL LIBRARY
;
;+
;NAME:
;	LASER8
;
;PURPOSE:
;	This procedure generates a "nice" layout for printing images
;	using an interactive menu system.
;
;CATEGORY:
;	UTIL
;
;CALLING SEQUENCE:
;	LASER8
;
;INPUTS:
;	None
;
;OUTPUTS:
;	None, File written to disk
;
;AUTHOR:
;	Eric T. Swanson, NRL Summer Student, Aug, 1991
;
;	@(#)laser8.pro	1.2 05/14/97 LASCO IDL LIBRARY
;-
;
FUNCTION FILEMENU,imcol,imrow,ioerr,reset_flag
;
common FM1, directory, filename, filetype, format, datatype, ncols, nrows, process_flag
;
case n_params() of
	3:  reset_flag='yes'
	2:  begin & reset_flag='yes' & ioerr=0 & end
	1:  begin & reset_flag='yes' & ioerr=0 & imrow=1 & end
	0:  begin & reset_flag='yes' & ioerr=0 & imrow=1 & imcol=1 & end
	else:
endcase
;
if (reset_flag eq 'yes') then begin
	directory='.'
	filename=''
	datatype='floating'
	ncols=72 & nrows=36
	filetype='unformatted'
	format=''
	process_flag='on'
	reset_flag='no'
endif
;
spawn, 'clear'
reply=''
if (ioerr lt 0) then begin
	print
	print, '\007' + '!#@*#&%#$! Error in reading ' +directory+ $
		'/' +filename+ '! !#@*#&%#$!' 
	ioerr=0
endif
print
print, 'FILEMENU:  Column',imcol,', number',imrow,':', format='(a,i2,a,i2,a)'
print
print, "    file's directory (DIR): ", directory
print, '    filename        (FILE): ', filename
print, '    file format     (FORM): ', filetype, format
print, '    data type       (DATA): ', datatype
print, '    data dimensions (DIMS): ', ncols, ',', nrows, format='(3(a,i4))'
print, '    image processing (PRO): ', process_flag
print
print, 'Enter in the form VARIABLE=NEWVALUE; type LOAD when ready to load; '
print, 'or type ABORT to return to IDL:'
read,  '---(filemenu)---> ', reply
;
eqpos=strpos(reply,'=')
if (eqpos gt -1) then begin
	reply1=strupcase(strmid(reply,0,eqpos))
	reply2=strmid(reply,eqpos+1,80)
endif else reply1=strupcase(reply)
;
case strupcase(strmid(reply1,0,3)) of
	'DIR':  directory=strtrim(reply2,2)
	'FIL':  filename=strtrim(reply2,2)
	'FOR':  begin
		filetype=strtrim(reply2,2)
                if (strupcase(filetype) eq 'FITS') then begin
                        filetype='fits'
                        format=''
                ENDIF ELSE BEGIN
		if (strupcase(strmid(filetype,0,1)) eq 'F') then begin
			filetype='formatted, '
			read, 'Enter format of file:  ', reply
			format='('+reply+')'
		endif else begin
			filetype='unformatted'
			format=''
		endelse
                ENDELSE
		end
	'DAT':  datatype=strtrim(reply2,2)
	'DIM':  begin & ncols=fix(strmid(reply2,0,strpos(reply2, ','))) & $
		nrows=fix(strmid(reply2,strpos(reply2, ',')+1,8)) & end
	'PRO':  if (strupcase(strtrim(reply2)) eq 'OFF') then process_flag='off' $
		else process_flag='on'
	'LOA':  reply1='LOAD'
	else:
endcase
;
return,reply1
end
;
;
;
;
;
FUNCTION IMAGEMENU, imcol, imrow, filename, reset_flag
;
common IM1, invert, invert_flag, reflect_flag, interp, nshades, shadecut, shadecol, $
	newmax, newmin, omax, omin, sz
;
case n_params() of
	3:  reset_flag='yes'
	2:  begin & reset_flag='yes' & filename='' & end
	1:  begin & reset_flag='yee' & filename='' & imrow=1 & end
	0:  begin & reset_flag='yes' & filename='' & imrow=1 & imcol=1 & end
	else:
endcase
;
reply=''
spawn, 'clear'
print
print, 'IMAGEMENU:  column: ',imcol,'   row: ',imrow, format='(2(a,i2))'
print, '            file  :  ',filename
print, '            dims  :  ' + strtrim(fix(interp*sz(1)),2) + 'x' + $
							strtrim(fix(interp*sz(2)),2)
print, '            max   : ', omax, format='(a,f7.3)'
print, '            min   : ', omin, format='(a,f7.3)'
print
print, '    inversion (black/white)    (INVERT):  ', invert_flag, format='(a,a5)'
print, '    reflection (top/bottom)   (REFLECT):  ', reflect_flag, format='(a,a5)'
print, '    interpolation factor       (INTERP):   ', interp, format='(a,f4.1)'
print, '    maximum cutoff                (MAX): ', newmax, format='(a,f6.1)'
print, '    minimum cutoff                (MIN): ', newmin, format='(a,f6.1)'
print, '    number of shades          (NSHADES):   ', nshades, format='(a,i4)'
if (nshades gt 0) then begin
	print
	print, '    shade zone cutoffs (in %)  (CUTOFF):'
	print, shadecut, format='(4x,7f7.2)'
	print
	print, '    shade zone colors (1-256)   (COLOR):'
	print, shadecol, format='(6x,7i7)'
endif else begin
	print, '    shade zone cutoffs (in %)  (CUTOFF):      0'
	print, '    shade zone colors (1-256)   (COLOR):      0'
endelse
print
print, 'Enter in the form VARIABLE=NEWVALUE or VARIABLE OLDVALUE=NEWVALUE.'
print, '(e.g. MAX=20 or COLOR 245=225).  Type SAVE to save this image and'
print, 'go on, or QUIT to quit this image:'
read,  '---(imagemenu)---> ', reply
print
;
eqpos=strpos(reply,'=')
if (eqpos gt -1) then begin
	reply1=strupcase(strmid(reply,0,eqpos))
	reply2=strmid(reply,eqpos+1,80)
endif else reply1=strupcase(reply)
;
case strupcase(strmid(reply1,0,3)) of
	'INV':  if (strupcase(reply2) eq 'ON') then begin
			invert_flag='on' & invert=-1
		endif else begin
			invert_flag='off' & invert=1
		endelse
	'REF':  if (strupcase(reply2) eq 'ON') then begin
			reflect_flag='on' & !order=1
		endif else begin
			reflect_flag='off' & !order=0
		endelse
	'INT':  interp=float(reply2) > .01
	'MAX':  newmax=float(reply2)
	'MIN':  newmin=float(reply2)
	'NSH':  begin
		nshades=fix(reply2)
		if (nshades ge 255) then nshades=0
		if (nshades gt 0) then begin
			shadecut=[findgen(nshades)*(100./nshades), 100.0]
			shadecol=byte( [findgen(nshades-1)*(255./(nshades-1)), 255.0] + 0.5 )
		endif else begin
			shadecut=0.0
			shadecol=0
		endelse
		end
	'CUT':  if (nshades le 4) then begin
			print, format='(a,i3,a)', 'Enter the', nshades+1, $
				' cutoff numbers separated by commas below:'
			read, '---> ', shadecut
		endif else begin
			index=where(shadecut eq float(strmid(reply1,6,eqpos-6)), count)
			if (count gt 0) then shadecut(index)=float(reply2)
		endelse
	'COL':  if (nshades le 4) then begin
			print, format='(a,i3,a)', 'Enter the', nshades, $
				' color integers separated by commas below:'
			read, '---> ', shadecol
			shadecol=shadecol > 0B < 255B
		endif else begin
			index=where(shadecol eq byte(fix(strmid(reply1,5,eqpos-5))), count)
			if (count gt 0) then shadecol(index)=byte(fix(reply2))
			shadecol=shadecol > 0B < 255B
		endelse
	'SAV':  reply1='SAVE'
	'QUI':  reply1='QUIT'
	 else:
endcase
;
return,reply1
end
;
;
;
;
;
FUNCTION PRINTMENU, numimcols, numimrows, reset_flag
;
common PM1, ximsize, yimsize, xticks, yticks, xrange, yrange, toptitle, bottitle, $
	leftitle, xbot, xtop, yleft, yright, margins, xoffset, yoffset, $
	nimcols, nimrows
;
case n_params() of
	2:  reset_flag='yes'
	1:  begin & reset_flag='yes' & nimrows=1 & end
	0:  begin & reset_flag='yes' & nimrows=1 & nimcols=1 & end
	else:
endcase
;
if (reset_flag eq 'yes') then begin
	nimcols=numimcols
	nimrows=numimrows
	!order=0
	margins=0.4
	ximsize=6.2/nimcols-0.4
	yimsize=6.9/nimrows-0.4 < ximsize/2
	ximsize=ximsize < 2*yimsize
	xticks=4
	yticks=4
	xrange=[0,360]
	yrange=[-90,90]
	xtop=strarr(nimcols)
	xbot=strarr(nimcols)
	yleft=strarr(nimrows)
	yright=strarr(nimrows)
	toptitle=strarr(2)
	leftitle='Latitude (Deg)'
	bottitle='Longitude (Deg)'
	reset_flag='no'
endif
;
reply=''
spawn,'clear'
print
print, 'PRINTMENU:  Current page setup:'
print
print, '    Image width  (IW):  ', ximsize, ' in.', format='(a,f5.2,a)'
print, '    Image height (IH):  ', yimsize, ' in.', format='(a,f5.2,a)'
print, '    Margins between images (MAR):  ', margins, ' in.', $
	format='(a,f5.2,a)'
print
print, '    Ticks:  number along x-axis (TNX):  ', xticks, format='(a,i2)'
print, '            number along y-axis (TNY):  ', yticks, format='(a,i2)'
print, '            range of x-axis values (TRX):  ', xrange(0), ',', $
	xrange(1), format='(a,i4,a,i4)'
print, '            range of y-axis values (TRY):  ', yrange(0), ',', $
	yrange(1), format='(a,i4,a,i4)'
print
print, '    Titles: top of page title, 1st line (TOP1):  ', toptitle(0)
print, '            top of page title, 2nd line (TOP2):  ', toptitle(1)
print, '            left of page title          (LEFT):  ', leftitle
print, '            bottom of page title         (BOT):  ', bottitle
print, '            column 1, top     (XTOP1):  ', xtop(0)
print, '                      bottom  (XBOT1):  ', xbot(0)
for i=1,nimcols-1 do begin
	print, 'column',i+1,',    top  (XTOP',i+1,'):  ', xtop(i), $
		format='(12x,a,i2,a,i1,a,a)
	print, 'bottom     (XBOT',i+1,'):  ', xbot(i), format='(19x,a,i1,2a)'
endfor
for j=0,nimrows-1 do begin
	print, 'row',j+1,',    left   (YLEFT',j+1,'):  ', yleft(j), $
		format='(12x,a,i2,a,i1,a,a)'
	print, '  right (YRIGHT',j+1,'):  ', yright(j), format='(20x,a,i1,2a)'
endfor
print
print, '    Other commands:  PREVIEW sends the page to the screen'
print, '                     PRINT sends the page to the printer'
print, '                     REDO lets you reprocess an image'
print, '                     SAVE saves the page as a PostScript file'
print, '                     SWITCH lets you interchange two images'
print
print, 'Enter in the form VARIABLE=NEWVALUE or type a command; type EXIT when done:'
read,  '---(printmenu)---> ',reply
print
;
eqpos=strpos(reply,'=')
if (eqpos gt -1) then begin
	reply1=strupcase(strmid(reply,0,eqpos))
	reply2=strmid(reply,eqpos+1,80)
endif else reply1=strupcase(reply)
;
case strmid(reply1,0,3) of
	'IW' :  ximsize=float(reply2)
	'IH' :  yimsize=float(reply2)
	'MAR':  margins=float(reply2)
	'TNX':  xticks=float(reply2)
	'TNY':  yticks=float(reply2)
	'TRX':  xrange=[float(strmid(reply2,0,strpos(reply2,','))), $
			float(strmid(reply2,strpos(reply2,',')+1,10))]
	'TRY':  yrange=[float(strmid(reply2,0,strpos(reply2,','))), $
			float(strmid(reply2,strpos(reply2,',')+1,10))]
	'XTO':  xtop(fix(strmid(reply1,4,1))-1)=reply2
	'XBO':  xbot(fix(strmid(reply1,4,1))-1)=reply2
	'YLE':  yleft(fix(strmid(reply1,5,1))-1)=reply2
	'YRI':  yright(fix(strmid(reply1,6,1))-1)=reply2
	'TOP':  toptitle(fix(strmid(reply1,3,1))-1)=reply2
	'LEF':  leftitle=reply2
	'BOT':  bottitle=reply2
	'PRE':  reply1='PREVIEW'
	'PRI':  reply1='PRINT'
	'RED':  reply1='REDO'
	'SAV':  reply1='SAVE'
	'SWI':  reply1='SWITCH'
	 else:
endcase
;
return,reply1
end
;
;
;
;
;
FUNCTION EXITMENU, reset_flag, ioerr
;
common EM1, saveim_flag, mkdir_flag, imdir, impref
;
case n_params() of
	1:  ioerr=0
	0:  begin & ioerr=0 & reset_flag='yes' & end
	else:
endcase
;
if (reset_flag eq 'yes') then begin
	saveim_flag='no'
	mkdir_flag='no'
	imdir='.'
	impref='laser'
	saveps_flag='yes'
	psdir='.'
	psname='idl.ps'
	reset_flag='no'
endif
;
reply=''
spawn,'clear'
if (ioerr eq -1) then begin
	print
	print, '\007' + '!#@*#&%#$! Error in saving ' + impref + $
		'.*.*.*.*.image files to ' + imdir + '! !#@*#&%#$!' 
	ioerr=0
endif
print
print,'EXITMENU:  Save the laser.*.*.*.*.image files?'
print
print,'        Save the image files (SAVE):  ', saveim_flag
print,'        Make save directory (MKDIR):  ', mkdir_flag
print,'        Save to directory     (DIR):  ', imdir
print,"        Save files' prefix   (PREF):  ", impref
print
print,'Enter in the form VARIABLE=NEWVALUE; type DONE when finished:'
read, '---(exitmenu)---> ', reply
print
;
eqpos=strpos(reply,'=')
if (eqpos gt -1) then begin
	reply1=strupcase(strmid(reply,0,eqpos))
	reply2=strmid(reply,eqpos+1,80)
endif else reply1=strupcase(reply)
;
case strupcase(strmid(reply1,0,2)) of
	'SA':  saveim_flag=reply2
	'MK':  mkdir_flag=reply2
	'DI':  imdir=reply2
	'PR':  impref=reply2
	'DO':  reply1='DONE'
	'EX':  reply1='DONE'
	 else:
endcase
;
return,reply1
end
;
;
;
;
;  **************************************************************************************
;
;  **************************************************************************************
;                                 IDL Congrid Function
;  **************************************************************************************
;  **************************************************************************************
;
;;
;
;
function congrid, image, xs, ys, interp=int ;VAX IDL CONGRID function
;+
; NAME:		CONGRID
; PURPOSE:	Simulate the action of the VAX/VMS CONGRID/CONGRIDI function.
;		Shrink or expand the size of an image.
; CATEGORY:	Image processing.
; CALLING SEQUENCE:
;	Result = CONGRID(Image, Xs, Ys [, Interp = Interp])
; INPUTS:
;	Image = 2D array to resample.
;	Xs = desired number of columns for result.
;	Ys = number of rows for result.
; KEYWORD PARAMETERS:
;	Interp = keyword which if set causes bilinear interpolation to be
;		used.  Otherwise nearest neighbor method is used.
; OUTPUTS:
;	Result = Image of same type as input, of size (Xs, Ys).
; COMMON BLOCKS:
;	None.
; SIDE EFFECTS:
;	None.
; RESTRICTIONS:
;	Doesn't completely emulate the VAX/VMS CONGRID.  The case 
;	of a rectangular grid is not implemented.  This can be done 
;	using multiple calls to POLY_2D.
; PROCEDURE:
;	Simple call POLY_2D with the warping coefficients.
; MODIFICATION HISTORY:
;	DMS, Sept. 1988.
;-

on_error,2              ;Return to caller if an error occurs

if n_params() gt 3 then begin ;Cant warp over small rectangles
	print,"CONGRID - Can't warp over control grid."
	return,undef
	endif

s = size(image)
if s(0) ne 2 then begin		;2d image?
	print,'CONGRID - Image parameter not 2 dimensional'
	return,undef
	endif

if n_elements(int) le 0 then int = 0 ;Default = no interp

return, poly_2d(image, [[0,0],[s(1)/float(xs),0]], $ ;Use poly_2d
	  [[0,s(2)/float(ys)],[0,0]],int,xs,ys)
end
;
;
;
;
;
FUNCTION READFILE,ioerr
;
common FM1, directory, filename, filetype, format, datatype, ncols, nrows, process_flag
;
if (n_params() lt 1) then return,-1
;
on_ioerror, abort
;
IF (STRUPCASE(datatype) EQ 'FITS') THEN BEGIN
   temp = READFITS(directory+'/'+filename,hdr)
   sz = SIZE (temp)
   ncols = sz(1)
   nrows = sz(2)
   io_ok=0
ENDIF ELSE BEGIN
case strupcase(strmid(datatype,0,1)) of
	'I' :  temp=intarr(ncols,nrows, /nozero)
	'B' :  temp=bytarr(ncols,nrows, /nozero)
	'D' :  temp=dblarr(ncols,nrows, /nozero)
	else:  temp=fltarr(ncols,nrows, /nozero) 
endcase
;
get_lun, input
openr, input, directory+'/'+filename
if (strupcase(strmid(filetype,0,1)) eq 'F') then readf, input, temp, format=format $
	else readu, input, temp
free_lun, input
;
ENDELSE
io_ok:  return, temp
abort:  ioerr=-1 & return,-1
end
;
;
;
;
;
FUNCTION STOREFILE, data, imcol, imrow
;
case n_params() of
	2:  imrow=1
	1:  begin & imrow=1 & incol=1 & end
	else:
endcase
;
sz=size(data)
;
if (!order eq 1) then begin
	data1=data
	for i=0,sz(2)-1 do data(*,i)=data1(*,sz(2)-1-i)
endif
;
get_lun, output
openw, output, 'laser.'+strtrim(imcol,1)+'.'+strtrim(imrow,1)+ $
	'.'+strtrim(sz(1),1)+'.'+strtrim(sz(2),1)+'.image'
writeu, output, bytscl(data)
;writeu,output,data
free_lun, output
;
return, [sz(1),sz(2)]
end
;
;
;
;
;
FUNCTION WRAPUP, nimcols, nimrows, dims
;
common EM1, saveim_flag, mkdir_flag, imdir, impref
;
on_ioerror, abort
if (saveim_flag eq 'yes') then begin
	if (mkdir_flag eq 'yes') then spawn, 'mkdir ' + imdir
	for i=1,nimcols do begin
	for j=1,nimrows do begin
		oldfile='laser.' + strtrim(i,2) + '.' + strtrim(j,2) + $
			'.' + strtrim(dims(0,j-1,i-1),2) + '.' + $
			strtrim(dims(1,j-1,i-1),2) + '.image'
		newfile=imdir + '/' + impref + strmid(oldfile,5,80)
		spawn, '\mv ' + oldfile + ' ' + newfile
	endfor
	endfor
endif else spawn, '\rm laser.*.*.*.*.image'
;
io_ok:  return, 0
abort:  return,-1
end
;
;
;
;
;
PRO SWITCHIMS,dims
;
coords1=intarr(2)
coords2=intarr(2)
;
on_ioerror,again
again:
read,'Enter COLUMN,ROW of  first image: ',coords1
read,'Enter COLUMN,ROW of second image: ',coords2
;
file1coords='laser.' + strtrim(coords1(0),2) + '.' + strtrim(coords1(1),2) 
file2coords='laser.' + strtrim(coords2(0),2) + '.' + strtrim(coords2(1),2)
file1dims='.' + strtrim(dims(0,coords1(1)-1,coords1(0)-1),2) + '.' + $
	strtrim(dims(1,coords1(1)-1,coords1(0)-1),2) + '.image'
file2dims='.' + strtrim(dims(0,coords2(1)-1,coords2(0)-1),2) + '.' + $
	strtrim(dims(1,coords2(1)-1,coords2(0)-1),2) + '.image'
;
spawn,'\mv ' + (file1coords+file1dims) + ' x.x.x.temp.x.x.x'
spawn,'\mv ' + (file2coords+file2dims) + ' ' + (file1coords+file2dims)
spawn,'\mv x.x.x.temp.x.x.x ' + (file2coords+file1dims)
;
coords1=coords1-1
coords2=coords2-1
temp=dims( *, coords1(1), coords1(0) )
dims( *, coords1(1), coords1(0) )=dims( *, coords2(1), coords2(0) )
dims( *, coords2(1), coords2(0) )=temp
;
MULTIDISPLAY,dims,'PREVIEW'
return
end
;
;
;
;
;
PRO PAGETITLES,font,scale
;
common PM1, ximsize, yimsize, xticks, yticks, xrange, yrange, toptitle, bottitle, $
	leftitle, xbot, xtop, yleft, yright, margins, xoffset, yoffset, $
	nimcols, nimrows
;
topheight=((nimrows-1.)*(yimsize+margins)+yimsize+yoffset)/11.
;
xyouts, (xoffset-1.0)/8.5, 0.5-0.125/11, leftitle, /normal, $
	alignment=0.5, color=0, charsize=2*scale, charthick=1, $
	orientation=90, font=font
xyouts, 0.5+0.25/8.5, (yoffset-1.0)/11, bottitle, /normal, $
	alignment=0.5, color=0, charsize=2*scale, charthick=1, font=font
xyouts, 0.5+0.25/8.5, topheight+1.75/11, toptitle(0), /normal, $
	alignment=0.5, color=0, charsize=3*scale, charthick=3, font=font
xyouts, 0.5+0.25/8.5, topheight+1.125/11, toptitle(1), /normal, $
	alignment=0.5, color=0, charsize=3*scale, charthick=3, font=font
!x.tickname=replicate('',30) & !y.tickname=replicate('',30)
;
return
end
;
;
;
;
;
PRO PLOTIMAGE,imcol,imrow,dims,font,inputstring
;
common PM1, ximsize, yimsize, xticks, yticks, xrange, yrange, toptitle, bottitle, $
	leftitle, xbot, xtop, yleft, yright, margins, xoffset, yoffset, $
	nimcols, nimrows
;
imcol1=imcol-1  ; translate from English 1,2,3 to IDL 0,1,2
imrow1=imrow-1
;
position= [ (imcol1*(ximsize+margins)+xoffset)/8.5, $
	(imrow1*(yimsize+margins)+yoffset)/11, $
	(imcol1*(ximsize+margins)+ximsize+xoffset)/8.5, $
	(imrow1*(yimsize+margins)+yimsize+yoffset)/11]
;
if (imrow1 eq 0) then begin
	xbot1=xbot(imcol1)
	!x.tickname=replicate('',30)
endif else begin
	xbot1=' '
	!x.tickname=replicate(' ',30)
endelse
;
if (imcol1 eq 0) then begin
	yleft1=yleft(imrow1)
	yright1=yright(imrow1)
endif else begin
	yleft1=' '
	yright1=' '
	!y.tickname=replicate(' ',30)
endelse
;
get_lun, input
openr, input, 'laser.'+strtrim(imcol,1)+'.'+strtrim(imrow,1)+'.'+ $
	strtrim(dims(0,imrow1,imcol1),1)+'.'+strtrim(dims(1,imrow1,imcol1),1)+'.image'
temp=bytarr(dims(0,imrow1,imcol1),dims(1,imrow1,imcol1))
readu, input, temp
free_lun, input
;
if (inputstring eq 'PREVIEW') then begin
	temp=CONGRID( temp, (position(2)-position(0))*!d.x_vsize, $
		(position(3)-position(1))*!d.y_vsize )
	tv, temp, position(0), position(1), /normal
endif else begin
	tv, temp, position(0), position(1), $
		/normal, xsize=position(2)-position(0), $
		ysize=position(3)-position(1)
endelse
;
IF (xticks LT 0)  OR (yticks LT 0)  THEN RETURN
contour, temp, /nodata, /noerase, xticks=xticks, yticks=yticks, $
	xstyle=1, ystyle=1, position=position, /normal, $
	xrange=xrange, yrange=yrange, color=0, yticklen=.01, $
	xtitle=xbot1, ytitle=yleft1, charthick=2
if (imrow1 eq nimrows-1) then axis, xaxis=1, xticks=xticks, $
	xtickname=replicate(' ',30), xtitle=xtop(imcol1), xstyle=1, $
	color=0, charsize=1.75, charthick=1, font=font
if (imcol1 eq nimcols-1) then axis, yaxis=1, yticks=yticks, $
	ytickname=replicate(' ',30), ytitle=yright(imrow1), ystyle=1, $
	color=0, yticklen=.01
;
return
end
;
;
;
;
;
FUNCTION DISPLAY, inputimage, reset_flag, newimg_flag
;
common IM1, invert, invert_flag, reflect_flag, interp, nshades, shadecut, shadecol, $
	newmax, newmin, omax, omin, sz
;
if (newimg_flag eq 'yes') then begin
	omin=min(inputimage, max=omax)
		newmin=omin
		newmax=omax
	sz=SIZE(inputimage)
	newimg_flag='no'
endif
if (reset_flag eq 'yes') then begin
	!order=0
	erase, 255
	invert=-1
	invert_flag='on'
	reflect_flag='off'
	interp=1
	nshades=0
	shadecut=0.0
	shadecol=0
	reset_flag='no'
endif
;
temp=CONGRID(inputimage,fix(interp*sz(1)),fix(interp*sz(2)),interp=1) $
	< newmax > newmin
;
if (nshades gt 0) then begin
	processedimage=bytarr(fix(interp*sz(1)),fix(interp*sz(2)))
	for i=1,nshades do begin
		index=where((temp ge newmin+shadecut(i-1)*(newmax-newmin)/100 and $
			temp le newmin+shadecut(i)*(newmax-newmin)/100), count)
		if (count ne 0) then processedimage(index)=byte(invert)*shadecol(i-1)
	endfor
endif else processedimage=bytscl(invert*temp)
;endif else processedimage=invert*temp
;
xsize=550./640*!d.x_vsize
ysize=float(sz(2))/sz(1)*xsize
displayimage=CONGRID(processedimage,xsize,ysize)
xoffset=(1-xsize/!d.x_vsize)/2
yoffset=(1-ysize/!d.y_vsize)/2
erase, 255
;
tv, displayimage, xoffset, yoffset, /normal
contour, temp, /nodata, /noerase, color=0, ticklen=0, $
	position=[ xoffset, yoffset, xoffset+xsize/!d.x_vsize, $
	yoffset+ysize/!d.y_vsize ], xticks=1, xtickname=[' ',' '], $
	yticks=1, ytickname=[' ',' ']
;
return, processedimage
end
;
;
;
;
;
PRO MULTIDISPLAY, dims, inputstring
;
common PM1, ximsize, yimsize, xticks, yticks, xrange, yrange, toptitle, bottitle, $
	leftitle, xbot, xtop, yleft, yright, margins, xoffset, yoffset, $
	nimcols,nimrows
;
xused= nimcols*ximsize + (nimcols-1)*margins
yused= nimrows*yimsize + (nimrows-1)*margins
xoffset= (8.5 -xused-2*margins)/2 + 0.675
yoffset= (9.25-yused-2*margins)/2 + 0.75
;
if (inputstring eq 'PREVIEW') then begin
	set_plot,'x'
	erase, 255
	!p.charsize=0.5
	scale=0.5
	font=1
endif else begin
	set_plot, 'ps'
	device, xoffset=0, yoffset=0, xsize=8.5, ysize=11, /inches, bits=8, $
		/times, /bold
	!p.charsize=1.0
	scale=1
	font=0
endelse
;
for i=1,nimcols do begin
for j=1,nimrows do begin
	PLOTIMAGE,i,j,dims,font,inputstring
endfor
endfor
;
PAGETITLES,font,scale
;
if (inputstring ne 'PREVIEW') then begin
	device, /close
	if (inputstring eq 'PRINT') then begin
		spawn, 'lp -o nobanner idl.ps' 
		spawn, '\rm idl.ps'
	endif else begin
		psname=''
		read, 'Enter desired directory/filename for PostScript file: ',psname
		if (strpos(psname,'.ps') eq -1) then psname = psname + '.ps'
		spawn, '\mv idl.ps ' + psname
	endelse
	set_plot,'x'
endif
;
return
end
;
;
;
;
;
FUNCTION CONTRAST,inputimage,imcol,imrow,filename,newimg_flag,reset_flag,reply
;
case n_params() of
	4:  newimg_flag='yes'
	3:  begin & newimg_flag='yes' & filename='' & end
	2:  begin & newimg_flag='yes' & filename='' & imrow=1 & end
	1:  begin & newimg_flag='yes' & filename='' & imrow=1 & imcol=1 & end
	else:
endcase
;
repeat begin
	processedimage=DISPLAY(inputimage,reset_flag,newimg_flag)
	reply=IMAGEMENU(imcol,imrow,filename,reset_flag)
endrep until (reply eq 'SAVE' or reply eq 'QUIT')
;
return,processedimage
end
;
;
;
;
;
PRO IMPROCESSOR,i,j,dims,reset_flag
;
common FM1, directory, filename, filetype, format, datatype, ncols, nrows, process_flag
;
if (n_elements(reset_flag) le 0) then reset_flag='yes'
;
ioerr=0
repeat begin
	repeat begin
		reply=FILEMENU(i,j,ioerr,reset_flag)
		if (reply eq 'ABORT') then begin
			print
			read, 'Are you sure you want to abort LASER8? ', reply
			if (strupcase(strmid(reply,0,1)) eq 'Y') then stop 
		endif
	endrep until (reply eq 'LOAD')
	;
	image=READFILE(ioerr)  ; Readfile returns ioerr=-1 if error occurs.
	if (process_flag eq 'on' and ioerr ne -1) then begin
		repeat begin
			newimg_flag='yes'
			if (i eq 1 and j eq 1) then reset_flag='yes'
			image=CONTRAST(image,i,j,filename,newimg_flag,reset_flag,reply)
		endrep until (reply eq 'SAVE' or reply eq 'QUIT')
	endif
endrep until (reply ne 'QUIT' and ioerr ne -1)
dims(*,j-1,i-1)=STOREFILE(image,i,j)  ; Storefile saves the image and returns its dims.
;
return
end
;
;
;
;
;
PRO REPROCESS,dims
;
coords=intarr(2)
;
on_ioerror,again
again: read,'Enter COLUMN,ROW of image to be redone: ',coords
;
IMPROCESSOR,coords(0),coords(1),dims,'no'
;
MULTIDISPLAY,dims,'PREVIEW'
return
end
;
;
;
;
;  ********************************************************************************
;
;                                   LASER8.PRO
;
;
;          designed to be significantly more modular than its predecessors
;           and hopefully more comprehensible to the peruser (and myself).
;
;
;
;                                  Eric T Swanson
;                                     8/27/91
;  ********************************************************************************
;
;
;
PRO LASER8
;
common FM1, directory, filename, filetype, format, datatype, ncols, nrows, process_flag
;
print
read, 'How many columns of images to display on this page? ', nimcols
read, 'How many images in each column? ', nimrows
dims=intarr(2,nimrows,nimcols)
;
ioerr=0
reset_flag='yes'
for i=1,nimcols do begin
for j=1,nimrows do begin
	repeat begin
		repeat begin
			reply=FILEMENU(i,j,ioerr,reset_flag)
			if (reply eq 'ABORT') then begin
				print
				read, 'Are you sure you want to abort LASER8? ', reply
				if (strupcase(strmid(reply,0,1)) eq 'Y') then stop 
			endif
		endrep until (reply eq 'LOAD')
		;
		image=READFILE(ioerr)  ; Readfile returns ioerr=-1 if error occurs.
		if (process_flag eq 'on' and ioerr ne -1) then begin
			repeat begin
				newimg_flag='yes'
				if (i eq 1 and j eq 1) then reset_flag='yes'
				image=CONTRAST(image,i,j,filename,newimg_flag,reset_flag,reply)
			endrep until (reply eq 'SAVE' or reply eq 'QUIT')
		endif
	endrep until (reply ne 'QUIT' and ioerr ne -1)
	dims(*,j-1,i-1)=STOREFILE(image,i,j)  ; Storefile saves the image and returns its 
                                            ; dims.
endfor
endfor
;
reset_flag='yes'
repeat begin
	reply=PRINTMENU(nimcols,nimrows,reset_flag)
	case reply of
		'PREVIEW':  MULTIDISPLAY,dims,reply
		'PRINT'  :  MULTIDISPLAY,dims,reply
		'SAVE'   :  MULTIDISPLAY,dims,reply
		'SWITCH' :  SWITCHIMS,dims
		'REDO'   :  REPROCESS,dims
		 else:
	endcase
endrep until (reply eq 'EXIT')
;
reset_flag='yes'
repeat begin
	reply=EXITMENU(reset_flag,ioerr)
	if (reply eq 'DONE') then ioerr=WRAPUP(nimcols,nimrows,dims)
endrep until (reply eq 'DONE' and ioerr eq 0)
;
end