;+ ; NAME: ; SMEI_SEQUENCE::MAKE_MPEG ; ; ; PURPOSE: ; Generates an mpeg movie from a SMEI sequence ; ; ; CATEGORY: ; SMEI_SEQUENCE ; ; ; CALLING SEQUENCE: ; seqref -> make_mpeg, file ; ; ; INPUTS: ; file string The name of the file to which to write the MPEG ; ; ; KEYWORD PARAMETERS: ; compress int The compression level (0..3) ; quality int The quality setting [01] ; multiplex int The number of times to repeat each ; image to get a sensible speed. ; /no_progress If set, then disable the progress bars (useful ; if slow network means the progress bars are ; slowing operation). ; /no_delete If set, then don't delete the image files. ; ; ; RESTRICTIONS: ; Requires that mpeg_encode and pngtopnm or pngtoppm be ; installed on the system. ; ; ; MODIFICATION HISTORY: ; Original (from LASCO original by JW): 18/12/02; SJT ; Skip hidden frames: 13/6/03; SJT ; Use IDL's WRITE_PPM if no PNG->PPM converter found: 31/3/04; SJT ; Add no_progress keyword: 25/8/05; SJT ; Add no_delete keyword: 13/12/12; SJT ;- pro smei_sequence::make_mpeg, mpegfilename, compress = compress, $ quality = quality, multiplex = $ multiplex, no_progress = no_progress, $ no_delete = no_delete if n_elements(compress) eq 0 then ascale = '8' $ else ascale = (['4', '8', '16', '24'])[compress] if n_elements(quality) eq 0 then quality = 1 aref = (['ORIGINAL', 'DECODED'])[quality] if n_elements(multiplex) eq 0 then multiplex = 1 ; Verify existence of mpeg_encode if not have_command("mpeg_encode") then begin smei_msg, /alert, ['mpeg_encode was not found', $ 'please install it if you', $ 'wish to make mpeg movies'] return endif ; ** get png converter ppmflag = 0b if not have_command("pngtoppm") then begin if not have_command("pngtopnm") then begin smei_msg, /warn, ['No suitable image format converter', $ 'found; please install one of the PBM', $ 'software suites if you want colour movies'] ppmflag = 1b convert_type = 'PPM' endif convert_type = 'PNM' converter = 'pngtopnm' endif else begin convert_type = 'PPM' converter = 'pngtoppm' endelse sz = (self -> get_first()) -> get_size() nframes = self -> get_count() ndigits = 1+fix(alog10(nframes)) formatstring = strcompress('(i'+string(ndigits)+'.'+string(ndigits)$ + ')', /remove_all) ; Load current color table into byte arrays red = self -> get_colour_map(/red) green = self -> get_colour_map(/green) blue = self -> get_colour_map(/blue) on_ioerror, badwrite write = file_test('./', /write) if (write ne 1) then dir = '/tmp/' else dir = './' tmpdir = dir+'idl2mpeg.frames'+string(systime(1), format = "('_',I0)") file_mkdir, tmpdir ; write each frame into tmpdir as an 8-bit .png image file namelist = strarr(nframes) im = self -> get_first() framenum = 0 owindow = self -> get_window() window, /free, /pixmap, xsize = sz[0], ysize = sz[1] pwindow = !d.window if not widget_info(/active) or keyword_set(no_progress) then isprog = $ 0b $ else isprog = 1b if isprog then $ pid = cw_progress(/column, $ title = 'Saving frames', $ xsize = 200, $ ysize = 20, $ value = 0., $ max = nframes) $ else pid = 0l ispid = widget_info(/valid, pid) if ppmflag then ext = '.ppm' $ else ext = '.png' while obj_valid(im) do begin if not im -> get_pflags(/skip) then begin namelist[framenum] = 'frame.' + string(framenum, format = $ formatstring) + ext filename = tmpdir + '/'+namelist[framenum] im -> show, window = pwindow wset, pwindow if ppmflag then begin img = tvrd(true = 1, /order) write_ppm, filename, img endif else if !d.n_colors le 256 then begin img = tvrd() write_png, filename, img, red, green, blue endif else begin img = tvrd(true = 1) write_png, filename, img endelse framenum = framenum+1 if ispid then widget_control, pid, set_value = framenum endif else nframes = nframes-1 im = im -> get_next() endwhile wdelete, pwindow if ispid then widget_control, pid, /destroy device, window_state = wstat if owindow ne -1 && wstat[owindow] then wset, owindow frate = '24' ; Build the mpeg parameter file first = string(0, format = formatstring) last = string(nframes-1, format = formatstring) paramfile = tmpdir + '/idl2mpeg.params' openw, unit, paramfile, /get_lun printf, unit, 'PATTERN IBBPBBPBBPBB' printf, unit, 'OUTPUT ' + mpegFileName printf, unit, 'GOP_SIZE 12' printf, unit, 'SLICES_PER_FRAME 1' printf, unit, 'BASE_FILE_FORMAT '+convert_type if ppmflag then printf, unit, 'INPUT_CONVERT *' $ else printf, unit, 'INPUT_CONVERT ' + converter + ' *' printf, unit, 'INPUT_DIR '+TMPDIR printf, unit, 'INPUT' for j = 0, nframes-1 do for i = 0, multiplex-1 do $ printf, unit, namelist[j] printf, unit, 'END_INPUT' printf, unit, 'PIXEL HALF' printf, unit, 'RANGE 8' printf, unit, 'PSEARCH_ALG LOGARITHMIC' printf, unit, 'BSEARCH_ALG SIMPLE' printf, unit, 'IQSCALE '+ascale printf, unit, 'PQSCALE '+ascale printf, unit, 'BQSCALE '+ascale printf, unit, 'FRAME_RATE '+frate printf, unit, 'REFERENCE_FRAME '+aref printf, unit, 'FORCE_ENCODE_LAST_FRAME' free_lun, unit if widget_info(/active) then $ pid = cw_progress(/column, $ title = 'Encoding movie', $ xsize = 200, $ ysize = 20, $ value = 0., $ max = nframes*multiplex) $ else pid = 0l ispid = widget_info(/valid, pid) ; spawn a shell to process the mpeg_encode command if ispid then begin spawn, 'mpeg_encode ' + paramfile, unit = ilu inln = '' while not eof(ilu) do begin readf, ilu, inln if strpos(inln, 'FRAME') eq 0 then begin nos = stregex(inln, '[0-9]+', /extract) widget_control, pid, set_value = $ nos[0] endif endwhile endif else spawn, 'mpeg_encode ' + paramfile ; clean temp dir if ~keyword_set(no_delete) then begin file_delete, tmpdir + '/'+namelist, paramfile file_delete, tmpdir endif if ispid then widget_control, pid, /destroy return badwrite: smei_msg, /alert, 'Unable to write MPEG file!' end