%%%% bldelem2.lmc
%%%% Created by Laurence D. Finston (LDF) Wed Jun 20 16:35:51 CEST 2012

%% * (1) Copyright and License.

%%%% This file is part of GNU 3DLDF, a package for three-dimensional drawing.  
%%%% Copyright (C) 2012, 2013 The Free Software Foundation  

%%%% GNU 3DLDF is free software; you can redistribute it and/or modify 
%%%% it under the terms of the GNU General Public License as published by 
%%%% the Free Software Foundation; either version 3 of the License, or 
%%%% (at your option) any later version.  

%%%% GNU 3DLDF is distributed in the hope that it will be useful, 
%%%% but WITHOUT ANY WARRANTY; without even the implied warranty of 
%%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
%%%% GNU General Public License for more details.  

%%%% You should have received a copy of the GNU General Public License 
%%%% along with GNU 3DLDF; if not, write to the Free Software 
%%%% Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA 

%%%% GNU 3DLDF is a GNU package.  
%%%% It is part of the GNU Project of the  
%%%% Free Software Foundation 
%%%% and is published under the GNU General Public License. 
%%%% See the website http://www.gnu.org 
%%%% for more information.   
%%%% GNU 3DLDF is available for downloading from 
%%%% http://www.gnu.org/software/3dldf/LDF.html.

%%%% Please send bug reports to Laurence.Finston@gmx.de
%%%% The mailing list help-3dldf@gnu.org is available for people to 
%%%% ask other users for help.  
%%%% The mailing list info-3dldf@gnu.org is for sending 
%%%% announcements to users. To subscribe to these mailing lists, send an 
%%%% email with ``subscribe <email-address>'' as the subject.  

%%%% The author can be contacted at: 

%%%% Laurence D. Finston 
%%%% c/o Free Software Foundation, Inc. 
%%%% 51 Franklin St, Fifth Floor 
%%%% Boston, MA  02110-1301  
%%%% USA

%%%% Laurence.Finston@gmx.de
 


%% Created:        June 20, 2012
%% Last Updated:   June 23, 2012

input "bldelem1.lmc";

%% * (1) Macros

%% ** (2) rect_prism_ma (rectangular prism, multiple angles)

%% V: picture or 0

macro rect_prism_ma;

%% STP:  Single-Tab Picture
%% DTP:  Double-Tab Picture

def rect_prism_ma (V, W, STP, DTP, LP) {numeric h_val_side, numeric v_val_side, numeric hheight,
                          numeric rot_angle_a, numeric rot_angle_b, numeric rot_angle_c, 
                          numeric rot_angle_d,
			  numeric ccross_a, 
			  numeric ccross_b, 
			  numeric ccross_c, 
			  numeric ccross_d,
			  numeric ccross_e} = 

