Return to Revisions

Here is a proof-of-concept for doing this on Linux (and maybe Mac). I've looked around and I haven't seen any previous example of how to do this in MMA. Perhaps the comments will enlighten me as to prior work.

The function below accepts a (pure/stateless) function f: Any -> Graphics together with a list of values times. It spawns an ffmpeg subprocess (ffmpeg should be on the path), and then proceeds to loop over the values in times. For each value, it calls f to generate a frame, which it then rasterizes and feeds to the ffmpeg process via a fifo/named pipe. This way, there's at most one frame in memory at a time. When all frames have been fed to ffmpeg, the fifo is closed, which signals ffmpeg to conclude its business.

The code currently suffers from some caveats:

1. It's been tested on linux only. It may work as-is on Mac. It does not work as-is on windows.
2. The encoding parameters are of course debatable. I prefer to force periodic keyframes because, though it makes the file substantially larger, it makes "scrubbing" smoother when using my media player. I tend to do that a lot with technical animations.
3. The code isn't particularly elegant.

If you have the skills and interest, I encourage you to whip this code into shape and share it with the community. Please, don't forget the progress indicator -- It's the least important thing and what I miss most.

My thanks to [1] for guidance.

[1] https://stackoverflow.com/questions/51903888/is-it-possible-to-send-ffmpeg-images-by-using-pipe

Implementation

EncodeMyVideo[frameGraphicFun_, times_, outputFile_, rasterWidth_, 
  fps_ : 24, keyframeInterval_ : 24, videoBitrate_ : "2500k", 
  batchSize_ : Max[$ProcessorCount, Min[16, $ProcessorCount*4]]] := 
 Block[{
   fifoName = 
    FileNameJoin[{$TemporaryDirectory, "fifo." <> CreateUUID[]}],
   rasterHeight = 
    ImageAspectRatio[frameGraphicFun[times[[1]]]]*rasterWidth // N // 
     Ceiling,
   templateCtx,
   templateBody,
   stdout, cmd, process, bst, i = 1, progressMessage, messageCell, 
   result
   },
  templateCtx =
   <|
    "width" -> ToString[rasterWidth],
     "height" -> ToString[rasterHeight],
    "fps" -> ToString[fps],
    "fifoName" -> fifoName,
    "keyframeInterval" -> keyframeInterval,
    "videoBitrate" -> videoBitrate
    |>;
  templateBody = 
   "ffmpeg -hide_banner -nostats -loglevel 24 -y -f rawvideo -pix_fmt \
rgb24 -s `width`x`height` -r `fps` -i `fifoName` -c:v libx264 -b:v \
`videoBitrate` -x264-params keyint=`keyframeInterval` -an";
  RunProcess[{"mkfifo", fifoName}];
  WithCleanup[
   cmd = (TemplateApply[templateBody, templateCtx] // StringSplit)~
     Join~{outputFile}; 
   process = StartProcess[cmd]; 
   bst = OpenWrite[fifoName, BinaryFormat -> True];
    
   progressMessage = 
    "Encoding Frame " <> ToString[i] <> "/" <> ToString[Length[times]];
   messageCell = PrintTemporary[Dynamic[progressMessage]];
   Scan[( 
      frames = 
       ParallelMap[
        Rasterize[frameGraphicFun[#], 
          RasterSize -> {rasterWidth, rasterHeight}] &, #];
      (*frames =Rasterize[frameGraphicFun[#],
      RasterSize\[Rule]{rasterWidth,rasterHeight}]&/@#;*)
      Scan[( 
         progressMessage = 
          "Encoding Frame " <> ToString[i++] <> "/" <> 
           ToString[Length[times]];
         BinaryWrite[bst, ImageData[#, "Byte"]];
         ) &, frames];
      ) &, Partition[times, UpTo[batchSize]]];
   NotebookDelete[messageCell];
   ProcessStatus[process];
   ,
   Close[bst], RunProcess[{"rm", fifoName}]];
  progressMessage = 
   "Waiting for ffmpeg to return... " <> ProcessStatus[process];
  messageCell = PrintTemporary[Dynamic[progressMessage]];
  While[ProcessStatus[process] == "Running", 
   progressMessage = 
    "Waiting for ffmpeg to return... " <> ProcessStatus[process]; 
   Pause[0.25]];
  NotebookDelete[messageCell];
  result = ReadString[ProcessConnection[process, "StandardError"]];
  If [result == EndOfFile, "Encoding Completed Successfully!", 
   "Error:\n" result]
  ]

Usage

generateFrameGraphic[t_] := 
 Plot[Sin[x t], {x, 0, 2 \[Pi]}, PlotRange -> {-2, 2}];

Block[{fps = 24, duration = 5, tStart = 0, tEnd = 1, videoWidth = 640,
   times},
 times = Range[tStart, tEnd, (tEnd - tStart)/(duration*fps)];
 EncodeMyVideo[generateFrameGraphic, times, "sinAnimation.mp4", 
  videoWidth, fps]
]
```