1(*
2        plmtex3, plptex3 demo.
3
4   Copyright (C) 2007 Alan W. Irwin
5   Copyright (C) 2008, 2010 Hezekiah M. Carty
6
7  This file is part of PLplot.
8
9  PLplot is free software; you can redistribute it and/or modify
10  it under the terms of the GNU Library General Public License as published
11  by the Free Software Foundation; either version 2 of the License, or
12  (at your option) any later version.
13
14  PLplot is distributed in the hope that it will be useful,
15  but WITHOUT ANY WARRANTY; without even the implied warranty of
16  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17  GNU Library General Public License for more details.
18
19  You should have received a copy of the GNU Library General Public License
20  along with PLplot; if not, write to the Free Software
21  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22
23*)
24
25open Plplot
26
27let pi = atan 1.0 *. 4.0
28
29(* Choose these values to correspond to tick marks. *)
30let xpts = 2
31let ypts = 2
32let nrevolution = 16
33let nrotation = 8
34let nshear = 8
35
36(*--------------------------------------------------------------------------*\
37 * Demonstrates plotting text in 3D.
38\*--------------------------------------------------------------------------*)
39let () =
40  let xmin = 0.0 in
41  let xmax = 1.0 in
42  let xmid = 0.5 *. (xmax +. xmin) in
43  let xrange = xmax -. xmin in
44  let ymin = 0.0 in
45  let ymax = 1.0 in
46  let ymid = 0.5 *. (ymax +. ymin) in
47  let yrange = ymax -. ymin in
48  let zmin = 0.0 in
49  let zmax = 1.0 in
50  let zmid = 0.5 *. (zmax +. zmin) in
51  let zrange = zmax -. zmin in
52  let ysmin = ymin +. 0.1 *. yrange in
53  let ysmax = ymax -. 0.1 *. yrange in
54  let ysrange = ysmax -. ysmin in
55  let dysrot = ysrange /. float_of_int (nrotation - 1) in
56  let dysshear = ysrange /. float_of_int (nshear - 1) in
57  let zsmin = zmin +. 0.1 *. zrange in
58  let zsmax = zmax -. 0.1 *. zrange in
59  let zsrange = zsmax -. zsmin in
60  let dzsrot = zsrange /. float_of_int (nrotation - 1) in
61  let dzsshear = zsrange /. float_of_int (nshear - 1) in
62  let pstring =
63    "The future of our civilization depends on software freedom."
64  in
65  (* Allocate and define the minimal x, y, and z to insure 3D box *)
66  let x =
67    Array.init xpts (
68      fun i ->
69        xmin +. float_of_int i *. (xmax -. xmin) /. float_of_int (xpts - 1)
70    )
71  in
72  let y =
73    Array.init ypts (
74      fun j ->
75        ymin +. float_of_int j *. (ymax -. ymin) /. float_of_int (ypts - 1)
76    )
77  in
78  let z = Array.make_matrix xpts ypts 0.0 in
79
80  (* Parse and process command line arguments *)
81  plparseopts Sys.argv [PL_PARSE_FULL];
82
83  plinit ();
84
85  (* Page 1: Demonstrate inclination and shear capability pattern. *)
86  pladv 0;
87  plvpor (-0.15) 1.15 (-0.05) 1.05;
88  plwind (-1.2) 1.2 (-0.8) 1.5;
89  plw3d 1.0 1.0 1.0 xmin xmax ymin ymax zmin zmax 20.0 45.0;
90
91  plcol0 2;
92  plbox3 "b" "" (xmax -. xmin) 0
93         "b" "" (ymax -. ymin) 0
94         "bcd" "" (zmax -. zmin) 0;
95
96  plschr 0.0 1.0;
97  for i = 0 to nrevolution - 1 do
98    let omega = 2.0 *. pi *. float_of_int i /. float_of_int nrevolution in
99    let sin_omega = sin omega in
100    let cos_omega = cos omega in
101    let x_inclination = 0.5 *. xrange *. cos_omega in
102    let y_inclination = 0.5 *. yrange *. sin_omega in
103    let z_inclination = 0.0 in
104    let x_shear = -0.5 *. xrange *. sin_omega in
105    let y_shear = 0.5 *. yrange *. cos_omega in
106    let z_shear = 0.0 in
107    plptex3
108      xmid ymid zmin
109      x_inclination y_inclination z_inclination
110      x_shear y_shear z_shear
111      0.0 "  revolution";
112  done;
113
114  plschr 0.0 1.0;
115  for i = 0 to nrevolution - 1 do
116    let omega = 2.0 *. pi *. float_of_int i /. float_of_int nrevolution in
117    let sin_omega = sin omega in
118    let cos_omega = cos omega in
119    let x_inclination = 0.0 in
120    let y_inclination = -0.5 *. yrange *. cos_omega in
121    let z_inclination = 0.5 *. zrange *. sin_omega in
122    let x_shear = 0.0 in
123    let y_shear = 0.5 *. yrange *. sin_omega in
124    let z_shear = 0.5 *. zrange *. cos_omega in
125    plptex3
126      xmax ymid zmid
127      x_inclination y_inclination z_inclination
128      x_shear y_shear z_shear
129      0.0 "  revolution";
130  done;
131
132  plschr 0.0 1.0;
133  for i = 0 to nrevolution - 1 do
134    let omega = 2.0 *. pi *. float_of_int i /. float_of_int nrevolution in
135    let sin_omega = sin omega in
136    let cos_omega = cos omega in
137    let x_inclination = 0.5 *. xrange *. cos_omega in
138    let y_inclination = 0.0 in
139    let z_inclination = 0.5 *. zrange *. sin_omega in
140    let x_shear = -0.5 *. xrange *. sin_omega in
141    let y_shear = 0.0 in
142    let z_shear = 0.5 *. zrange *. cos_omega in
143      plptex3
144        xmid ymax zmid
145        x_inclination y_inclination z_inclination
146        x_shear y_shear z_shear
147        0.0 "  revolution";
148  done;
149  (* Draw minimal 3D grid to finish defining the 3D box. *)
150  plmesh x y z [PL_DRAW_LINEXY];
151
152  (* Page 2: Demonstrate rotation of string around its axis. *)
153  pladv 0;
154  plvpor (-0.15) 1.15 (-0.05) 1.05;
155  plwind (-1.2) 1.2 (-0.8) 1.5;
156  plw3d 1.0 1.0 1.0 xmin xmax ymin ymax zmin zmax 20.0 45.0;
157
158  plcol0 2;
159  plbox3 "b" "" (xmax -. xmin) 0
160         "b" "" (ymax -. ymin) 0
161         "bcd" "" (zmax -. zmin) 0;
162
163  plschr 0.0 1.0;
164  let x_inclination = 1.0 in
165  let y_inclination = 0.0 in
166  let z_inclination = 0.0 in
167  let x_shear = 0.0 in
168  for i = 0 to nrotation - 1 do
169    let omega = 2.0 *. pi *. float_of_int i /. float_of_int nrotation in
170    let sin_omega = sin omega in
171    let cos_omega = cos omega in
172    let y_shear = 0.5 *. yrange *. sin_omega in
173    let z_shear = 0.5 *. zrange *. cos_omega in
174    let zs = zsmax -. dzsrot *. float_of_int i in
175    plptex3
176      xmid ymax zs
177      x_inclination y_inclination z_inclination
178      x_shear y_shear z_shear
179      0.5 "rotation for y = y#dmax#u";
180  done;
181
182  plschr 0.0 1.0;
183  let x_inclination = 0.0 in
184  let y_inclination = -1.0 in
185  let z_inclination = 0.0 in
186  let y_shear = 0.0 in
187  for i = 0 to nrotation - 1 do
188    let omega = 2.0 *. pi *. float_of_int i /. float_of_int nrotation in
189    let sin_omega = sin omega in
190    let cos_omega = cos omega in
191    let x_shear = 0.5 *. xrange *. sin_omega in
192    let z_shear = 0.5 *. zrange *. cos_omega in
193    let zs = zsmax -. dzsrot *. float_of_int i in
194    plptex3
195      xmax ymid zs
196      x_inclination y_inclination z_inclination
197      x_shear y_shear z_shear
198      0.5 "rotation for x = x#dmax#u";
199  done;
200
201  plschr 0.0 1.0;
202  let x_inclination = 1.0 in
203  let y_inclination = 0.0 in
204  let z_inclination = 0.0 in
205  let x_shear = 0.0 in
206  for i = 0 to nrotation - 1 do
207    let omega = 2.0 *. pi *. float_of_int i /. float_of_int nrotation in
208    let sin_omega = sin omega in
209    let cos_omega = cos omega in
210    let y_shear = 0.5 *. yrange *. cos_omega in
211    let z_shear = 0.5 *. zrange *. sin_omega in
212    let ys = ysmax -. dysrot *. float_of_int i in
213    plptex3
214      xmid ys zmin
215      x_inclination y_inclination z_inclination
216      x_shear y_shear z_shear
217      0.5 "rotation for z = z#dmin#u";
218  done;
219  (* Draw minimal 3D grid to finish defining the 3D box. *)
220  plmesh x y z [PL_DRAW_LINEXY];
221
222  (* Page 3: Demonstrate shear of string along its axis. *)
223  (* Work around xcairo and pngcairo (but not pscairo) problems for
224     shear vector too close to axis of string. (N.B. no workaround
225     would be domega = 0.) *)
226  let domega = 0.05 in
227  pladv 0;
228  plvpor (-0.15) 1.15 (-0.05) 1.05;
229  plwind (-1.2) 1.2 (-0.8) 1.5;
230  plw3d 1.0 1.0 1.0 xmin xmax ymin ymax zmin zmax 20.0 45.0;
231
232  plcol0 2;
233  plbox3 "b" "" (xmax -. xmin) 0
234         "b" "" (ymax -. ymin) 0
235         "bcd" "" (zmax -. zmin) 0;
236
237  plschr 0.0 1.0;
238  let x_inclination = 1.0 in
239  let y_inclination = 0.0 in
240  let z_inclination = 0.0 in
241  let y_shear = 0.0 in
242  for i = 0 to nshear - 1 do
243    let omega = domega +. 2.0 *. pi *. float_of_int i /. float_of_int nshear in
244    let sin_omega = sin omega in
245    let cos_omega = cos omega in
246    let x_shear = 0.5 *. xrange *. sin_omega in
247    let z_shear = 0.5 *. zrange *. cos_omega in
248    let zs = zsmax -. dzsshear *. float_of_int i in
249    plptex3
250      xmid ymax zs
251      x_inclination y_inclination z_inclination
252      x_shear y_shear z_shear
253      0.5 "shear for y = y#dmax#u";
254  done;
255
256  plschr 0.0 1.0;
257  let x_inclination = 0.0 in
258  let y_inclination = -1.0 in
259  let z_inclination = 0.0 in
260  let x_shear = 0.0 in
261  for i = 0 to nshear - 1 do
262    let omega = domega +. 2.0 *. pi *. float_of_int i /. float_of_int nshear in
263    let sin_omega = sin omega in
264    let cos_omega = cos omega in
265    let y_shear = -0.5 *. yrange *. sin_omega in
266    let z_shear = 0.5 *. zrange *. cos_omega in
267    let zs = zsmax -. dzsshear *. float_of_int i in
268    plptex3
269      xmax ymid zs
270      x_inclination y_inclination z_inclination
271      x_shear y_shear z_shear
272      0.5 "shear for x = x#dmax#u";
273  done;
274
275  plschr 0.0 1.0;
276  let x_inclination = 1.0 in
277  let y_inclination = 0.0 in
278  let z_inclination = 0.0 in
279  let z_shear = 0.0 in
280  for i = 0 to nshear - 1 do
281    let omega = domega +. 2.0 *. pi *. float_of_int i /. float_of_int nshear in
282    let sin_omega = sin omega in
283    let cos_omega = cos omega in
284    let y_shear = 0.5 *. yrange *. cos_omega in
285    let x_shear = 0.5 *. xrange *. sin_omega in
286    let ys = ysmax -. dysshear *. float_of_int i in
287    plptex3
288      xmid ys zmin
289      x_inclination y_inclination z_inclination
290      x_shear y_shear z_shear
291      0.5 "shear for z = z#dmin#u";
292  done;
293  (* Draw minimal 3D grid to finish defining the 3D box. *)
294  plmesh x y z [PL_DRAW_LINEXY];
295
296  (* Page 4: Demonstrate drawing a string on a 3D path. *)
297  pladv 0;
298  plvpor (-0.15) 1.15 (-0.05) 1.05;
299  plwind (-1.2) 1.2 (-0.8) 1.5;
300  plw3d 1.0 1.0 1.0 xmin xmax ymin ymax zmin zmax 40.0 (-30.0);
301
302  plcol0 2;
303  plbox3 "b" "" (xmax -. xmin) 0
304         "b" "" (ymax -. ymin) 0
305         "bcd" "" (zmax -. zmin) 0;
306
307  plschr 0.0 1.2;
308  (* domega controls the spacing between the various characters of the
309     string and also the maximum value of omega for the given number
310     of characters in pstring. *)
311  let domega = 2.0 *. pi /. float_of_int (String.length pstring) in
312  (* 3D function is a helix of the given radius and pitch *)
313  let radius = 0.5 in
314  let pitch = 1.0 /. (2.0 *. pi) in
315  for i = 0 to String.length pstring - 1 do
316    let omega = 0.0 +. float_of_int i *. domega in
317    let sin_omega = sin omega in
318    let cos_omega = cos omega in
319    let xpos = xmid +. radius *. sin_omega in
320    let ypos = ymid -. radius *. cos_omega in
321    let zpos = zmin +. pitch *. omega in
322    (* In general, the inclination is proportional to the derivative of
323       the position wrt theta. *)
324    let x_inclination = radius *. cos_omega in
325    let y_inclination = radius *. sin_omega in
326    let z_inclination = pitch in
327    (* The shear vector should be perpendicular to the 3D line with Z
328       component maximized, but for low pitch a good approximation is
329       a constant vector that is parallel to the Z axis. *)
330    let x_shear = 0.0 in
331    let y_shear = 0.0 in
332    let z_shear = 1.0 in
333    let p1string = String.sub pstring i 1 in
334    plptex3
335      xpos ypos zpos
336      x_inclination y_inclination z_inclination
337      x_shear y_shear z_shear
338      0.5 p1string;
339  done;
340
341  (* Draw minimal 3D grid to finish defining the 3D box. *)
342  plmesh x y z [PL_DRAW_LINEXY];
343
344  (* Page 5: Demonstrate plmtex3 axis labelling capability *)
345  pladv 0;
346  plvpor (-0.15) 1.15 (-0.05) 1.05;
347  plwind (-1.2) 1.2 (-0.8) 1.5;
348  plw3d 1.0 1.0 1.0 xmin xmax ymin ymax zmin zmax 20.0 45.0;
349
350  plcol0 2;
351  plbox3 "b" "" (xmax -. xmin) 0
352         "b" "" (ymax -. ymin) 0
353         "bcd" "" (zmax -. zmin) 0;
354
355  plschr 0.0 1.0;
356  plmtex3 "xp" 3.0 0.5 0.5 "Arbitrarily displaced";
357  plmtex3 "xp" 4.5 0.5 0.5 "primary X-axis label";
358  plmtex3 "xs" (-2.5) 0.5 0.5 "Arbitrarily displaced";
359  plmtex3 "xs" (-1.0) 0.5 0.5 "secondary X-axis label";
360  plmtex3 "yp" 3.0 0.5 0.5 "Arbitrarily displaced";
361  plmtex3 "yp" 4.5 0.5 0.5 "primary Y-axis label";
362  plmtex3 "ys" (-2.5) 0.5 0.5 "Arbitrarily displaced";
363  plmtex3 "ys" (-1.0) 0.5 0.5 "secondary Y-axis label";
364  plmtex3 "zp" 4.5 0.5 0.5 "Arbitrarily displaced";
365  plmtex3 "zp" 3.0 0.5 0.5 "primary Z-axis label";
366  plmtex3 "zs" (-2.5) 0.5 0.5 "Arbitrarily displaced";
367  plmtex3 "zs" (-1.0) 0.5 0.5 "secondary Z-axis label";
368  (* Draw minimal 3D grid to finish defining the 3D box. *)
369  plmesh x y z [PL_DRAW_LINEXY];
370
371  (* Clean up. *)
372  plend ();
373  ()
374
375