Message Boards Message Boards

Merry Christmas!

GROUPS:

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
Answer
8 months ago

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
Answer
8 months ago

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

POSTED BY: Moderation Team
Answer
8 months ago

Thanks!

POSTED BY: Sander Huisman
Answer
8 months ago

Merry Christmas to you, too!

POSTED BY: Clayton Shonkwiler
Answer
8 months ago

Thanks a lot!

POSTED BY: Sander Huisman
Answer
8 months ago

Group Abstract Group Abstract