Message Boards Message Boards

GROUPS:

Merry Christmas!

Posted 1 year ago
2844 Views
|
5 Replies
|
16 Total Likes
|

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!

5 Replies

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.

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

Thanks!

Merry Christmas to you, too!

Thanks a lot!

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

Group Abstract Group Abstract