Group Abstract Group Abstract

Message Boards Message Boards

[GIF] Starry Night over Water

Attachments:
POSTED BY: Silvia Hao
7 Replies

Great idea there!

So to create a GIF, I think it would be convenient to introduce the total number of frames:

With[{frames = 120}
 , With[{
   (* time step of the animation: *) Δt = 1/frames
   (* ...... *)

To ensure the GIF is periodical, ω should be constrained, so:

(* ...... *)
Module[{cx, cy, Δx, Δy, color},
    {
        (* θ0: *) RandomReal[{0, Pi / 2}, n],
        (* ω: *)(* instead of RandomReal[{0.3, 1}, n]: *)
        2 Pi RandomInteger[{1, 5}, n] ,
(* ...... *)

Finally, instead of:

Function[{θ0, ω, expr},
                DynamicModule[{θ = θ0},
                    DynamicWrapper[
                        Deploy @ Activate @ expr,
                        θ = Mod[θ + ω * Δt, 2 * Pi]
                    ]]]

a static generator is needed:

Function[{θ0, ω, expr},
   Block[{θ = θ0 + k ω Δt, 
     Dynamic = Identity},
    expr // Deploy // Inactive[Function][k, #] & // Activate
    ]
]

So assemble them together:

frameGen = With[{frames = 120},#]& @ With[
    {
        (* time step of the animation: *) Δt            = 1./frames, 
        (* number of stars:            *) n             = 50, 
        (* maximal size of stars:      *) radius        = 1.5, 
        (* color theme:                *) baseColorFunc = ColorData @ "StarryNightColors",
        (* geometric properties of the water region: *)
        waterBase = -2, waterWidth = 5, 
        (* geometric properties of the final drawing: *)
        height = 20, imageHeight = 700, aspRatio = 1 / GoldenRatio
    },
    With[{width = (height + (-waterBase) + waterWidth) / aspRatio},
        Apply[
            Function[{θ0, ω, expr},
                (* DynamicModule[{θ = θ0},DynamicWrapper[Deploy @ Activate @ expr,θ = Mod[θ + ω * Δt, 2 * Pi]]]] *)
                Block[{θ = θ0 + k ω Δt, Dynamic = Identity},
                   expr // Deploy // Inactive[Function][k, #] & // Activate
                ]
            ]
        ][
            Module[{cx, cy, Δx, Δy, color},
                {
                    RandomReal[{0, Pi / 2}, n],
                    RandomReal[{0.3, 1}, n],
                    Inactive[Graphics][
                        {
                            (* background: *)
                            Module[
                                {
                                    h = height + (-waterBase) + waterWidth + 10,
                                    w = width + 5,
                                    m = 10, Δh, cf = baseColorFunc /* (Darker[#, 0.5]&)
                                },
                                Δh = h / m;
                                MapThread[
                                    Function[{y, c1, c2}, {EdgeForm[], Polygon[{{-5, y},{w, y},{w, y + Δh},{-5, y + Δh}},VertexColors -> Map[cf, {c1, c1, c2, c2}]]}],
                                    {
                                        Function[
                                            Rescale[#, {1, m}, {(waterBase + -waterWidth) - 5, height + 5 + -Δh}]
                                        ][Range @ m],
                                        Most[Function[0.4 * (1 + -#) ^ 5][Rescale[Range[m + 1]]]],
                                        Rest[Function[0.4 * (1 + -#) ^ 5][Rescale[Range[m + 1]]]]
                                    }
                                ]
                            ],
                            (* foreground: *)
                            MapThread[
                                Function[
                                    {cpos, r, idx, shineShift},
                                    {cx, cy} = cpos;
                                    {Δx, Δy} = cpos + -({width, height} / 2);
                                    (* base color: *)
                                    color = baseColorFunc[
                                        1 + -Norm[{Δx, Δy} / {width, height}, 1]
                                    ];
                                    {
                                        (* one star: *)
                                        {
                                            FaceForm @ {Append[(* transparency: *) 0.7][color]},
                                            EdgeForm[],
                                            Polygon[Map[Function[cpos + r * #],{{0, 1},{Cos[Dynamic[θ[[idx]]]], 0},{0, -1},{-Cos[Dynamic[θ[[idx]]]], 0}}]]
                                        },
                                        (* and its reflection: *)
                                        {
                                            RightComposition[
                                                ColorConvert[#, "LAB"]&,
                                                (* adjust luminance according to shineShift (i.e. y-coords): *)
                                                ReplacePart[
                                                    1 -> RightComposition[
                                                        Function[Cos[2 * #]],
                                                        Function[((# + 1) / 2) ^ 0.5],
                                                        Function[
                                                            Rescale[#, {0, 1},
                                                                Plus[
                                                                    (* mean luminance, lower the brighter: *)
                                                                    Rescale[shineShift, {-1, 1}, {0.4, 0.7}],
                                                                    (* luminance variation range, lower the more active: *)
                                                                    {-1, 1} * Rescale[shineShift, {-1, 1}, {0.3, 0.03}]
                                                                ]]
                                                        ]
                                                    ][Dynamic[θ[[idx]]]]
                                                ],
                                                (* transparency: *)
                                                Append[Function[Rescale[#, {-1, 1}, {0.2, 0.6}]][shineShift]]
                                            ][color],
                                            (* abstract blur: *)
                                            AbsoluteThickness[Function[Rescale[#, {-1, 1}, {10, 1}]][shineShift]],
                                            Line[
                                                Function[
                                                    {
                                                        {cx - 1/2 r (#3 (1 - #2 Cos[Dynamic[θ[[idx]]]])), #1},
                                                        {cx + 1/2 r (#3 (1 + #2 Sin[Dynamic[θ[[idx]]]])), #1}
                                                    }
                                                ][
                                                    (* y-coords: *)
                                                    Plus[
                                                        waterBase,
                                                        waterWidth * ((Rescale[shineShift, {-1, 1}] ^ 0.5) - 1)
                                                    ],
                                                    (* variance: *)
                                                    Rescale[shineShift, {-1, 1}, {1, 0.2}],
                                                    (* mean radius: *)
                                                    Rescale[shineShift, {-1, 1}, {2, 4}]
                                                ]]}}],
                                {
                                    Join[
                                        ScalingTransform[{3 / 4, 3 / 4}, {width, height} / 2][
                                            RandomPoint[Rectangle[{0, 0}, {width, height}], Ceiling[n / 4]]
                                        ],
                                        RandomPoint[Rectangle[{0, 0}, {width, height}], (n + -Ceiling[n / 4]) - 1],
                                        {{width, height} / 2}
                                    ],
                                    radius * RandomReal[{1 / height, 1}, n],
                                    Range @ n,
                                    RandomReal[{-1, 1}, n]
                                }
                            ]},
                        PlotRange -> {{0, width}, {waterBase + -waterWidth, height}},
                        PlotRangePadding -> {{2, 2}, {1, 2}},
                        Background -> None,
                        ImageSize -> {Automatic, imageHeight}
                    ]}]]]];

Generating frames:

frames = With[{frames = 120}, RightComposition[frameGen, Rasterize] /@ Range[frames]];

Exporting to GIF:

Export["starry_night_over_water.gif", frames, "GIF",  "DisplayDurations" -> .1]
POSTED BY: Silvia Hao

Works great -- Thanks!

POSTED BY: Anton Antonov

How can this Deployed dynamic be converted into images frames?

The exported movie would be great as Zoom background (this month.)

POSTED BY: Anton Antonov

Beautiful and calming! Saving for my attempts at meditation. And it's great to see such clear, logical beautifully-formatted code.

Posted 6 years ago

Lovely post!

POSTED BY: Casper YC

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive!

POSTED BY: EDITORIAL BOARD

Great post, and thanks for providing the notebook for download.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard