Message Boards Message Boards

Merry Christmas!

enter image description here

Code

This created the background:

vc=N@PolyhedronData["RhombicHexecontahedron","VertexCoordinates"];
fi=PolyhedronData["RhombicHexecontahedron","FaceIndices"];
invalid=Select[Transpose[{Range[Length[vc]],vc}],Norm[{0,0,-1.0}-Last[#]]<1.5&][[All,1]];
pols=Select[fi,ContainsNone[#,invalid]&];
valid=Union@@pols;
pols=pols/.Thread[valid->Range[Length[valid]]];
pts=RotationTransform[-Pi/2,{0,0}]/@vc[[valid,;;2]];

rim=Polygon[Most[Select[pts,Norm[#]>1.6&]//#[[FindShortestTour[#][[2]]]]&]];

nf=Nearest[Select[pts,Norm[#]>1.9&]];
starts=Select[pts,1.3<Norm[#]<1.7&];
l1=Line[{#,nf[#][[1]]}&/@starts];

nf=Nearest[Select[pts,1.7<Norm[#]<1.9&]];
starts=Select[pts,0.5<Norm[#]<1.1&];
starts={#,nf[#,2]}&/@starts;
l2=Line[Join@@With[{x=#1,y=#2},{x,#}&/@y]&@@@starts];

center=Select[pols,Norm[Mean[pts[[#]]]]<1&];

size=5;

{dark,light}={,};
bg=Polygon[1.01size{{-1,-1},{1,-1},{1,1},{-1,1}},VertexColors->{dark,dark,light,light}];

spec=Directive[White,Thickness[0.1/size]];


{hat,hat2,hat3}={{{-2.30810546875`,1.4252050781249985`},{-2.385791015625`,0.9260351562500001`},{-2.280126953125`,0.46109374999999864`},{-1.8998535156249998`,0.34307617187500006`},{-1.3693359374999998`,0.60767578125`},{-0.7615234374999997`,0.9790625000000001`},{-0.2900390625`,1.5730078124999989`},{0.193603515625`,1.8767187500000002`},{0.7763671875`,2.034677734375`},{1.2802734375000009`,1.9143164062500002`},{1.5273925781250002`,1.5112890625`},{1.5569335937500002`,1.0600683593749987`},{1.8193359375`,1.1870703125`},{2.0535644531250004`,1.4586035156250001`},{2.00341796875`,1.98150390625`},{1.5439941406250002`,2.58375`},{0.9820312500000004`,2.918466796875`},{0.12739257812499982`,2.85865234375`},{-0.7204101562500007`,2.399765625`},{-1.3158691406249998`,1.9246679687500001`},{-2.017724609375`,1.5189062499999988`}},{{-2.799755859375`,2.1602148437500004`},{-2.45234375`,2.6712988281249994`},{-2.162890625`,3.3095800781249998`},{-1.5270507812499998`,3.8791113281249996`},{-0.5945312499999993`,4.091757812499999`},{0.06850585937500053`,3.8572851562499997`},{0.6195312499999996`,3.5445410156249997`},{1.2171875000000005`,2.9704687499999998`},{1.3102050781250005`,2.7108984374999996`},{1.4206054687500007`,2.62330078125`},{-0.45834960937500036`,1.9788183593749995`},{-2.0560546875`,1.0878027343749994`},{-2.207958984375`,1.4178808593749994`},{-2.08076171875`,1.8430761718749995`},{-2.079345703125`,1.9618261718749994`},{-2.125732421875`,1.9290624999999992`},{-2.642626953125`,1.6914160156249993`},{-3.007080078125`,1.8389746093749992`}},{{-3.05625`,1.375`}}};
thick=Thickness[0.04/size];
hat={EdgeForm[{thick,Black}],FaceForm[Red],FilledCurve[{BSplineCurve[hat2,SplineClosed->True]}],EdgeForm[{thick,Black}],FaceForm[GrayLevel[0.975]],FilledCurve[{BSplineCurve[hat,SplineClosed->True]}],Disk[hat3[[1]],0.61]};

back=Graphics[{bg,spec,CapForm[None],l1,l2,GraphicsComplex[pts,{FaceForm[],EdgeForm[spec],Polygon[center],rim,{hat}}]},Background->None,PlotRange->size,ImageSize->{500,500}]

enter image description here

Now we add some random paths of snow:

ClearAll[RandomPath]
RandomPath[n_,startx_]:=Module[{vx,vy,angle,x,y},
    vy=-N[2 size/n];
    vx=0.02RandomReal[{-1,1}];
    y=-vy+size;
    x=startx;

    angle=0;

    Table[
        y+=vy;
        x+=vx;
        vx+=0.05RandomReal[{-1,1}];
        vx*=0.9;
        x=Mod[x,2size,-size];
        {x,y}
     ,
        {i,n}
    ]
]
data=Table[RandomPath[RandomChoice[{24,32,36,48,72,96}],RandomReal[size{-1,1}]],{200}];
max=288;
data=(Join@@ConstantArray[#,max/Length[#]])&/@data;
data=RotateLeft[#,RandomInteger[{0,288}]]&/@data;
sizes=RandomReal[0.025{3,5},Length[data]];

Manipulate[Show[{back,Graphics[{White,MapThread[Disk[#1,#2]&,{data[[All,i]],sizes}]}]}],{i,1,Length[First[data]],1}]

enter image description here

Enjoy the holidays!
POSTED BY: Sander Huisman
5 Replies
Sort By:

Merry Christmas to you, too!
POSTED BY: Clayton Shonkwiler

Thanks a lot!
POSTED BY: Sander Huisman

enter image description here - Congratulations! This post is now Staff Pick! Thank you for your wonderful contributions. Please, keep them coming!
POSTED BY: EDITORIAL BOARD

Thanks!
POSTED BY: Sander Huisman

Happy holidays to everyone! Wonderful animation. If we are celebrating with Wolfram Language, I'd like to share another snowy gem created by Simon Woods in the spirit of holidays:

enter image description here

flake := Module[{arm},
   arm = Accumulate[{{0, 0.1}}~Join~RandomReal[{-1, 1}, {5, 2}]];
   arm = arm.Transpose@RotationMatrix[{arm[[-1]], {0, 1}}];
   arm = arm~Join~Rest@Reverse[arm.{{-1, 0}, {0, 1}}];
   Polygon[Flatten[arm.RotationMatrix[# \[Pi]/3] & /@ Range[6], 1]]];

snowfield

[flakesize_, size_, num_] := 
  Module[{x = 100/flakesize}, 
   ImageData@Image[Graphics[{White, Table[Translate[
         Rotate[flake, RandomReal[{0, \[Pi]/6}]], {RandomReal[{0, x}],
           RandomReal[{0, 5 x}]}], {num}]}, Background -> Black, 
      PlotRange -> {{0, x}, {0, 5 x}}], ImageSize -> {size, 5 size}]];

size = 300;

r = snowfield @@@ {{1, size, 500}, {1.5, size, 250}, {2, size, 50}};
Dynamic[Image[(r[[#]] = RotateRight[r[[#]], #]) & /@ {1, 2, 3}; 
Total[r[[All, ;; size]]]]]

The sources with some other animation is here.
POSTED BY: Vitaliy Kaurov
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract