Figures for
Geometry Lab with Mathematica

by
Joan Trias and Vera Sacristan
Universitat Politecnica de Catalunya
E-08028  Barcelona Spain
avtrias@ma2.upc.es
vera@ma2.upc.es

Mathematia in Education and Research
Volume 4 Number 2
Copyright 1995 TELOS/Springer-Verlag

Figure 1

(*fig01.m*)
(*
 This code generates FIGURE 1
 of the paper
 Geometry Lab with Mathematica 
 by Joan Trias and Vera Sacristan
*)

Needs["Graphics`Shapes`"]

norm[v_]:=N[Sqrt[v.v]]                          
e1={1,0,0}
e2={0,1,0}
e3={0,0,1}
vectorProduct[u_,v_]:=
 N[{Det[{u,v,e1}],Det[{u,v,e2}],Det[{u,v,e3}]}]
coordinateTransf[ 
  (* X=AX'+W *)
  obj_, (* object or scene *)
  A_,   (* change of basis (row) matrix *)
  W_    (* new origin *)
 ]:=N[obj]/.{a_?NumberQ,b_?NumberQ,c_?NumberQ}->A.{a,b,c}+W

uu3={1,1,1} (* normal to the plane *)
u3=uu3/norm[uu3]
uu1=vectorProduct[u3,e3] (* for example, if not dependent *)
u1=uu1/norm[uu1]
u2=vectorProduct[u3,u1]
AA={u1,u2,u3}
A=Transpose[AA]
W={1,1,1}

plane=Polygon[{{3,0,0},{0,3,0},{0,0,3}}]
tor0=Torus[.75,.25,15,15]
torA=tor0/.{a_?NumberQ,b_?NumberQ,c_?NumberQ}->{a,b,c+.25}
torusOnThePlane=coordinateTransf[torA,A,W]

(*FIGURE:*)
FIGURE8=Show[Graphics3D[{plane,torusOnThePlane}],ViewPoint->{.3,2,-.1}]

Figure 2

Figure 3

Figure 4

Figure 5

Figure 6

Figure 7

Figure 8

Figure 9

Figure 10

Show[LEFT,DisplayFunction->$DisplayFunction]

Show[RIGHT,DisplayFunction->$DisplayFunction]

Figure 11

Figure 12

Figure 13