home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / GFX / Converter / IMAFX26.lha / imagefx2 / rexx / BuildMPEG.ifx < prev    next >
Encoding:
Text File  |  1994-11-15  |  16.4 KB  |  647 lines
  1. /*
  2.  *  BuildMPEG, compile a list of images into an MPEG stream
  3.  *  using the Stanford codec
  4.  *
  5.  *  history
  6.  *
  7.  *  30/06/1994  TEK:  Minor change for IFX 2.0
  8.  *
  9.  *  18/04/1994  fixed problems with odd sized pictures
  10.  *
  11.  *  16/04/1994  fixed a few bugs
  12.  *
  13.  *  13/04/1994  added requester that shows why the codec might have failed
  14.  *              previously it just guessed memory problems
  15.  *              turned redraw off for loading and preprocessing
  16.  *
  17.  *  03/03/1994  added checks to avoid frozen script when the codec never started
  18.  *              (bad installation or memory problems)
  19.  *
  20.  *  28/01/1994  allows selection of a filter script to preprocess source frames
  21.  *              also cosmetic changes
  22.  *
  23.  *  02/01/1994  tries to handle user abort
  24.  *              should definitely work if aborted through 'waiting for activity'
  25.  *              period.
  26.  *
  27.  *  01/01/1994  first version
  28.  *
  29.  *  Copyright Michael van Elst 1994
  30.  *
  31.  *  This program is freely distributable, but copyrighted by me. This means
  32.  *  that you can copy it freely as long as you don't ask for any more money
  33.  *  than a nominal fee for copying. This program may be put on PD disks,
  34.  *  especially on Fred Fish's AmigaLibDisks.
  35.  *  This program cannot be used for commercial purposes without permission
  36.  *  from the author. The author can not be made responsible for any damage
  37.  *  which is caused by using this program.
  38.  *
  39.  *  This notice applies to the AREXX script, my changes to the MPEG codec
  40.  *  done by the Portable Video Research Group at Stanford and the resulting
  41.  *  executable contained in the BuildMPEG archive.
  42.  */
  43.  
  44. OPTIONS RESULTS
  45.  
  46. /*logging='>"con:3/12/500/400/MPEG Log/AUTO/WAIT/CLOSE/INACTIVE"'*/
  47. logging=''
  48. /*profiling='sc:c/lprof -t5'*/
  49. profiling=''
  50.  
  51. cleanup = nothing
  52. SIGNAL ON BREAK_C
  53.  
  54. CALL ADDLIB("rexxsupport.library",0,-30,0)
  55.  
  56. /**************************************
  57.  * Added by TEK  6/30/94:
  58.  */
  59. GetStatus AssignDir        /* IFX2.0: gives us it's assign */
  60. IF rc = 0 THEN
  61.    assign = result
  62. ELSE
  63.    assign = "IMAGEFX:"
  64. /**************************************/
  65.  
  66. /* TEK  11/15/94: */
  67. SetPrefs SaveNails Off
  68.  
  69. CALL DoRequesters
  70.  
  71. CALL MakeOptions
  72.  
  73. CALL MainLoop
  74.  
  75. /* TEK  11/15/94: */
  76. SetPrefs SaveNails On
  77.  
  78. EXIT
  79.  
  80. /*-------------------------------------------------------------------------
  81.  *
  82.  * auxiliary functions
  83.  *
  84.  *-------------------------------------------------------------------------*/
  85.  
  86. /*
  87.  * check if argument is a positive integer
  88.  * if not then return default
  89.  */
  90. NumDefault:
  91.     procedure
  92.     parse arg input,low,high,default
  93.  
  94.     if ~datatype(input,'w') | input<low | input>high
  95.         then return default
  96.         else return input
  97.  
  98. /*
  99.  * display an information requester with no special symbols in strings
  100.  */
  101. MyNotify:
  102.     procedure
  103.     parse arg prompt
  104.  
  105.     string = ""
  106.     do until i=0
  107.         i = pos('%',prompt)
  108.         if i>0 then do
  109.             string = string || left(prompt,i) || '%'
  110.             prompt = substr(prompt,i+1)
  111.             end
  112.         else
  113.             string = string || prompt
  114.     end
  115.  
  116.     requestnotify string
  117.     return
  118.  
  119. /*
  120.  * ensure reasonable defaults
  121.  */
  122. EnsureDefaults:
  123.     bitrate    = numdefault(bitrate,0,100000,1200)
  124.     ffirst     = numdefault(ffirst,0,999999,1)
  125.     flast      = numdefault(flast,0,999999,10)
  126.     finterval  = numdefault(finterval,0,99,3)
  127.     ginterval  = numdefault(ginterval,0,99,2)
  128.     framerate  = numdefault(framerate,1,8,3)
  129.     targetsize = numdefault(targetsize,0,10000000,0)
  130.     xingflag   = numdefault(xingflag,0,1,0)
  131.     msdiameter = numdefault(msdiameter,1,15,15)
  132.     intramode  = numdefault(intramode,0,1,0)
  133.     precisedct = numdefault(precisedct,0,1,0)
  134.     telescope  = numdefault(telescope,0,1,1)
  135.     bounding   = numdefault(bounding,0,1,0)
  136.     mvpredict  = numdefault(mvpredict,0,1,0)
  137.     quantizer  = numdefault(quantizer,0,31,0)
  138.     return
  139.  
  140. /*
  141.  * format a positive integer to have at least n digits
  142.  */
  143. MakeDigits:
  144.     procedure
  145.     arg v,n
  146.  
  147.     l = length(v)
  148.     do while l<n
  149.         v = "0"v
  150.         l = l+1
  151.     end
  152.  
  153.     return v
  154.  
  155. /*
  156.  * trim quotes from a string
  157.  */
  158. TrimQuotes:
  159.     procedure
  160.     parse arg in
  161.  
  162.     l = length(in)
  163.  
  164.     if l>1 & left(in,1)='"' & right(in,1)='"'
  165.         then out = substr(in,2,l-2)
  166.         else out = in
  167.  
  168.     return out
  169.  
  170. /*-------------------------------------------------------------------------
  171.  *
  172.  * parameter requesters
  173.  *
  174.  *-------------------------------------------------------------------------*/
  175.  
  176. DoRequesters:
  177.  
  178. /*
  179.  * fetch last parameters
  180.  */
  181. inpattern  = GETCLIP('MPEG_In')
  182. ffirst     = GETCLIP('MPEG_FirstFrame')
  183. flast      = GETCLIP('MPEG_LastFrame')
  184. outfile    = GETCLIP('MPEG_Out')
  185. finterval  = GETCLIP('MPEG_FInterval')
  186. ginterval  = GETCLIP('MPEG_GInterval')
  187. framerate  = GETCLIP('MPEG_Framerate')
  188. bitrate    = GETCLIP('MPEG_Bitrate')
  189. targetsize = GETCLIP('MPEG_Targetsize')
  190. xingflag   = GETCLIP('MPEG_Xingflag')
  191. cscript    = GETCLIP('MPEG_Controlscript')
  192. msdiameter = GETCLIP('MPEG_MSDiameter')
  193. intramode  = GETCLIP('MPEG_Intramode')
  194. precisedct = GETCLIP('MPEG_PreciseDCT')
  195. telescope  = GETCLIP('MPEG_MVTelescoping')
  196. bounding   = GETCLIP('MPEG_DMVBounding')
  197. mvpredict  = GETCLIP('MPEG_MVPrediction')
  198. quantizer  = GETCLIP('MPEG_Quantization')
  199. fscript    = GETCLIP('MPEG_FilterScript')
  200.  
  201. CALL EnsureDefaults
  202.  
  203. fpsstring = '23.51fps 24fps 25fps 25.50fps 30fps 50fps 59.94fps 60fps'
  204. if framerate>1 then
  205.     gadstring = subword(fpsstring,framerate,words(fpsstring)-framerate+1) || ,
  206.                 " " || subword(fpsstring,1,framerate-1)
  207. else
  208.     gadstring = fpsstring
  209. gadstring = translate(gadstring,"/"," ")
  210.  
  211. Gadget.1  = 'S/125/20/Input Pattern:/'inpattern
  212. Gadget.2  = 'I/330/20/From:/'ffirst
  213. Gadget.3  = 'I/430/20/To:/'flast
  214. Gadget.4  = 'S/125/35/Output Filename:/'outfile
  215. Gadget.5  = 'I/125/50/Frame Interval:/'finterval
  216. Gadget.6  = 'I/125/65/Group Interval:/'ginterval
  217. Gadget.7  = 'C/430/35/ /8/'gadstring
  218. Gadget.8  = 'L/348/38/1/1/Frame rate:'
  219. Gadget.9  = 'I/430/50/Bit rate:/'bitrate
  220. Gadget.10 = 'I/430/65/Target size:/'targetsize
  221. Gadget.11 = 'X/85/82/×ING Override/'xingflag
  222. Gadget.12 = 'X/255/82/Query Advanced Options.../0'
  223.  
  224. Extras.1  = 'X/20/20/DC intraframe mode/'intramode
  225. Extras.2  = 'X/20/35/Use Precise DCT/'precisedct
  226. Extras.3  = 'S/130/80/Control Script:/'cscript
  227. Extras.4  = 'X/280/20/Motion Vector Telescoping/'telescope
  228. Extras.5  = 'X/280/35/Dynamic Motion Vector Bounding/'bounding
  229. Extras.6  = 'X/280/50/Motion Vector prediction/'mvpredict
  230. Extras.7  = 'I/420/65/Search diameter:/'msdiameter
  231. Extras.8  = 'I/420/80/Quantization:/'quantizer
  232. Extras.9  = 'S/130/65/IFX Filter:/'fscript
  233.  
  234. ComplexRequest '"MPEG Compiler"' 12 Gadget 540 120
  235. IF rc ~= 0 then EXIT
  236.  
  237. /* fetch parameters back from requester */
  238. inpattern  = result.1
  239. ffirst     = result.2
  240. flast      = result.3
  241. outfile    = result.4
  242. finterval  = result.5
  243. ginterval  = result.6
  244. fpsindex   = result.7
  245. bitrate    = result.9
  246. targetsize = result.10
  247. xingflag   = result.11
  248. advanced   = result.12
  249.  
  250. framerate  = (fpsindex + (framerate-1)) // words(fpsstring) + 1
  251.  
  252. if advanced then do
  253.     ComplexRequest '"MPEG Advanced Options"' 9 Extras 540 120
  254.     if rc ~= 0 then EXIT
  255.     /* fetch parameters back from requester */
  256.     intramode  = result.1
  257.     precisedct = result.2
  258.     cscript    = result.3
  259.     telescope  = result.4
  260.     bounding   = result.5
  261.     mvpredict  = result.6
  262.     msdiameter = result.7
  263.     quantizer  = result.8
  264.     fscript    = result.9
  265. end
  266.  
  267. CALL EnsureDefaults
  268.  
  269. CALL SETCLIP('MPEG_In',            inpattern)
  270. CALL SETCLIP('MPEG_FirstFrame',    ffirst)
  271. CALL SETCLIP('MPEG_LastFrame',     flast)
  272. CALL SETCLIP('MPEG_Out',           outfile)
  273. CALL SETCLIP('MPEG_FInterval',     finterval)
  274. CALL SETCLIP('MPEG_GInterval',     ginterval)
  275. CALL SETCLIP('MPEG_Framerate',     framerate)
  276. CALL SETCLIP('MPEG_Bitrate',       bitrate)
  277. CALL SETCLIP('MPEG_Targetsize',    targetsize)
  278. CALL SETCLIP('MPEG_Xingflag',      xingflag)
  279. CALL SETCLIP('MPEG_Controlscript', cscript)
  280. CALL SETCLIP('MPEG_MSDiameter',    msdiameter)
  281. CALL SETCLIP('MPEG_Intramode',     intramode)
  282. CALL SETCLIP('MPEG_PreciseDCT',    precisedct)
  283. CALL SETCLIP('MPEG_MVTelescoping', telescope)
  284. CALL SETCLIP('MPEG_DMVBounding',   bounding)
  285. CALL SETCLIP('MPEG_MVPrediction',  mvpredict)
  286. CALL SETCLIP('MPEG_Quantization',  quantizer)
  287. CALL SETCLIP('MPEG_FilterScript',  fscript)
  288.  
  289. /*
  290.  * split input pattern
  291.  */
  292.  
  293. csep = pos(':',inpattern)
  294. ssep = lastpos('/',inpattern)
  295. if ssep>0 & ssep>csep then do
  296.         directory  = left(inpattern,ssep)
  297.         infilename = substr(inpattern,ssep+1)
  298.         end
  299. else if csep>0 & csep>ssep then do
  300.         directory  = left(inpattern,csep)
  301.         infilename = substr(inpattern,csep+1)
  302.         end
  303. else do
  304.         directory  = ""
  305.         infilename = inpattern
  306. end
  307.  
  308. csep = pos('%',infilename)
  309. if csep>0 then do
  310.     ssep=csep+1
  311.     do while substr(infilename,ssep,1)='%'
  312.         ssep = ssep+1
  313.     end
  314.     inprefix = left(infilename,csep-1)
  315.     insuffix = substr(infilename,ssep)
  316.     indigits = ssep-csep
  317.     end
  318. else do
  319.     inprefix = infilename
  320.     insuffix = ""
  321.     indigits = 1
  322. end
  323.  
  324. return
  325.  
  326. /*-------------------------------------------------------------------------
  327.  *
  328.  * run a user command or script
  329.  *
  330.  *-------------------------------------------------------------------------*/
  331.  
  332. UserScript:
  333.  
  334. if pos(':',fscript)>0 then
  335.     filterfile = fscript
  336. else
  337.     filterfile = assign||"mpegfilters/"fscript
  338.  
  339. if open('filter',filterfile,'r') then do
  340.     rx quiet filterfile
  341.     call close('filter')
  342.     end
  343. else if open('filter',filterfile'.ifx','r') then do
  344.     rx quiet filterfile".ifx"
  345.     call close('filter')
  346.     end
  347. else
  348.     rxs fscript
  349.  
  350. return
  351.  
  352. /*-------------------------------------------------------------------------
  353.  *
  354.  * automatically preformat for XING files
  355.  *
  356.  *-------------------------------------------------------------------------*/
  357.  
  358. XingPreProc:
  359.  
  360. GetMain ; if result="" then EXIT
  361. parse VAR result name width height depth .
  362. if width ~= 160 | height ~= 120 then
  363.     scale 160 120
  364.  
  365. return
  366.  
  367.  
  368. /*-------------------------------------------------------------------------
  369.  *
  370.  * create command line options for Stanford CODEC
  371.  *
  372.  *-------------------------------------------------------------------------*/
  373.  
  374. MakeOptions:
  375.  
  376. command = assign||"mpeg/mpeg"
  377. opts    = "-PF" "-a" ffirst "-b" flast
  378.  
  379. check=statef(command)
  380. parse var check typ len blocks perm .
  381. if typ ~= "FILE" | substr(perm,7,1) ~= 'E' then do
  382.     call MyNotify("Sorry, can't find "command" or wrong permissions.")
  383.     EXIT
  384. end
  385.  
  386. if xingflag then
  387.     opts = opts "-XING"
  388. else do
  389.     if cscript ~= "" then do
  390.         if pos(':',cscript)>0 then
  391.             controlfile = cscript
  392.         else
  393.             controlfile = assign||"mpegcontrol/"cscript
  394.         command = command '<"'controlfile'"'
  395.         opts = opts "-o"
  396.     end
  397.     if ~telescope then opts = opts "-NVNT"
  398.     if bounding   then opts = opts "-DMVB"
  399.     if intramode  then opts = opts "-4"
  400.     if mvpredict  then opts = opts "-c"
  401.     if precisedct then opts = opts "-y"
  402.     if finterval>0  then opts = opts "-f" finterval
  403.     if ginterval>0  then opts = opts "-g" ginterval
  404.     if msdiameter>0 then opts = opts "-i" msdiameter
  405.     if bitrate>0    then opts = opts "-r" bitrate*1024
  406.     if framerate>0  then opts = opts "-p" framerate
  407.     if quantizer>0  then opts = opts "-q" quantizer
  408.     if targetsize>0 then opts = opts "-x" targetsize*8192
  409. end
  410.  
  411. id = random(100,999,time('s'))
  412. pipename = "PIPE:"address()"."id"="
  413. portname = "IFX_BuildMPEGServer."id
  414. statfile = 'T:CODE.return_status.'id
  415.  
  416. opts = opts "-REXX" portname||":"||mpeg
  417.  
  418. if outfile = "" then do
  419.     requestnotify "Sorry, you must given an output filename"
  420.     EXIT
  421.     end
  422.  
  423. /*
  424.  * preload first frame to determine size or
  425.  * to check size against XING values
  426.  */
  427. lastbuf  = directory||inprefix||makedigits(ffirst,indigits)||insuffix
  428. redraw off
  429. loadbuffer lastbuf FORCE
  430. if rc>0 then do
  431.     redraw on
  432.     requestnotify "Failed to preload first frame"
  433.     EXIT 10
  434.     end
  435. CALL UserScript
  436. if xingflag then CALL XingPreProc
  437. redraw on
  438.  
  439. GetMain ; if result="" then EXIT
  440. parse VAR result name width height depth .
  441. /* round size up, YUVSPLIT does the same */
  442. if (width // 2) > 0 then width = width + 1
  443. if (height // 2) > 0 then height = height + 1
  444.  
  445. if xingflag then
  446. do
  447.     if width ~= 160 | height ~= 120 then do
  448.         requestnotify "XING frames need to be of size 160x120 pixel"
  449.         EXIT
  450.         end
  451. end
  452. else
  453.     opts = opts "-h" width "-v" height
  454.  
  455. opts = opts "-s" '"'outfile'"' '"'pipename'"'
  456.  
  457. mpegcommand = command opts
  458.  
  459. return
  460.  
  461. /*-------------------------------------------------------------------------
  462.  *
  463.  * run the codec program and feed it with data
  464.  *
  465.  *-------------------------------------------------------------------------*/
  466.  
  467. MainLoop:
  468.  
  469. LockInput
  470. Undo Off
  471.  
  472. cleanup = "restoreifx"
  473.  
  474. nullptr  = '00000000'x
  475.  
  476. port = openport(portname);
  477. if port = nullptr then do
  478.     call MyNotify("can't create server port '" portname "'")
  479.     exit
  480. end
  481.  
  482. packet  = "xx"
  483. cleanup = "flushcodec"
  484. CALL SETCLIP('MPEG_PipeName',"")
  485. message "Running CODEC in the background"
  486. pre      = 'failat 99'
  487. post1    = 'get RC >'statfile
  488. post2    = 'rx "address '''portname''' x FAIL"'
  489. sep      = '+'x2c('0a')
  490. address command "run" logging pre sep profiling mpegcommand sep post1 sep post2
  491. if rc>0 then do
  492.     call MyNotify("can't create background process")
  493.     exit
  494. end
  495. framenumber = 1
  496.  
  497. do until subcommand = "FAIL"
  498.     cleanup = "flushcodec"
  499.     message "Waiting for activity on frame "framenumber
  500.     call waitpkt portname
  501.     do until packet=nullptr
  502.         packet = getpkt(portname);
  503.         if packet ~= nullptr then
  504.         do
  505.             command = getarg(packet,0)
  506.  
  507.             call reply packet, 0            /* should be atomic */
  508.             packet = nullptr
  509.  
  510.             parse var command prefix subcommand filespec x y .
  511.             CALL SETCLIP('MPEG_PipeName',filespec)
  512.             select
  513.                 when subcommand = "LoadMem" then do
  514.                     /* filespec is something like:  PIPE:ident.random=framenr.Y */
  515.                     csep = lastpos('=',filespec)
  516.                     ssep = lastpos('.',filespec)
  517.                     filetype = substr(filespec,ssep+1,1)
  518.                     framenumber = substr(filespec,csep+1,ssep-csep-1)
  519.                     framenumber = makedigits(framenumber,indigits)
  520.  
  521.                     message "pushing "filetype" data for frame "framenumber
  522.  
  523.                     newbuf = directory||inprefix||framenumber||insuffix
  524.                     if lastbuf ~= newbuf then do
  525.                         redraw off
  526.                         loadbuffer newbuf FORCE
  527.                         if rc>0 then do
  528.                             requestnotify "Failed to read frame"||framenumber
  529.                             SIGNAL BREAK_C
  530.                         end
  531.                         CALL UserScript
  532.                         if xingflag then CALL XingPreProc
  533.                         redraw on
  534.                         lastbuf = newbuf
  535.                     end
  536.                     GetMain ; if result="" then SIGNAL BREAK_C
  537.                     parse VAR result name width height depth .
  538.                     /* round size up, YUVSPLIT does the same */
  539.                     if (width // 2) > 0 then width = width + 1
  540.                     if (height // 2) > 0 then height = height + 1
  541.                     if filetype ~= 'Y' then do
  542.                         width  = width/2
  543.                         height = height/2
  544.                     end
  545.  
  546.                     /* this check fails when the framesize is not constant
  547.                      * or a load failed (then width=height=0)
  548.                      */
  549.                     if width ~= x | height ~= y then do
  550.                         /* then we push an empty file which will
  551.                          * make the codec abort
  552.                          */
  553.                            filename = trimquotes(filespec)
  554.                         call open('push',filename,'w')
  555.                         call writeln('push',"STOP")  /* some dummy data */
  556.                         call close('push')
  557.                         end
  558.                     else
  559.                         savebufferas YUVSPLIT filespec filetype
  560.                 end
  561.                 when subcommand = "EXIT" then
  562.                     cleanup = "restoreifx"
  563.                 when subcommand = "FAIL" then do
  564.                     end
  565.                 otherwise
  566.                     call MyNotify("unknown command" subcommand)
  567.  
  568.             end
  569.         end
  570.     end
  571. end
  572.  
  573. code="Out of memory ?"
  574. if open('result',statfile,'r') then do
  575.     code = readln('result')
  576.     call close('result')
  577.     select
  578.         when code=0  then code=0
  579.         when code=1  then code="Input values out of bounds."
  580.         when code=2  then code="Huffman decoder finds bad code."
  581.         when code=3  then code="Undefined value in encoder."
  582.         when code=4  then code="Error found in Marker."
  583.         when code=5  then code="Cannot initialize MPEG stream."
  584.         when code=6  then code="No recovery mode specified."
  585.         when code=7  then code="End of file unexpected."
  586.         when code=8  then code="Bad marker structure."
  587.         when code=9  then code="Cannot write output."
  588.         when code=10 then code="Cannot read input."
  589.         when code=11 then code="System parameter Error."
  590.         when code=12 then code="Memory allocation failure."
  591.         otherwise         code="General failure."
  592.     end
  593. end
  594. if code~=0 then call MyNotify("MPEG encoder failed. "||code)
  595. message "done"
  596.  
  597. call closeport(port);
  598. address command "delete force file " statfile
  599.  
  600. UnlockInput
  601. Undo On
  602.  
  603. return
  604.  
  605. /*-------------------------------------------------------------------------
  606.  *
  607.  * cleaning up
  608.  *
  609.  *-------------------------------------------------------------------------*/
  610.  
  611. BREAK_C:
  612.  
  613. /*
  614.  * beware.. we can't handle another break_c at this point
  615.  */
  616.  
  617. select
  618.     when cleanup="restoreifx" then do
  619.         call closeport(port)
  620.         UnlockInput
  621.         Undo On
  622.         end
  623.     when cleanup="flushcodec" then do
  624.         call closeport(port)            /* let all requests fail immediatly */
  625.         if (filespec ~= "") then do
  626.             filename = trimquotes(filespec)
  627.             if ~open('tryme',filename,'r') then do
  628.                 if open('push',filename,'w') then do
  629.                     call writeln('push',"STOP")  /* some dummy data */
  630.                     call close('push')
  631.                     end
  632.                 else
  633.                     requestnotify "pushing data failed. Possible Hangup."
  634.                 end
  635.             else do
  636.                 call close('tryme')
  637.             end
  638.         end
  639.         UnlockInput
  640.         Undo On
  641.         end
  642.     otherwise
  643.         NOP
  644. end
  645.  
  646. EXIT
  647.