pro Make_mpeg, filename, destdir, times=times, scratchdir=scratchdir, $
               table=table, range=range, ncolours=ncolours, $
               names=names, rescale=rescale

;+
; MAKE_MPEG
;
; Usage:
;	make_mpeg, filename[, destdir]
;
; Arguments:
;	filename string	input	The name of the MPEG file (if not
;				given, then use lasco.mpg).
;	destdir	string	input	The name of the directory in which to
;				put the mpeg file. (If not given then
;				use: ${LASCO_WORK}/${USER}/gif)
;
; Keywords:
;	times	int	input	If set, then put the time on the
;				frames before dumping them. (1 -
;				bottom left, 2 - bottom right, 3 - top
;                                                left, 4 - bottom right)
;	scratchdir string in	The directory to which to write the gif
;				files (default = destdir)
;	table	int	input	The colour table to use
;	range	float	input	The range of image values to display
;				(default min & max of first image)
;	ncolours int	input	The number of colours to use in each
;				frame (Default !d.table_size) N.B. if
;				this key is set, then TABLE must be
;				set as well.
;	names	int	input	If set, put the names of the input
;				files on the files before dumping them
;				(same code as time and note it's not
;				clever enough to check if they are
;				going on top of each other)
;	rescale	int	input	The rescaling factor (-n = increase by
;				2^n, +n = decrease by 2^n)
; Method:
;	Saves the selected images as PPM (Portable PixMap) format
;	files and then spawns "mpeg_encode" to convert them to an MPEG
;	file (the PPM files are deleted after the operation)
;
; Restrictions:
;	1) Can handle a maximum of 1000 frames
;	2) Must have MPEG_ENCODE available.
;	3) Any prexisting files called Lnnn.ppm or MPEG.PARAM will be
;		overwritten.
;
; History:
;	Original: 23/7/96; SJT
;	Change from GIF to PPM: 25/7/96; SJT
;-

@chandle.com
@wload.com
common Colors

if (n_elements(sel_img) ne n_elements(h_array)) then $
  message, 'Corrupted image selection information'

if (n_elements(table) eq 0 and n_elements(ncolours) ne 0) then  $
  message, "Must specify a colour table if you give a number of " + $
  "colours"

if (n_params() ne 2) then begin
    lasco_work = getenv('LASCO_WORK')
    if (lasco_work eq '') then lasco_work = getenv('WORK')
    destdir = lasco_work+!Delimiter+getenv('USER')+ $
      !Delimiter+'gif'+!Delimiter
    if (n_params() eq 0) then filename = 'lasco.mpg'
endif

if (n_elements(scratchdir) eq 0) then scratchdir = destdir

sel_array = where(sel_img, nsel)      ; This should already be done but play
                                ; safe.

param = [ $
          'PATTERN		IBBPBBI', $
          '@@', $
          'BASE_FILE_FORMAT	PPM', $
          'INPUT_CONVERT *', $
          'GOP_SIZE	6', $
          'SLICES_PER_FRAME	1', $
          'INPUT_DIR	.', $
          'INPUT', $
          '++', $
          'END_INPUT', $
          'PIXEL		HALF', $
          'RANGE		10', $
          'PSEARCH_ALG	LOGARITHMIC', $
          'BSEARCH_ALG	CROSS2', $
          'IQSCALE		8', $
          'PQSCALE		10', $
          'BQSCALE		25', $
          'REFERENCE_FRAME	ORIGINAL' $
        ]

;;openr, ilui, /get, '/base/soho/etc/mpeg.param' ; Template MPEG
                                ; parameter file
openw, iluo, /get, scratchdir+'MPEG.PARAM'

;;line = ''
;;while (not eof(ilui)) do begin  ; Copy the file and add the file names
;;    readf, ilui, line
for j = 0, n_elements(param)-1 do begin
    if (param(j) eq '@@') then printf, iluo, 'OUTPUT		' + $
      destdir+filename $
    else if (param(j) eq '++') then printf, iluo, 'L*.ppm  [000-', nsel-1, $
      ']', format = "(A,I3.3,A)" $
    else printf, iluo, param(j)
endfor

;;free_lun, ilui
free_lun, iluo

if (keyword_set(rescale)) then scale_fac = 2.^(-rescale) $
else scale_fac = 1.

for j = 0, nsel-1 do begin      ; Save each image as a gif with
                                ; optional times &| names.
    ghandle, sel_array(j)
    print, j, sel_array(j),'      ', name
    
    if (j eq 0) then begin
        ss = sz(1:2)*scale_fac
        window, /free, /pixmap, xs = ss(0), ys = ss(1)
        if (keyword_set(ncolours)) then begin
            if (ncolours gt !D.table_size) then message, /inform, $
              "WARNING - number of colours requested is too big, using " + $
              "table size"
            nc = ncolours < !D.table_size
            loadct, table, nc
        endif else begin
            nc = !d.table_size
            if (n_elements(table) ne 0) then loadct, table
        endelse
        
        ff = 255./[max(r_curr), max(g_curr), max(b_curr)]
        if (n_elements(range) eq 0) then range = [min(image, max = mx), mx]
    endif
    
    imb = bytscl(rebin(image, ss(0), ss(1)), min = range(0), max = $
                       range(1), top = nc-1)
    tv, imb
    
    if (keyword_set(times)) then begin
        date = '!5'+sxpar(head, 'DATE-OBS') + ' ' $
          + sxpar(head, 'TIME-OBS')+'!3'
        if (times le 2) then ty = 0.05 $
        else ty = 0.93
        if (times eq 2 or times eq 4) then begin
            tx = 0.95
            alg = 1.
        endif else begin
            tx = 0.05
            alg = 0.
        endelse
        
        xyouts, /norm, tx, ty, date, align = alg, charsize = 1.25
    endif
    
    if (keyword_set(names)) then begin
        if (names le 2) then ty = 0.05 $
        else ty = 0.93
        if (names eq 2 or names eq 4) then begin
            tx = 0.95
            alg = 1.
        endif else begin
            tx = 0.05
            alg = 0.
        endelse
        
        xyouts, /norm, tx, ty, '!5'+name+'!3', align = alg, charsize = 1.25
    endif
    
    imc = tvrd(/order)
    imt = bytarr(3, ss(0), ss(1))
    imt(0, *, *) = round(r_curr(imc)*ff(0))
    imt(1, *, *) = round(g_curr(imc)*ff(1))
    imt(2, *, *) = round(b_curr(imc)*ff(2))
    
    fn = scratchdir+string(j, format = "('L',I3.3,'.ppm')")
    write_ppm, fn, imt
endfor

print, "PPMs written"

cd, scratchdir, curr = here
cmd = 'mpeg_encode MPEG.PARAM'
spawn, cmd

spawn, 'rm L???.ppm MPEG.PARAM'

cd, here

end