oftenpaper.net

fadeleaf animation ™


  1. game = Compile[{{vertices, _Real, 2}, {numPoints, _Integer}, {wowzerz, _Real}},
       Module[{diff},
        FoldList[(diff = #2 - #1;
           Clip[(#1 + #2) Log[Sqrt[diff.diff] + wowzerz]]) &,
         {0., 0., 0.}, RandomChoice[vertices, numPoints]]]];
    
    {numFrames, imageSize, numPoints} = {
        {5(*sec*)15(*fps*), 1/2 {640, 480}, 1/3 600000},
        {20(*sec*)15(*fps*), {640, 480}, 600000}}[[1]];
    
    Needs["PolyhedronOperations`"];
    vertices = Stellate[PolyhedronData[{"Pyramid", 5}, "Faces"]][[1]];
    
    frame = Function[w,
       Graphics3D[{Opacity[.1], PointSize[0], Point[game[vertices, numPoints, w]]},
        ImageSize -> imageSize, ViewVertical -> {0, 0, 1}, Boxed -> False, SphericalRegion -> True, PlotRange -> 1,
        ViewVector -> {RotationTransform[2 Pi w, {0, 0, 1}][{1, 0, (w - .25) Pi/2}], {0, 0, 0}}]];
    
    SetDirectory["c:/users/zrp/desktop/frames"];
    
    range = Range[0, 3/4, 3/4/(numFrames - 1)];
    file[w_] := ToString[N@w] <> ".png";
    
    ParallelDo[
      If[! FileExistsQ[file[w]],
       Export[file[w], frame[w]]],
      {w, range}];
    
    Export["mov.avi",
     ColorNegate /@ ImageAdjust /@ Import /@ file /@ range]
    
    Beep[];
    Button[open, SystemOpen["mov.avi"],
     Enabled -> FileExistsQ["mov.avi"]]
    
    1. MovieMaker[frameF_, range : {start_Integer, stop_Integer}, rest___] :=
        MovieMaker[frameF, {start, stop, stop - start}, rest];
      
      (*arithmetic for eg doubling movie length is easier by 'intervals' than by 'frame count'*)
      MovieMaker[frameF_, range : {start_, stop_, numIntervals_}, rest___] :=
        MovieMaker[frameF, List[Range[#1, #2, (#2 - #1)/#3(*(#3-1)*)] & @@ range], rest];
      
      MovieMaker::expqq = "Export is complaining about something. " <>
         "Most likely you're feeding it items with different image sizes.";
      
      MovieMaker::usage =
        "NOTE: copies of this notebook are automatically stored along
        with the generated files. To prevent this, set AutoArchive -> False.
        
        MovieMaker[frameFunction, rangeSpec, options___]
        
        rangeSpec:
        {start, stop, number of intervals}:  {0, 1, 5(*sec*)15(*fps*)}
        {start, stop} integer range:  {1, 20}
        {explicit list}:  {AstronomicalData[\"Earth\",\"OrbitPath\"][[1]]}
        
        The Label option determines the folder name under which the animation
        is created. For example, if changing a variable X makes a different
        animation, then place that variable in the Label spec so that when you
        change that variable, the animation will be generated in a different folder.
        
        Likewise, the first element of the Process spec determines the folder
        and uniqueness of the process function. Processes work in subfolders of
        the main project folder, meaning you can experiment with multiple processes
        in a single project.
        
        MovieMaker[
         {ToLowerCase[#], ToUpperCase[#]} &, {CharacterRange[\" \", \"~\"]},
         Serialization -> Hash, Label -> \"UpperLower\", FileTypes -> {\".mx\", \".png\", \".gif\"},
         Process -> {\"times\", ImageMultiply @@ Map[Rasterize[#, ImageSize -> 400 {1, 1}] &, #] &},
         MovieOptions -> {\"DisplayDurations\" -> 1}, MapFunction -> Map]
        
        Serialization is for converting values to valid file names.
        MapFunction is for when you don't want to use parallelization.
        Directory setting specifies the specific project folder, overriding Label.";
      
      Options[MovieMaker] = {
         Label -> Automatic, Process -> {None, None}, MapFunction -> ParallelMap, AutoArchive -> True,
         FileTypes -> {".png", ".png", ".avi"}, MakeMovie -> True, MovieOptions -> {}, Directory -> Automatic,
         Ordering -> (BlockRandom[RandomSample[#]] &), Serialization -> Composition[List, Chop, N]};
      
    2. (* After I wrote this program, a more powerful approach occurred to me. We could have a
      macro that would be used something like this: *)
      FileBackedProcess[Function[val,
         a = S[1][Rasterize@dirp[val]];
         b = S[2][Rasterize@derp[val]];
         S[3][ImageMultiply[a, b]]]];
      (* where the S[i_][body_] are the momoization points into the file system. If the S finds
      the file corresponding to the [i][body], then the file is imported. Otherwise it executes
      the body and saves the file. The point would be to make the file aspect as
      easy as annotating things with S[i] *)
      
      MovieMaker[frameF_, List[valueList_List], OptionsPattern[]] := Module[{
         tooltip, mainLabel, processLabel, processF, mapF, frameExt, processedExt, movieExt, dir,
         framesDir, processedDir, movieFile, fileMap, numFrames, alive = True, folder0exists,
         foldersExistL, folder1exists, folder2exists, progress1, progress2, movieDone, makeFrames,
         processFrames, makeMovie, serialization, archive, makeMovieA, preview, printPreview, printFileMap},
      
        tooltip[expr_] := Tooltip[#, expr, TooltipDelay -> .25] &;
        {mainLabel, mapF, makeMovieA, serialization} =
         OptionValue[{Label, MapFunction, MakeMovie, Serialization}];
      
        {processLabel, processF} =
         Replace[OptionValue[Process], {
           {pf_} :> {ToString[pf], pf},
           pf : Except[_List] :> {ToString[pf], pf}}];
      
        {frameExt, processedExt, movieExt} = PadRight[
          Flatten[List[OptionValue[FileTypes]]], 3,
          FileTypes /. Options[MovieMaker]];
      
        mainLabel = Replace[mainLabel,
          Automatic -> IntegerString[Hash[{frameF, valueList}, "CRC32"], 36]];
        dir = Replace[OptionValue[Directory], Automatic ->
           FileNameJoin[{NotebookDirectory[], "vids", ToString[mainLabel]}]];
      
        framesDir = FileNameJoin[{dir, "frames"}];
        processedDir = FileNameJoin[{dir, "processed", ToString[processLabel]}];
        movieFile = FileNameJoin[{dir, ToString[{processLabel, mainLabel}] <> movieExt}];
      
        (* main iteration construct *)
        fileMap[f_, vals_: valueList, map_: mapF] := map[Function[val,
           f[
            FileNameJoin[{framesDir,
              ToString[serialization[val]] <> frameExt}],
            FileNameJoin[{processedDir,
              ToString[serialization[val]] <> processedExt}],
            val]],
          vals];
      
        numFrames = Length[valueList];
        progress1 = Total@Boole[fileMap[FileExistsQ[#1] &]];
        progress2 = Total@Boole[fileMap[FileExistsQ[#2] &]];
        foldersExistL = FileExistsQ /@ {dir, framesDir, processedDir};
        movieDone = FileExistsQ[movieFile];
        SetSharedVariable[progress1, progress2];
      
        If[OptionValue[AutoArchive] && FileExistsQ[dir] &&
          ! FileExistsQ[FileNameJoin[{dir, ToString[mainLabel] <> ".nb"}]],
         Export[FileNameJoin[{dir, ToString[mainLabel] <> ".nb"}],
          NotebookGet[EvaluationNotebook[]]]];
      
    3. (**)
      makeFrames[] := (
         Quiet@CreateDirectory[framesDir];
         foldersExistL[[1 ;; 2]] = {True, True};
         If[OptionValue[AutoArchive],
          Export[FileNameJoin[{dir, ToString[mainLabel] <> ".nb"}],
           NotebookGet[EvaluationNotebook[]]]];
      
         fileMap[If[! FileExistsQ[#1],
            Export[#1, frameF[#3]];
            progress1++] &,
          OptionValue[Ordering][valueList]]);
      
      (**)
      processFrames[] := If[
         processF =!= None,
         Quiet@CreateDirectory[processedDir];
         foldersExistL[[3]] = True;
         If[OptionValue[AutoArchive],
          Export[FileNameJoin[{processedDir, ToString[{mainLabel, processLabel}] <> ".nb"}],
           NotebookGet[EvaluationNotebook[]]]];
      
         fileMap[If[! FileExistsQ[#2] && FileExistsQ[#1],
            Export[#2, processF[Import[#1]]];
            progress2++] &,
          OptionValue[Ordering][valueList]]];
      
      (**)
      makeMovie[] := If[makeMovieA,
         If[FileExistsQ[movieFile],
          Print["movie file already exists"],
          With[{ab = If[processF === None, #1, #2]},
           If[And @@ fileMap[FileExistsQ[ab] &],
            Check[
              Export[movieFile, fileMap[Import[ab] &],
               Sequence @@ OptionValue[MovieOptions]];
              movieDone = True, Message[MovieMaker::expqq];
              movieDone = False, {Export::errelem}]]]]];
      
      (**)
      preview[] := preview[RandomChoice[valueList]];
      preview[val_] := Module[{frame, fileName, tempFile},
         tempFile = FileNameJoin[{$TemporaryDirectory, ToString[Hash[val]] <> frameExt}];
         fileName = First@fileMap[#1 &, {val}];
      
         If[FileExistsQ[fileName],
          (**)frame = Import[fileName],
          (**)frame = Import[Export[tempFile, frameF[val]]];
          Print[Labeled[frame, N@val, Right]]; Beep[]];
      
         If[processF =!= None,
          Print[Labeled[processF[frame], N@val, Right]]; Beep[]]];
      
      (**)
      printPreview[] := CellPrint[ExpressionCell[Defer[
           preview[Placeholder["val"]]], "Input"]];
      
      (**)
      printFileMap[] := CellPrint[ExpressionCell[Defer[
           frames2 = fileMap[If[FileExistsQ[#2], Import[#2], Sequence @@ {}] &];],
          "Input"]];
      
      (**)
      archive[] := Module[{fileName},
         fileName = ToString[mainLabel] <> " " <>
           DateString[{"DateShort",
             " (", "Hour12", " ", "Minute", " ", "Second", " ", "AMPM", ")"}];
      
         Quiet@CreateDirectory[dir];
         foldersExistL[[1]] = True;
         Export[FileNameJoin[{dir, fileName <> ".nb"}],
          NotebookGet[EvaluationNotebook[]]];
      
         Beep[]];
      
    4. (*controls*)
        With[{
          btnMakeFrames = Button["frames + process + movie",
            makeFrames[]; Beep[]; processFrames[]; Beep[]; makeMovie[]; Beep[],
            Method -> "Queued", Enabled -> Dynamic[progress1 =!= numFrames]],
          btnProcessFrames = Button["process + movie",
            processFrames[]; Beep[]; makeMovie[]; Beep[],
            Method -> "Queued", Enabled -> Dynamic[
              progress2 =!= numFrames && progress1 =!= 0 && processF =!= None]],
          btnMakeMovie = Button["movie",
            makeMovie[]; Beep[],
            Method -> "Queued", Enabled -> Dynamic[
              (progress2 === numFrames ||
                 (processF === None && progress1 === numFrames)) &&
               ! movieDone && makeMovieA]],
          btnMainFolder = tooltip["open folder"]@
            Button[{mainLabel, processLabel}, SystemOpen[dir],
             Enabled -> Dynamic[foldersExistL[[1]]]],
          btnFramesFolder = tooltip["open folder"]@
            Button[{Dynamic[progress1]/ToString[numFrames],
              ProgressIndicator[Dynamic[progress1/numFrames]]},
             SystemOpen[framesDir],
             Enabled -> Dynamic[foldersExistL[[2]]]],
          btnProcessFolder = tooltip["open folder"]@
            Button[{Dynamic[progress2]/ToString[numFrames],
              ProgressIndicator[Dynamic[progress2/numFrames]]},
             SystemOpen[processedDir],
             Enabled -> Dynamic[processF =!= None && foldersExistL[[3]]]],
          btnMovieFile = tooltip["open movie"]@
            Button[{Dynamic[Boole[movieDone]]/"1",
              ProgressIndicator[Dynamic[Boole[movieDone]/1]]},
             SystemOpen[movieFile], Enabled -> Dynamic[movieDone]]},
      
         (*without going the extra mile, better to have no persistence*)
         Dynamic[If[alive === True,
             Panel[#, FrameMargins -> {{Automatic, Automatic}, {Automatic, 0}}],
             Panel[Tooltip[Overlay[{
                 Style["VWXYZ", Lighter[LightGray, 2/3], FontFamily -> "Wingdings"],
                 Style["dead", Darker[Red, 1/6]]}, All, 2, Alignment -> {Center, Center}],
               "R.I.P. this MovieMaker module"],
              FrameMargins -> 0]]] &@
      
          Manipulate[
           Grid[{
             {btnMainFolder, SpanFromLeft},
             {btnMakeFrames, btnFramesFolder},
             {btnProcessFrames, btnProcessFolder},
             {btnMakeMovie, btnMovieFile}}],
      
           Bookmarks :> {
             "preview" :> AbortProtect[preview[]],
             Overscript[Row[{"print ", Style["preview", Bold], " function"}], ""] :> printPreview[],
             Row[{"print ", Style["fileMap", Bold], " function"}] :> printFileMap[],
             Overscript["write archive", ""] :> archive[],
             "shoot" :> (alive = False)},
           Paneled -> False, FrameMargins -> False]]];
      
  2. game = Compile[{{vertices, _Real, 2}, {numPoints, _Integer}, {wowzerz, _Real}},
       Module[{diff, b},
        (*NestList for less memory usage. i didn't actually verify this*)
        NestList[(
           b = RandomChoice[vertices];
           diff = b - #1;
           Clip[(#1 + b) Log[Sqrt[diff.diff] + wowzerz]]) &,
         {0, 0, 0}, numPoints]]];
    
    proc[img1_, cf_: ColorData[1], mode_: None, blur_: 8] :=
      Module[{img, components, rank, largest, colored},
       img = RemoveAlphaChannel[ColorNegate@ColorConvert[img1, "Grayscale"]];
       components = MorphologicalComponents[img];
    
       Module[{measurements, sorted},
        measurements = ComponentMeasurements[components, "Count"];
        sorted = First /@ Reverse@SortBy[measurements, Last];
        rank[label_] := (rank[label] = Position[sorted, label][[1, 1]])];
    
       colored = Colorize[components,
         ColorFunction -> (cf[rank[#]] &), ColorFunctionScaling -> False];
       If[mode == "Angelic",
        colored = ImageMultiply[img, colored]];
       ColorNegate[ImageMultiply[ColorNegate[img],
           Blur[#, blur] &@ColorNegate[colored]]] // ImageAdjust];
    
    Needs["PolyhedronOperations`"];
    vertices = OpenTruncate[PolyhedronData["Icosahedron", "Faces"]][[1]];
    vertices = Rescale[vertices] - 1/2; (*rescale to 1/2 {-1, 1} range*)
    
    {numFrames, imageSize, numPoints} = {
       {5(*sec*)15(*fps*), {16, 9} (360/9), 600000},
       {5(*sec*)15(*fps*), {16, 9} (1080/9), 10000000}}[[2]];
    
    label = {"NUCLEAR1080P", numPoints, IntegerString[Hash[vertices, "CRC32"], 36]};
    
    process = {
        {"[COLORDATA3]", Composition[
          proc[#, If[# == 1, Blue, ColorData[3][#]] &, "Angelic", 1] &,
          ImageResize[#, Scaled[1/2]] &, Blur[#, 1] &, ImageAdjust]},
        {"[HIGHBLUR]", Composition[
          proc[#, If[# == 1, Blue, ColorData[3][#]] &, "Angelic", 40] &,
          ImageResize[#, Scaled[1/2]] &, ImageAdjust]}}[[2]];
    
    frame[w_] :=
      Graphics3D[{Opacity[.1], PointSize[0],
        Point[game[vertices, numPoints, w]]},
       ImageSize ->(**)2(**)imageSize, ViewVertical -> {0, 0, 1}, Boxed -> False,
       SphericalRegion -> True, Method -> {"ShrinkWrap" -> True},
       ViewVector -> {RotationTransform[2 Pi w, {0, 0, 1}][{1, 0, (w - .25) Pi/2}], {0, 0, 0}}];
    
    MovieMaker[frame, {.4, .75, 4 numFrames},
     Label -> label, Process -> process]
    

This page is an excerpt from the sierpinski triangle page to end most sierpinski triangle pages ™.