把动态图放映到球面上的方法

电脑

Mathematica

加载动态图：a = Import['D:\\我的图片\\a.gif']得到了动态图每一帧的列表a。

把a里面的第一幅图片，贴到球面上，看看模样：SphericalPlot3D[1 , {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None,  TextureCoordinateFunction -> ({#5, 1 - #4} &),  PlotStyle -> Texture[a[[1]]], Lighting -> {'Directional', White},  Boxed -> False, Axes -> False, RotationAction -> 'Clip',  ViewPoint -> {-1,0,0}, SphericalRegion -> True]里面的图案严重变形了，得改。

把a里面的所有图片，都进行同样的修改：b = ColorReplace[     Colorize[      ImageResize[#, {200, 360}]], {RGBColor[0.7, 0.2, 0.2]}] & /@ a;下面是对应的动态图。

b的第一幅图片贴到球面上，效果如下。

对b的每个图套加上一个浅绿色的外框：c = ImageResize[     ImageCompose[      Graphics[{Lighter@Lighter@Lighter@Lighter@Green, Rectangle[]},        ImageSize -> 800], #], 500] & /@ b;

把c的第一幅图贴到球面上，龙猫的形状总算是比较正常了。

把c的所有图片，都贴到球面上：Table[SphericalPlot3D[1 , {u, 0, Pi}, {v, 0, 2 Pi}, Mesh -> None,    TextureCoordinateFunction -> ({#5, 1 - #4} &),    PlotStyle -> Texture[n], Lighting -> {'Directional', White},    Boxed -> False, Axes -> False, RotationAction -> 'Clip',    ViewPoint -> {-1, 0, 0}, SphericalRegion -> True], {n, c}];

这样，就实现了在球面上播放动态图；球面还可以旋转。