%% *** (3)

   rectangle r[];

   boolean do_labels;

   do_labels := false;

   r0 := unit_rectangle scaled (h_val_side, 0, v_val_side);

   r1 := r0 shifted (0, hheight);

   point p[];

   for i := 0 upto 3:
      p[i] := get_point (i) r0;
      p[i + 4] := get_point (i) r1;
 
     j := i + 1;

      if j == 4:
         j := 0;
      fi;

      p[i + 8] := mediate(get_point (i) r0, get_point (j) r0);
      p[i + 12] := mediate(get_point (i) r1, get_point (j) r1);

      p[i + 16] := mediate(p[i], p[i + 4]);

      p[i + 20] := mediate(p[i + 8], p[i + 12]);

   endfor;

   circle c[];

   transform t[];

   t0 := identity rotated (0, 0, 90);
   shift t0 by p21;

   t1 := identity rotated (0, 0, 90);
   shift t1 by p23;

   if    (rot_angle_a == 0) or (rot_angle_a == 90) or (rot_angle_a == 180) 
      or (rot_angle_a == 270) or (rot_angle_a == 360):
      message "rot_angle_a == "; 
      show rot_angle_a;
      message "rot_angle_a == 0 or 90 or 180 or 270 or 360.  Not rotating.";
   else:
      %message "rot_angle_a == "; 
      %show rot_angle_a;
      %message "rot_angle_a <> 0 and <> 90 and <> 180 and <> 270 and <> 360.  Rotating.";
      rotate_around t0 (p17, p18) rot_angle_a;
   fi;

   if (rot_angle_b == 0) or (rot_angle_b == 90) or (rot_angle == 180)
      or (rot_angle_b == 270) or (rot_angle_b == 360):
      message "rot_angle_b == "; 
      show rot_angle_b;
      message "rot_angle_b == 0 or 90 or 180 or 270 or 360.  Not rotating.";
   else:
      %message "rot_angle_b == "; 
      %show rot_angle_b;
      %message "rot_angle_b <> 0 and <> 90 and <> 180 and <> 270 and <> 360.  Rotating.";
      rotate_around t0 (p9, p13) rot_angle_b;
   fi;

   if (rot_angle_c == 0) or (rot_angle_c == 90) or (rot_angle == 180)
      or (rot_angle_c == 270) or (rot_angle_c == 360):
      message "rot_angle_c == "; 
      show rot_angle_c;
      message "rot_angle_c == 0 or 90 or 180 or 270 or 360.  Not rotating.";
   else:
      %message "rot_angle_c == "; 
      %show rot_angle_c;
      %message "rot_angle_c <> 0 and <> 90 and <> 180 and <> 270 and <> 360.  Rotating.";
      rotate_around t1 (p16, p19) rot_angle_c;
   fi;

   if (rot_angle_d == 0) or (rot_angle_d == 90) or (rot_angle == 180)
      or (rot_angle_d == 270) or (rot_angle_d == 360):
      message "rot_angle_d == "; 
      show rot_angle_d;
      message "rot_angle_d == 0 or 90 or 180 or 270 or 360.  Not rotating.";
   else:
      %message "rot_angle_d == "; 
      %show rot_angle_d;
      %message "rot_angle_d <> 0 and <> 90 and <> 180 and <> 270 and <> 360.  Rotating.";
      rotate_around t1 (p11, p15) -rot_angle_d;
   fi;
   
   c0 := unit_circle scaled (2v_val_side, 0, 2v_val_side);
   c1 := unit_circle scaled (v_val_side, 0, v_val_side);

   c0 *= c1 *= t0;

   c2 := unit_circle scaled (2v_val_side, 0, 2v_val_side);
   c3 := unit_circle scaled (v_val_side, 0, v_val_side);

   c2 *= c3 *= t1;


%% *** (3)

%% **** (4)

   string s;

   point temp_pt;

   bool_point_vector bpv;

   for i := 0 step 2 until 6:
      bpv := (p[i] -- p[i + 1]) intersection_points c0;

      %show bpv;

      p[24 + .5i] := bpv0;
      temp_pt := bpv1;

      if is_invalid p[24 + .5i]:
        s := "p" & decimal (24 + .5i) & " is invalid.  Trying again.";
        message s;
        p[24 + i] := temp_pt;
        if is_invalid p[24 + .5i]:
           s := "p" & decimal (24 + .5i) & " is still invalid.  Quitting.";
           message s;
           end;
        else:
           s := "p" & decimal (24 + .5i) & "is now valid.  Continuing.";
           message s;
        fi;
      else:
           s := "p" & decimal (24 + .5i) & " is valid.";
           message s;
      fi;

      bpv := (p[i] -- p[i + 1]) intersection_points c2;

      p[28 + .5i] := bpv0;
      temp_pt := bpv1;

      if is_invalid p[28 + .5i]:
        s := "p" & decimal (28 + .5i) & " is invalid.  Trying again.";
        message s;
        p[28 + i] := temp_pt;
        if is_invalid p[28 + .5i]:
           s := "p" & decimal (28 + .5i) & " is still invalid.  Quitting.";
           message s;
           end;
        else:
           s := "p" & decimal (28 + .5i) & "is now valid.  Continuing.";
           message s;
        fi;
      else:
           s := "p" & decimal (28 + .5i) & " is valid.";
           message s;
      fi;

   endfor;

   path q[];

   pen big_pen; 
   big_pen := pencircle scaled (.5mm, .5mm, .5mm);

   q0 := p28 -- p24 -- p25 -- p29 -- cycle;
   draw q0; % with_color red with_pen big_pen on_picture W;

   q1 := p30 -- p26 -- p27 -- p31 -- cycle;
   draw q1; % with_color blue with_pen big_pen on_picture W;

   q2 := p28 -- p24 -- p26 -- p30 -- cycle;
   draw q2; % with_color green with_pen big_pen on_picture W;

   q3 := p29 -- p25 -- p27 -- p31 -- cycle;

   q4 := q1 rotated_around (p4, p5) 90;
   rotate_around q4 (p0, p1) 90;

   q5 := q2 rotated_around (p0, p1) 90;
   q5 := q2 rotated_around (p0, p1) 90;
   q6 := q3 rotated_around (p2, p3) 90;

   draw q3; % with_color cyan with_pen big_pen on_picture W;

   p32 := p28 shifted (0, 1);

   numeric curr_mag;

   curr_mag := magnitude (p30 - p28);
   p33 := (curr_mag * unit_vector ((p29 rotated_around (p28, p32) 90) - p28)) shifted by p28;
   
   % message "p28:"; 
   % show p28;

   % message "p33:"; 
   % show p33;

   if do_labels:   
      dotlabel.urt("$p_{29}$", p29) W;
      dotlabel.lft("$p_{33}$", p33) W;

      dotlabel.lft("$p_{30}$", p30) W;
      dotlabel.lft("$p_{28}$", p28) W;

   fi;

   % message "p33:"; 
   % show p33;

   % message "curr_mag:";  
   % show curr_mag;

   % message "magnitude (p33 - p28):";
   % show magnitude (p33 - p28);
   
   p34 := p29 shifted (0, 1);

   curr_mag := magnitude (p31 - p29);
   p35 := (curr_mag * unit_vector ((p28 rotated_around (p29, p34) -90) - p29)) shifted by p29;

   % message "p29:"; 
   % show p29;

   % message "p35:"; 
   % show p35;

   if do_labels:   
      dotlabel.lft("$p_{35}$", p35) W;
   fi;

   % message "p35:"; 
   % show p35;

   % message "curr_mag:";  
   % show curr_mag;

   % message "magnitude (p35 - p29):";
   % show magnitude (p35 - p29);

   q7 := p33 -- p28 -- p29 -- p35 -- cycle;

   p36 := p24 shifted (0, 1);

   curr_mag := magnitude (p26 - p24);
   p37 := (curr_mag * unit_vector ((p25 rotated_around (p24, p36) -90) - p24)) shifted by p24;
   
   %dotlabel.rt("$p_{37}$", p37) W;

   % message "p37:"; 
   % show p37;

   % message "curr_mag:";  
   % show curr_mag;

   % message "magnitude (p37 - p24):";
   % show magnitude (p37 - p24);

   p38 := p25 shifted (0, 1);

   curr_mag := magnitude (p27 - p25);
   p39 := (curr_mag * unit_vector ((p24 rotated_around (p25, p38) 90) - p25)) shifted by p25;
   
   %dotlabel.rt("$p_{39}$", p39) W;

   % message "p39:"; 
   % show p39;

   % message "curr_mag:";  
   % show curr_mag;

   % message "magnitude (p39 - p25):";
   % show magnitude (p39 - p25);

   q8 := p24 -- p37 -- p39 -- p25 -- cycle;  

   % dotlabel.rt("$p_{24}$", p24) W;
   % dotlabel.llft("$p_{25}$", p25) W;
   % dotlabel.rt("$p_{26}$", p26) W;
   % dotlabel.rt("$p_{27}$", p27) W;

   % dotlabel.bot("$p_{28}$", p28) W;
   % dotlabel.urt("$p_{29}$", p29) W;
   % dotlabel.lft("$p_{30}$", p30) W;
   % dotlabel.lft("$p_{31}$", p31) W;

   %% End circles

   %draw c1 on_picture W;
   %draw c3 on_picture W;

