(*^ ::[ frontEndVersion = "Microsoft Windows Mathematica Notebook Front End Version 2.2"; microsoftWindowsStandardFontEncoding; fontset = title, "Times", 24, L0, center, nohscroll, bold; fontset = subtitle, "Times", 18, L0, center, nohscroll, bold; fontset = subsubtitle, "Times", 14, L0, center, nohscroll, italic; fontset = section, "Times", 18, L0, nohscroll, bold, grayBox; fontset = subsection, "Times", 14, L0, nohscroll, bold, blackBox; fontset = subsubsection, "Times", 13, L0, nohscroll, B65535; fontset = text, "Times", 12, L0, nohscroll, cellOutline; fontset = smalltext, "Times", 10, L0, nohscroll; fontset = input, "Courier", 12, L-5, nowordwrap, bold; fontset = output, "Courier", 12, L-5, nowordwrap; fontset = message, "Courier", 12, L-5, nowordwrap, R65535; fontset = print, "Courier", 12, L-5, nowordwrap; fontset = info, "Courier", 12, L-5, nowordwrap, B65535; fontset = postscript, "Courier", 12, L0, nowordwrap; fontset = name, "Geneva", 10, L0, nohscroll, italic; fontset = header, "Times", 12, L0; fontset = footer, "Times", 12, L0, center; fontset = help, "Times", 10, L0, nohscroll; fontset = clipboard, "Times", 12, L0, nohscroll; fontset = completions, "Times", 12, L0, nohscroll; fontset = graphics, "Courier New", 10, L0, nowordwrap, nohscroll; fontset = special1, "Times", 12, L0, nohscroll; fontset = special2, "Times", 12, L0, nohscroll; fontset = special3, "Times", 12, L0, nohscroll; fontset = special4, "Times", 12, L0, nohscroll; fontset = special5, "Times", 12, L0, nohscroll; fontset = leftheader, "Times", 12, L2; fontset = leftfooter, "Times", 12, L2; fontset = reserved1, "Courier New", 10, L0, nowordwrap, nohscroll;] :[font = title; inactive; preserveAspect; nohscroll; center; ] MathLive Professional :[font = subsubtitle; inactive; preserveAspect; startGroup; nohscroll; center; ] Wineglass example Original by L.Angrave 1996 Last Update: 25/496 :[font = section; inactive; preserveAspect; startGroup; nohscroll; ] Introductory Notes :[font = subsubsection; inactive; preserveAspect; endGroup; nohscroll; ] This notebook creates three glasses and tips the bottle into the top wine glass. :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Define the graphics :[font = input; initialization; preserveAspect; nowordwrap; ] *) General::spell1 //Off; Needs["Graphics`SurfaceOfRevolution`"] Needs["MathLive`MathLive`"]; SetDisplay[ NoteBook ->On, Live->Off]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Create wine bottle graphics using a simple switch function. :[font = input; initialization; preserveAspect; nowordwrap; ] *) (* bottle *) bottleOutline = { # , 1. + 2. ( 1./ (1. + 1. Exp[ (#-9)] ) ) }& /@ Range[0.,15.,.5]; ListPlot[ bottleOutline, PlotRange -> {{0,15},{0,5}}] ; gBottle = ListSurfaceOfRevolution[ bottleOutline , RevolutionAxis -> {1,0,0}]; (* :[font = input; inactive; initialization; preserveAspect; nowordwrap; ] The glass base is an exponential decay and the bowl is based upon a circle. We add an extra point to close the basin. :[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ] *) (* wine glass *) glassOutline = Insert[ {# ,1. + 3. Exp[-#] + Re[ Sqrt[ (16. - (#-10.)^2)] ] }& /@ Range[0.,10.,.5] , {6,0} , 12 ]; ListPlot[ glassOutline]; gWineGlass = ListSurfaceOfRevolution[ glassOutline , RevolutionAxis -> {1,0,0}]; (* :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Create the objects in MathLive :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Start MathLive :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) LaunchLive[]; ResetLive[]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Define the Model Range :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) Live[ Change[ Model3D["Default`"] , ModelRange -> {{-7,-7,-7},{16,16,16}} , BoundingBox ->Off ]]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Create tabletop :[font = input; initialization; preserveAspect; nowordwrap; ] *) Plot3D[ 0, {x,-10,10},{y,-10,10} , PlotPoints ->10 , DisplayFunction->Live ]; tableObject = LastObjectCreated[]; (* :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) Live[ Change[ tableObject , Color -> {{Hue[0.0],Hue[.7]}} , RenderMode ->SmoothShaded , Specular ->0 , MouseMovement->False , Scale ->2]]; (* :[font = subsubsection; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Create the wineglasses :[font = input; initialization; preserveAspect; nowordwrap; ] *) (* Height of the wine glass tower *) nGlasses = 2; (* 2 layers so 2+1 = 3 wineglasses!*) Do[ rowGlasses = nGlasses - (z-1); Do[ xPosn = 11. (x - rowGlasses/2 - 1/2); zPosn = 10. (z-1); Live[ gWineGlass]; wineGlass = LastObjectCreated[]; Live[ Change[ wineGlass , PointOfRotation -> {0,0,0} , Color -> RGBColor[0.8,0.8,1] , Diffuse -> 1 , RenderMode -> SmoothShaded , Location -> {xPosn,0,zPosn } , Euler-> {0,-Pi/2,0}] ]; , {x,rowGlasses} ] , {z,nGlasses} ]; (* :[font = input; initialization; preserveAspect; nowordwrap; ] *) Live[ Create[ Object3D["Bottle"] , gBottle ] ]; (* :[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ] *) Live[ Change[ Object3D["Bottle"] , PointOfRotation -> {0,0,0} , Euler-> {0,-Pi/2,0} , Location -> {-5, -15 ,0.} , RenderMode -> SmoothShaded , Color -> RGBColor[0.5,.8,0.5] ] ]; (* :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Animations :[font = subsection; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Animate the bottle :[font = input; initialization; preserveAspect; nowordwrap; ] *) maxFrame = 10; anim1 = Table[ Change[ Object3D["Bottle"] , Euler-> {.75 Pi/2, -Pi/2 ,0} , Location -> {-5, -15 ,frame/maxFrame 10 (nGlasses+.5) } ] , { frame, 0,maxFrame,1} ] ~Join~ Table[ Change[ Object3D["Bottle"] , Euler-> {.75 Pi/2, -Pi/2 (1-1.2 frame/maxFrame),0 } ] , { frame, 0,maxFrame,1} ]; (* :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) Live[ anim1]; (* :[font = subsection; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Animate the top wine glass in a most peculiar fashion (hic) :[font = input; initialization; preserveAspect; nowordwrap; ] *) anim2 = Table[ Change[ wineGlass , Scale -> 1+ theta /(8 Pi) {Sin[theta],0,Sin[theta/2]} ] , {theta,0,8 Pi, Pi/ 8} ]; (* :[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ] *) Live[ anim2 ]; (* :[font = section; inactive; preserveAspect; startGroup; nohscroll; ] For further information, advice or suggestions please contact- :[font = text; inactive; preserveAspect; endGroup; endGroup; nohscroll; cellOutline; backColorRed = 65535; backColorGreen = 65535; backColorBlue = 65535; fontColorRed = 0; fontColorGreen = 0; fontColorBlue = 0; plain; fontName = "Times"; fontSize = 12; ] Email: support@milohedge.com Post: Milo Hedge Ltd, The Oxford Centre for Innovation, Mill Street, Oxford, OX2 0JX WWW: http://www.milohedge.com/mathlive/ ^*)