home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / GRAPHICS.PAK / THREESCR.M < prev   
Encoding:
Text File  |  1992-07-29  |  7.2 KB  |  287 lines
  1.  
  2. (* :Name: Graphics`ThreeScript *)
  3.  
  4. (* :Title: 3-Script File Format *)
  5.  
  6. (* :Author: *)
  7.  
  8. (* :Summary:
  9.     This package contains routines for converting three-dimensional
  10.      graphical objects from Mathematica into the 3-Script file format
  11.     and writing them into files (or on suitable operating systems
  12.     pipes).
  13. *)
  14.  
  15. (* :Context: Graphics`ThreeScript *)
  16.  
  17. (* :Package Version: 2.0 *)
  18.  
  19. (* :Copyright: Copyright 1991  Wolfram Research, Inc.
  20.         Permission is hereby granted to modify and/or make copies of
  21.         this file for any purpose other than direct profit, or as part
  22.         of a commercial product, provided this copyright notice is left
  23.         intact.  Sale, other than for the cost of media, is prohibited.
  24.  
  25.         Permission is hereby granted to reproduce part or all of
  26.         this file, provided that the source is acknowledged.
  27. *)
  28.  
  29. (* :History:
  30.         Extensively revised by C. Tom Wickham-Jones, May, 1991.
  31.         Version 1.0 by Stephen Wolfram, 1988.
  32. *)
  33.  
  34. (* :Source:
  35.     3-Script File Format, Technical Report Number T3100,
  36.         Wolfram Research, Inc., 1991.
  37. *)
  38.  
  39. (* :Mathematica Version: 2.0 *)
  40.  
  41. (* :Limitation:
  42.     Output is only generated for three-dimensional graphics
  43.     objects.  Two-dimensional objects are left unevaluated.
  44. *)
  45.  
  46.  
  47.     (***  ThreeScript Output Generator  ***)
  48.  
  49. BeginPackage["Graphics`ThreeScript`"]
  50.  
  51. ThreeScript::usage =
  52. "ThreeScript[file, graphics] writes 3D graphics to a file in ThreeScript
  53. format and returns the filename.
  54. ThreeScript[ graphics] opens a temporary file, writes to that file, and
  55. returns the file name."
  56.  
  57. Begin["`private`"]
  58.  
  59. ThreeScript::nodata = "ThreeScript has received an object with no graphical
  60. primitives to render."
  61.  
  62. (** Graphics3D output **)
  63.  
  64. ThreeScript[ g_] :=
  65.     ThreeScript[ OpenTemporary[], g]
  66.  
  67. ThreeScript[ file_String, g_]  := 
  68.     Block[{stm},
  69.         stm = OpenWrite[ file] ;
  70.         ThreeScript[ stm, g];
  71.         Close[stm]
  72.     ]
  73.  
  74.  
  75. ThreeScript[stream_OutputStream, gg:Graphics3D[g_, ___]] :=
  76.     (
  77.     WriteName[stream, "% Graphics3D objects"] ;
  78.     If[ TSBounding[stream, g],
  79.         TSOptions[stream, Flatten[Options[gg]], Options[Graphics3D]] ;
  80.         TS0[stream, g] ;
  81.     ] ;
  82.     StreamToFile[ stream]
  83.     )
  84.  
  85. TSBounding[file_, g_] :=
  86.     Block[{min, max, mini, maxi},
  87.         mini = min = {Infinity,Infinity,Infinity};
  88.         maxi = max = -min;
  89.         Scan[TSBounding0[#,min,max]&, Flatten[{g}]] ;
  90.         If[min==mini || max==maxi,
  91.             Message[ThreeScript::nodata]; Return[False] ]; 
  92.         WriteName[file, "boundingbox"] ;
  93.         WriteTriple[file, min] ;
  94.         WriteTriple[file, max] ;
  95.         Return[True]
  96.     ]
  97.  
  98. SetAttributes[{TSBounding0, TSBounding1}, HoldRest]
  99.  
  100. TSBounding0[Polygon[g_List], min_, max_] :=
  101.     Scan[TSBounding1[#, min, max]&, g]
  102.  
  103. TSBounding0[Line[g_List], min_, max_] :=
  104.     Scan[TSBounding1[#, min, max]&, g]
  105.  
  106. TSBounding0[Point[g_List], min_, max_] :=
  107.     TSBounding1[g, min, max]
  108.  
  109. TSBounding0[ Cuboid[g_List], min_, max_] :=
  110.         (TSBounding1[g, min, max];
  111.          TSBounding1[g+{1,1,1}, min, max])
  112.  
  113. TSBounding0[Cuboid[g_List, h_List], min_, max_] :=
  114.         (TSBounding1[g, min, max];
  115.          TSBounding1[ h, min, max])
  116.  
  117.  
  118. TSBounding1[l:{_,_,_}, min, max] :=
  119.     (
  120.     min = Map[Min, Transpose[{l, min}]] ;
  121.     max = Map[Max, Transpose[{l, max}]] ;
  122.     )
  123.  
  124. TSOptions[file_, opts_, dopts_] :=
  125.     (
  126.     WriteViewPoint[file, ViewPoint /. opts /. dopts] ;
  127.     If[Lighting /. opts /. dopts, 
  128.         WriteAmbientLight[file, AmbientLight /. opts /. dopts] ;
  129.         WriteLightSources[file, LightSources /. opts /. dopts] ;
  130.     ]
  131.     )
  132.  
  133. WriteViewPoint[file_,v:{_,_,_}] :=
  134.     (
  135.     WriteName[file, "viewpoint"] ;
  136.     WriteTriple[file, v] 
  137.     )
  138.  
  139. WriteAmbientLight[file_,a_] :=
  140.     (
  141.     WriteName[file, "ambientlight"] ;
  142.     WriteColor[file, a]
  143.     )
  144.     
  145. WriteColor[file_, RGBColor[r_,g_,b_]] :=
  146.     WriteTriple[file, {r,g,b}]
  147.  
  148. WriteColor[file_, GrayLevel[x_]] :=
  149.     WriteTriple[file, {x,x,x}]
  150.  
  151. WriteColor[file_, {x_}] := WriteColor[file, x]
  152.  
  153. WriteLightSources[file_,s_List] :=
  154.     (
  155.     WriteName[file, "lightsources"] ;
  156.     Scan[WriteLS0[file, #]&, s] 
  157.     )
  158.  
  159. WriteLS0[file_, {dir:{_,_,_}, c_}] :=
  160.     (
  161.     WriteTriple[file, dir] ;
  162.     WriteColor[file, c]
  163.     )
  164.  
  165. TS0[file_, g_List] := Scan[TS0[file, #]&, g]
  166.  
  167. WriteName[file_, name_String] :=
  168.     Write[file, TextForm[name]]
  169.  
  170. TS0[file_, Cuboid[g_List]] :=
  171.     TS0[file, Cuboid[g, g + {1,1,1}]]
  172.  
  173. TS0[file_, Cuboid[g1_List, h1_List]] :=
  174.     Block[ {a,b,c,d,e,f,g,h, rs},
  175.         a = g1 ;
  176.         b = CuboidAux[ g1, h1, {1,0,0}] ;
  177.         c = CuboidAux[ g1, h1, {1,1,0}] ;
  178.         d = CuboidAux[ g1, h1, {0,1,0}] ;
  179.         e = CuboidAux[ g1, h1, {0,0,1}] ;
  180.         f = CuboidAux[ g1, h1, {1,0,1}] ;
  181.         g = h1 ;
  182.         h = CuboidAux[ g1, h1, {0,1,1}] ;
  183.         res = {Polygon[ {a,b,c,d}], Polygon[ {a,b,f,e}],
  184.                Polygon[ {a,d,h,e}], Polygon[ {b,c,g,f}],
  185.                Polygon[ {e,f,g,h}], Polygon[ {d,c,g,h}]};
  186.         TS0[ file, res]
  187.     ]
  188.  
  189. CuboidAux[ g_List, h_List, vec_List] :=
  190.     (g ({1,1,1} - vec) + h vec)
  191.  
  192. TS0[file_, Polygon[g_List]] :=
  193.     (
  194.     WriteName[file, "polygon"] ;
  195.     Scan[WriteTriple[file, #]&, g] 
  196.     )
  197.  
  198. TS0[file_, Line[g_List]] :=
  199.     (
  200.     WriteName[file, "line"] ;
  201.     Scan[WriteTriple[file, #]&, g]
  202.     )
  203.  
  204. TS0[file_, Point[g_List]] :=
  205.     (
  206.     WriteName[file, "point"] ;
  207.     WriteTriple[file, g]
  208.     )
  209.  
  210. TS0[file_, g:RGBColor[_,_,_]] :=
  211.     (
  212.     WriteName[file, "color"] ;
  213.     WriteTriple[file, Apply[List, g]]
  214.     )
  215.  
  216. TS0[file_, GrayLevel[x_]] :=
  217.     (
  218.     WriteName[file, "color"] ;
  219.     WriteTriple[file, {x, x, x}]
  220.     )
  221.  
  222.  
  223. WriteTriple[file_, g:{_,_,_}] :=
  224.     Apply[Write[file, CForm[#1], TextForm[" "], 
  225.                 CForm[#2], TextForm[" "], CForm[#3]]&, g]
  226.  
  227.     
  228.  
  229.  
  230. (** SurfaceGraphics output **)
  231.  
  232. ThreeScript[stream_OutputStream, gg:SurfaceGraphics[g_, gc:{__List}, ___]] :=
  233.         Block[{d1, d2, t},
  234.                 WriteName[stream, "% SurfaceGraphics objects"] ;
  235.         SurfaceBounding[stream, g, PlotRange[gg]] ; 
  236.                 TSOptions[stream, Flatten[Options[gg]], 
  237.                     Options[SurfaceGraphics]] ;
  238.                 {d1, d2} = Dimensions[g] ;
  239.                 Write[stream, TextForm["colormesh "], CForm[d1], TextForm[" "],
  240.                         CForm[d2]] ;
  241.         WriteName[stream, "% z values"] ;
  242.                 Scan[Write[stream, CForm[#]]&, g, {2}];
  243.         WriteName[stream, "% color values"] ;
  244.         Scan[TSShade[stream, #]&, gc, {2}];
  245.         StreamToFile[ stream]
  246.         ]
  247.  
  248. (** Assumes BoxRatios -> { 1, 1, 0.4}  **)
  249.  
  250. SurfaceBounding[file_, g_List, { _, _,{zmin_, zmax_}}] :=
  251.         Block[{dim},
  252.                 dim = (zmax - zmin) / 0.4;
  253.                 WriteName[file, "boundingbox"] ;
  254.                 WriteTriple[file, {0, 0, zmin}] ;
  255.                 WriteTriple[file, {dim, dim, zmax}]
  256.         ]
  257.  
  258. SurfaceBounding[file_, g_List, _Symbol] :=
  259.         SurfaceBounding[file, g,
  260.         {Apply[Min, Flatten[g]], Apply[Max, Flatten[g]]}
  261.         ]
  262.  
  263. TSShade[file_, g_RGBColor] :=
  264.     WriteTriple[file, Apply[List, g]]
  265.  
  266. TSShade[file_, GrayLevel[g_]] :=
  267.     WriteTriple[file, {g, g, g}]
  268.  
  269. ThreeScript[stream_OutputStream, gg:SurfaceGraphics[g_, ___]] :=
  270.     Block[{d1, d2, t}, 
  271.             WriteName[stream, "% SurfaceGraphics objects"] ; 
  272.         SurfaceBounding[stream, g, PlotRange[ gg]] ;
  273.             TSOptions[stream, Flatten[Options[gg]], 
  274.                     Options[SurfaceGraphics]] ;
  275.         {d1, d2} = Dimensions[g] ;
  276.         Write[stream, TextForm["mesh "], CForm[d1], TextForm[" "],
  277.             CForm[d2]] ;
  278.         Scan[Write[stream, CForm[#]]&, g, {2}];
  279.         StreamToFile[ stream]
  280.     ]
  281.  
  282. StreamToFile[ stm_OutputStream] := First[stm]
  283.  
  284. End[ ]
  285. EndPackage[ ]
  286.  
  287.