%   draw r0 on_picture W;
%   draw r1 on_picture W;

   if do_labels:   
      dotlabel.bot("$p_{0}$", p0) W;
      dotlabel.top("$p_{1}$", p1) W;
      dotlabel.urt("$p_{2}$", p2) W;
      dotlabel.lft("$p_{3}$", p3) W;
      dotlabel.top("$p_{4}$", p4) W;
      dotlabel.top("$p_{5}$", p5) W;
      dotlabel.top("$p_{6}$", p6) W;
      dotlabel.top("$p_{7}$", p7) W;
      dotlabel.top("$p_{8}$", p8) W;
      dotlabel.top("$p_{9}$", p9) W;
      dotlabel.top("$p_{10}$", p10) W;
      dotlabel.top("$p_{11}$", p11) W;
      dotlabel.top("$p_{12}$", p12) W;
      dotlabel.top("$p_{13}$", p13) W;
      dotlabel.top("$p_{14}$", p14) W;
      dotlabel.top("$p_{15}$", p15) W;
      dotlabel.top("$p_{16}$", p16) W;
      dotlabel.top("$p_{17}$", p17) W;
      dotlabel.top("$p_{18}$", p18) W;
      dotlabel.top("$p_{19}$", p19) W;
      dotlabel.top("$p_{20}$", p20) W;
      dotlabel.top("$p_{21}$", p21) W;
      dotlabel.top("$p_{22}$", p22) W;
      dotlabel.top("$p_{23}$", p23) W;
   fi;


%% *** (3)

  t2 := identity rotated (90, 0);

  q4 *= q5 *= q6 *= q7 *= q8 *= t2;

  draw q4 on_picture V; % with_color red; % with_pen big_pen;    %% On plan
  draw q5 on_picture V; % with_color blue; % with_pen big_pen;   %% On plan
  draw q6 on_picture V; % with_color green; %  with_pen big_pen;  %% On plan
  draw q7 on_picture V; % with_color magenta;                                      %% On plan
  draw q8 on_picture V; % with_color cyan;                                      %% On plan

  % message "q7:"; 
  % show q7;

  % message "q8:"; 
  % show q8;

  point s[];

  for i = 0 upto 3:
     s[i] := get_point (i) q4;
     s[i + 4] := get_point (i) q5;
     s[i + 8] := get_point (i) q6;
     s[i + 12] := get_point (i) q7;
     s[i + 16] := get_point (i) q8;
  endfor;

  if do_labels:   
     %dotlabel.top("$s_{0}$", s0) V;
     %dotlabel.top("$s_{1}$", s1) V;
     dotlabel.bot("$s_{2}$", s2) V;
     dotlabel.bot("$s_{3}$", s3) V;

     dotlabel.ulft("$s_{4}$", s4) V;
     dotlabel.urt("$s_{5}$", s5) V;
     dotlabel.rt("$s_{6}$", s6) V;
     dotlabel.lft("$s_{7}$", s7) V;

     dotlabel.ulft("$s_{8}$", s8) V;
     dotlabel.urt("$s_{9}$", s19) V;
     dotlabel.top("$s_{10}$", s10) V;
     dotlabel.top("$s_{11}$", s11) V;

     dotlabel.lft("$s_{12}$", s12) V;
     %dotlabel.top("$s_{13}$", s13) V;
     %dotlabel.top("$s_{14}$", s14) V;  
     dotlabel.lft("$s_{15}$", s15) V;

     %dotlabel.top("$s_{16}$", s16) V;
     dotlabel.rt("$s_{17}$", s17) V;
     dotlabel.rt("$s_{18}$", s18) V;  
     %dotlabel.rt("$s_{19}$", s19) V;
  fi;

  s20 := s3 shifted (0, -.5cm);

  s21 := mediate(s11, s9);


  s22 := mediate(s8, s5);


  s23 := mediate(s4, s6);


  s24 := mediate(s2, s7);


  s25 := mediate(s15, s4);


  s26 := mediate(s9, s17);


  if do_labels:   
     label("$q_4$ ($s_{21}$)", s21) V;
     label("$s_{22}$", s22) V;
     label("$q_{5}$ ($s_{23}$)", s23) V;
     dotlabel.top("$s_{24}$", s24) V;
     label("$q_{7}$ ($s_{25}$)", s25) V;
     label("$q_{8}$ ($s_{26}$)", s26) V;
  fi;

  string temp_str;

  temp_str :=   "\vbox{\hbox{Horizontal side length: $" & decimal h_val_side & "\rm{cm}$}"
              & "\hbox{Vertical side length: $" & decimal v_val_side & "\rm{cm}$}"
              & "\hbox{Height: $" &  decimal hheight & "\rm{cm}$}"
              & "\hbox{Angle $\alpha$ ${" & decimal rot_angle_a & "}^\circ$}"
              & "\hbox{Angle $\beta$: ${" &  decimal rot_angle_b & "}^\circ$}"
              & "\hbox{Angle $\gamma$: ${" &  decimal rot_angle_c & "}^\circ$}"
              & "\hbox{Angle $\delta$: ${" &  decimal rot_angle_d & "}^\circ$}}";


  
  label.lrt(temp_str, s20) LP;


