require "ColorFunctions"; require "std"; widget type <- `output; /* Definition of Sphere, slightly reduced so that objects on the sphere show up clearly*/ X:=R^2->R^3: [u,v] ->.98 [cos(u) cos(v), sin(u) cos(v), sin (v)]; U := (Patch ((-pi, pi, 20), (-pi/2, pi/2, 20))); /* Definition of Circle, to be used when sphere is not around*/ YY:=R->R^3:t ->[cos(t),sin(t),0]; /*Polar coordinates a and d of point A, initialized along the x-axis*/ a:=widget Slider(0,1), init <- .7, drag <- False; d:=widget Slider(-pi,pi), init <- 0, drag <- False; A:= [a cos(d), a sin(d),sqrt(1 - a a)]; /*Polar coordinates b and g of point B, initialized along the a cube root of unity. The "g" is used because "e" was reserved?*/ b:=widget Slider(0,1), init <- .7, drag <- False; g:=widget Slider(-pi,pi), init <- 2*pi/3, drag <- False; B:=[b cos(g),b sin(g),sqrt(1 - b b)]; /*Polar coordinates c and f of point C, initialized along the other cube root of unity*/ c:=widget Slider(0,1), init <-.7, drag <- False; f:=widget Slider(-pi,pi), init <- -2*pi/3, drag <- False; C:=[c cos(f), c sin(f),sqrt(1 - c c)]; /*Normalization function*/ Unit := R^?->R^?: X-> X/sqrt(X . X) if X.X !=0 else X ; /*Definition of the Arc between two points, as a path*/ pqArc := (R^?,R^?) ->(R-> R^?) : (p,q) -> (R -> R^?: t ->Unit( t q + (1-t) p)); /*Definition of three edges of a triangle*/ Segment12 := pqArc(A,B); Segment23 := pqArc(B,C); Segment31 := pqArc(C,A); /*Definition of the antipodal reflection*/ Reflect:= R^?->R^?:X->-X; /*Definition of rotation of the sphere by a one-quarter turn about the point p*/ pRotate:=R^?->(R^?->R^?):p->(X->p>(R^?->R^?):p->(X->pRotate(pRotate(X));*/ /*Calculation of the midpoint of two (non-antipodal) points on the sphere*/ pqMidpoint:=(R^?,R^?)->R^?:(p,q)->Unit((p+q)/2); /*Definition of the length of a vector*/ Norm := R^? -> R: X -> sqrt(X . X); /*Checkboxes for various options of turning things on or off*/ showsphere :=widget CheckBox, init <- True; showcircle :=widget CheckBox, init <- False; showquad :=widget CheckBox, init <- False; showquadBC :=widget CheckBox, init <- False; showquadAC :=widget CheckBox, init <- False; showsegment12 :=widget CheckBox, init <- True; showsegment23 :=widget CheckBox, init <- True; showsegment31 :=widget CheckBox, init <- True; showperp12:=widget CheckBox, init <- False; showperp:=widget CheckBox, init <- False; showmidcurve12:=widget CheckBox, init <- False; showantipodes:=widget CheckBox, init <- True; /*Definiton of the main window, called "myView"*/ myView := widget Show({}); /* Circle */ widget Color(YY(Interval(0,2*pi,25)) if showcircle else {},"White"), parent <- `myView; /*Definition of the segment from A to B*/ widget Color(Segment12(Interval(0,1,11)) if showsegment12 else {},"Blue"), parent <- `myView; /*Calculation of the perpendicular bisector of the segment from A to B. Note that this is done in two parts, each of which will ordinarily have points on both halves of the sphere, so turning off the antipode doesn't automatically remove a portion on the lower half of the original sphere*/ widget Color(pRotate(pqMidpoint(A,B))(Segment12(Interval(-3,3,30))) if showperp12 else {},"Green"), parent <- `myView; widget Color(Reflect(pRotate(pqMidpoint(A,B))(Segment12(Interval(-3,3,30)))) if showperp12 and showantipodes else {},"Green"), parent <- `myView; /*Calculation of the line through the midpoints of two edges, AC and BC*/ widget Color((pqArc(pqMidpoint(A,C), pqMidpoint(B,C)))(Interval(-3,3,30)) if showmidcurve12 else {},"Orange"), parent<-`myView; widget Color(Reflect((pqArc(pqMidpoint(A,C), pqMidpoint(B,C)))(Interval(-3,3,30))) if showmidcurve12 and showantipodes else {},"Orange"), parent<-`myView; /*Calculation of the remaining segments*/ widget Color(Segment23(Interval(0,1,11)) if showsegment23 else {},"Red"), parent <- `myView; widget Color(Segment31(Interval(0,1,11)) if showsegment31 else {},"Yellow"), parent <- `myView; widget Color(Reflect(Segment12(Interval(0,1,11))) if showsegment12 and showantipodes else {},"Blue"), parent <- `myView; widget Color(Reflect(Segment23(Interval(0,1,11))) if showsegment23 and showantipodes else {},"Red"), parent <- `myView; widget Color(Reflect(Segment31(Interval(0,1,11))) if showsegment31 and showantipodes else {},"Yellow"), parent <- `myView; /*Specifications of the sphere*/ widget Color((ColorByLight2 [1,1,1] X U) if showsphere else {},"4:white->white"), parent <- `myView; /*Definition of the spherical triangle determined by A, B, and C*/ Triangle123:= R^?^3->{R^?}:[A,B,C]->triangle([A, B, C], 11); showtriangle:=widget CheckBox, init <- True; widget Color(Unit(Triangle123[A,B,C])if showtriangle else {}, "Purple"), parent<-`myView; widget Color(Reflect(Unit(Triangle123[A,B,C]))if showtriangle and showantipodes else {}, "Purple"), parent<-`myView; widget Color(Text(A, ".A")union Text(B, ".B")union Text(C, ".C") ,"white"),parent<-`myView; widget Color( Text(-A, ".-A")union Text(-B, ".-B")union Text(-C, ".-C") if showantipodes else {} ,"white"),parent<-`myView; pqPole:=(R^?,R^?)->R^?:(p,q)->Unit(p>R^?:(p,q,r)->(Unit(pqPole(p,q)>(R->R^?):(p,q,r)->(pqArc(r,pqrFoot(p,q,r))); widget Color(pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),C)(Interval(0,1,11)) if showperp else {}, "Green"), parent<-`myView; widget Color(pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),B)(Interval(0,1,11)) if showperp else {}, "Green"), parent<-`myView; widget Color(pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),A)(Interval(0,1,11)) if showperp else {}, "Green"), parent<-`myView; V:=Patch((0,1,11),(0,1,11)); Y:=R^2->R^?:[u,v]->pqArc(pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),B)(u),pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),A)(u))(v); ZBC:=R^2->R^?:[u,v]->pqArc(pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),B)(u),pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),C)(u))(v); ZAC:=R^2->R^?:[u,v]->pqArc(pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),A)(u),pqrFootarc(pqMidpoint(A,C), pqMidpoint(B,C),C)(u))(v); widget Color(Y(V) if showquad else {},"Blue"), parent<-`myView; widget Color(ZBC(V) if showquadBC else {},"Red"), parent<-`myView; widget Color(ZAC(V) if showquadAC else {},"Yellow"), parent<-`myView;