Thursday, September 21, 2006

Models for Orientation Gadgets

Here is some Mathematica code, without explanation, for improved orientation-visualization gadgetry. I'll do the display operators later, but I'm rushing out the door:


vcube=
TranslateShape[
{FaceForm[RGBColor[0,0,1],RGBColor[1,1,0]]
,Polygon[{{0,0,0},{1,0,0}(*xy*)
,{1,1,0},{0,1,0}}]
,Polygon[{{0,0,1},{1,0,1}
,{1,1,1},{0,1,1}}]
,FaceForm[RGBColor[0,1,0],RGBColor[1,0,1]]
,Polygon[Reverse[{{0,1,0},{1,1,0}
,{1,1,1},{0,1,1}}]](*zx*)
,Polygon[Reverse[{{0,0,0},{1,0,0}
,{1,0,1},{0,0,1}}]]
,FaceForm[RGBColor[1,0,0],RGBColor[0,1,1]]
,Polygon[{{0,0,0},{0,1,0}
,{0,1,1},{0,0,1}}]
,Polygon[{{1,0,0},{1,1,0},{1,1,1}
,{1,0,1}}]
},{-.5,-.5,-.5}];

x2pols={FaceForm[RGBColor[0,0,0],RGBColor[.5,.5,.5]]
,Polygon[
Reverse[{{1,1,0},{2.5,6,0},{3,6,0},{3,4+1/3,0},{2,1,0}}/12.]]
,Polygon[
Reverse[{{4,1,0},{3,4+1/3,0},{3,6,0},{3.5,6,0},{5,1,0}}/12.]]
,Polygon[
Reverse[{{3,6,0},{2.5,6,0},{1,11,0},{2,11,0},{3,7+2/3,0}}/12.]]
,Polygon[
Reverse[{{3,6,0},{3,7+2/3,0},{4,11,0},{5,11,0},{3.5,6,0}}/12.]]
};

y2pols={FaceForm[RGBColor[0,0,0],RGBColor[.5,.5,.5]]
,Polygon[
Reverse[{{2.5,1,0},{2.5,6,0},{3.5,6,0},{3.5,1,0}}/12.]]
,Polygon[
Reverse[{{3,6,0},{2.5,6,0},{1,11,0},{2,11,0},{3,7+2/3,0}}/12.]]
,Polygon[
Reverse[{{3,6,0},{3,7+2/3,0},{4,11,0},{5,11,0},{3.5,6,0}}/12.]]
};

z2pols={FaceForm[RGBColor[0,0,0],RGBColor[.5,.5,.5]]
,Polygon[
Reverse[{{1,1,0},{1.3,2,0},{5,2,0},{5,1,0}}/12.]]
,Polygon[
Reverse[{{1.3,2,0},{3.7,10,0},{4.7,10,0},{2.3,2,0}}/12.]]
,Polygon[
Reverse[{{1,11,0},{5,11,0},{4.7,10,0},{1,10,0}}/12.]]
};

combp=Join[#1,TranslateShape[#2,{.5,0,0}]]&;

xy2p=combp[x2pols,y2pols];
yz2p=combp[y2pols,z2pols];
zx2p=combp[z2pols,x2pols];

face2labels=
TranslateShape[
{TranslateShape[RotateShape[zx2p,Pi,Pi/2,0], {1,0,0}]
,TranslateShape[RotateShape[zx2p,Pi,Pi/2,0],{1,1,0}]
,RotateShape[yz2p,0,-Pi/2,-Pi/2]
,TranslateShape[RotateShape[yz2p,0,-Pi/2,-Pi/2],{1,0,0}]
,xy2p
,TranslateShape[xy2p,{0,0,1}]},{-.5,-.5,-.5}];

wcube=Chop[Join[AffineShape[vcube,{0.99,0.99,0.99}],face2labels]];

thing3={Thickness[0.010]
,RGBColor[1,0,0]
,Line[{{0,0,0},{1,0,0}}]
,RGBColor[0,1,0]
,Line[{{0,0,0},{0,1,0}}]
,RGBColor[0,0,1]
,Line[{{0,0,0},{0,0,1}}]
,RGBColor[0,1,1]
,Line[{{0,0,0},{-1,0,0}}]
,RGBColor[1,0,1]
,Line[{{0,0,0},{0,-1,0}}]
,RGBColor[1,1,0]
,Line[{{0,0,0},{0,0,-1}}]
};

xcube=Join[AffineShape[thing3,{2,2,2}],wcube];

0 Comments:

Post a Comment

<< Home