%% *** (3) Tabs

  % message "180 - ((s10 - s9) angle (s9 - s8)):"; 
  % show 180 - ((s10 - s9) angle (s9 - s8));

  numeric h_offset; 
  numeric tab_height;

  path temp_path;
  temp_path := s15 -- s8;  

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};

  temp_path := s15 -- s12;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};


  temp_path := s7 -- s3;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};


  temp_path := s12 -- s4;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};


  temp_path := s11 -- s8;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};


  temp_path := s4 -- s7;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};

  temp_path := s9 -- s18;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, 1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, -1};

  temp_path := s5 -- s17;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, 1};

  temp_path := s10 -- s9;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, -1};

  temp_path := s5 -- s6;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_c, -1};

  temp_path := s17 -- s18;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, 1};

  temp_path := s6 -- s2;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, -1};

  temp_path := s10 -- s11;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, 1};

  temp_path := s3 -- s2;

  tab (temp_path, STP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, -1};
  tab (temp_path, DTP, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_d, 1};




%% *** (3)

enddef; % rect_prism_ma

%% *** (3)

%% ** (2)

%% * (1) End of macro definitions

%% * (1) Emacs-Lisp code for use in indirect buffers when using the          
%%       GNU Emacs editor.  The local variable list is not evaluated when an 
%%       indirect buffer is visited, so it's necessary to evaluate the       
%%       following s-expression in order to use the facilities normally      
%%       accessed via the local variables list.                              
%%       LDF 2004.02.12.

%% (progn (metafont-mode) (outline-minor-mode t) (setq fill-column 80) (ignore '(  
%% )) (setq outline-regexp "%% [*\f]+"))

%% * (1) Local variables for Emacs.

%% Local Variables:
%% mode:Metafont
%% eval:(outline-minor-mode t)
%% eval:(read-abbrev-file abbrev-file-name)
%% outline-regexp:"%% [*\f]+"
%% eval:(set-register ?c "bldelem2.ldf")
%% eval:(set-register ?, "bldelem2.lmc")
%% eval:(set-register ?. "bldelem2.txt")
%% End: