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

%%%% $Id: bldelem3.lmc,v 1.4 2013/06/05 16:44:47 lfinsto1 Exp $

%% * (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 26, 2012
%% Last Updated:   July 4, 2012

input "bldelem1.lmc";

%% * (1) Macros

%% ** (2) 

macro pyramid;

def pyramid (U, V, W, ttext_picture, ddbl_tab_picture, 
             ddiameter_two, T, rr) {numeric ssides, 
                                    numeric ddiameter, 
                                    numeric hheight_a, 
                                    numeric hheight_b, 
                                    numeric hheight_c, 
                                    numeric ccross_a,
                                    numeric ccross_b,
                                    boolean do_guidelines, 
                                    boolean do_labels} =

 
 
   string s;
 
   reg_polygon r[];

   point p[];
   p0 := (0, hheight_a);

   pen normal_pen;

   normal_pen := pencircle scaled (.5mm, .5mm, .5mm);

   set r0 with_sides ssides with_diameter ddiameter;

   draw r0 on_picture U with_pen normal_pen;

   % message "size r0:"; 
   % show size r0;

   for i = 1 upto ssides:
      p[i] := get_point (i - 1) r0;
      draw p[i] -- p0 on_picture U with_pen normal_pen;
   endfor;


   point S[];

   S0 := mediate(p1, p2);

   numeric curr_mag;

   curr_mag := magnitude (p0 - S0);

   % message "curr_mag:"; 
   % show curr_mag;

   S1 := S0 shifted (0, 1);

   S2 := p1 rotated_around (S0, S1) 90;

   S3 :=  (curr_mag * unit_vector (S2 - S0)) shifted by S0;

   triangle t[];

   set t0 with_points (p1, S3, p2);

   numeric rot_val;

   rot_val := 360 / ssides;

   if do_labels:
      dotlabel.top("$p_0$", p0) U;
      dotlabel.bot("$p_1$", p1) U;
      dotlabel.bot("$p_2$", p2) U;
      dotlabel.bot("$p_3$", p3) U;
      dotlabel.bot("$p_4$", p4) U;
      dotlabel.bot("$p_5$", p5) U;
      dotlabel.bot("$s_0$", S0) U;
      dotlabel.bot("$s_2$", S2) U;
      dotlabel.bot("$s_3$", S3) U;

  fi;

%% **** (4) 



%% **** (4) 

  rotate t[0] (90, 0);



  path temp_path;
  path save_path;

  numeric h_offset;
  numeric tab_height;

  numeric temp_mag;

  path Q[];
 
  if (hheight_b <= 0) or (hheight_b >= hheight_a):
     message "hheight_b <= 0 or hheight_b >= hheight_a.  Not truncating pyramid."; 

     draw t0 rotated (-90, 0) on_picture U with_pen normal_pen;
     draw t0 on_picture V with_pen normal_pen;
     draw t0 on_picture W with_pen normal_pen;

     temp_path := get_point 0 t0 -- get_point 1 t0;
     tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
     tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};

     temp_mag := magnitude (get_point 0 t0 - get_point 1 t0);

     temp_path := origin -- (temp_mag, 0);


     save_path := temp_path;

     for i = 1 upto ssides:
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
        shift temp_path ((temp_mag - h_offset + .5cm), 0);
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
        shift temp_path ((temp_mag - h_offset + .5cm), 0);
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
        shift save_path (0, -(2tab_height + .25cm));
        temp_path := save_path;
     endfor;

     temp_path := get_point 2 t0 -- get_point 1 t0;
     tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
     tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};

     if do_labels:
        for i = 0 upto 2:
           s := "$0_" & decimal (i) & "$";
           dotlabel.top(s, get_point (i) t0) V;
        endfor;
     fi;

     for i = 1 upto ssides - 1:
        t[i] := t0 rotated (0, 0, i * rot_val);
        draw t[i] rotated (-90, 0) on_picture U with_pen normal_pen;
        draw t[i] on_picture V with_pen normal_pen;
        draw t[i] on_picture W with_pen normal_pen;

        temp_path := get_point 0 t[i] -- get_point 1 t[i];
        tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};


        temp_path := get_point 2 t[i] -- get_point 1 t[i];
        tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};

     endfor;


     if (is_triangle T):
         T := t0;
     fi;

  else:
     message "hheight_b > 0 and hheight_b < hheight_a.  Truncating pyramid."; 

     S4 := (0, hheight_b);

     % message "S4:"; 
     % show S4;

     curr_mag := magnitude (S4 - S0);

     % message "curr_mag:"; 
     % show curr_mag;

     S5 :=  (curr_mag * unit_vector (S2 - S0)) shifted by S0;




     rotate S5 (90, 0);



     rotate S0 (90, 0);

     S6 := S5 shifted (0, 0, 1);
     S7 := S0 rotated_around (S5, S6) 90;

     S8 := (get_point 0 t0 -- get_point 1 t0) intersection_point (S5 -- S7);
 
     S9 := (get_point 1 t0 -- get_point 2 t0) intersection_point (S5 -- S7);

     S10 := get_point 0 t0;

     S11 := get_point 2 t0;

     temp_path := S10 -- S8;
     tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
     tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};

     temp_path := S9 -- S11;
     tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
     tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};


     drawdot S10 with_pen pencircle scaled (1mm, 1mm, 1mm) on_picture V;


     Q0 := get_point 0 t0 -- S8 -- S9 -- get_point 2 t0 -- cycle;

     % draw t0 on_picture V with_pen normal_pen with_color blue;
     % draw t0 on_picture W with_pen normal_pen with_color blue;

     draw Q0 rotated (-90, 0) on_picture U;
     draw Q0 on_picture V;
     draw Q0 on_picture W;

     curr_mag := magnitude (S8 - S9) / magnitude (get_point 0 t0 - get_point 2 t0);

     r1 := r0 scaled (curr_mag, 0, curr_mag) rotated (90, 0, 180);

     shift r1 by (S8 - get_point 1 r1);

     ddiameter_two := 2 * magnitude (get_center r1 - get_point 1 r1);

     if do_labels:
     	dotlabel.top("$S_5$", S5) U;
     	dotlabel.top("$S_5$", S5) V;
     	dotlabel.top("$S_0$", S0) V;
     	dotlabel.top("$S_7$", S7) V;
     	dotlabel.rt("$S_8$", S8) V;
     	dotlabel.llft("$S_9$", S9) V;
     	label("$S_{10}$", S10 shifted (0, .333cm)) V;
     	dotlabel.ulft("$S_{11}$", S11) V;
     fi;

   
     if false: % do_labels
        for i = 0 upto ssides - 1:
           s := "$" & decimal (i) & "$";
           dotlabel.top(s, get_point (i) r1) V;
        endfor;
     fi;

     if (is_reg_polygon rr):
        rr := r1;
     fi;
    
     if hheight_c <= 0:
        draw r1 rotated (-90, 0) on_picture U;
        draw r1 on_picture V;
        draw r1 on_picture W;
     % else:
     %    draw r1 rotated (-90, 0) with_color dark_gray dashed evenly on_picture U;
     %    draw r1  with_color dark_gray dashed evenly on_picture V;
     fi;

     S12 := get_center r1;
     S13 := S12 shifted (0, 0, 1);


     for i = 1 upto ssides - 1:
        t[i] := t0 rotated (0, 0, i * rot_val);
        Q[i] := Q0 rotated (0, 0, i * rot_val);

        % draw t[i] rotated (-90, 0) on_picture U with_pen normal_pen with_color blue;
        % draw t[i] on_picture V with_pen normal_pen with_color blue;
        % draw t[i] on_picture W with_pen normal_pen with_color blue;

        draw Q[i] rotated (-90, 0) on_picture U with_pen normal_pen;
        draw Q[i] on_picture V with_pen normal_pen;
        draw Q[i] on_picture W with_pen normal_pen;

        if hheight_c <= 0:
           temp_path := (S8 -- S9) rotated_around (S12, S13) (i * rot_val);
           tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};
           tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, -1};

           temp_path := (S8 -- S9) rotated (0, 0, i * rot_val);
           tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};
           tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};
        fi;

        temp_path := (S10 -- S8) rotated (0, 0, i * rot_val);
        tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};

        temp_path := (S9 -- S11) rotated (0, 0, i * rot_val);
        tab (temp_path, V, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
        tab (temp_path, W, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};

     endfor;

     temp_mag := magnitude (S8 - S10);

     temp_path := origin -- (temp_mag, 0);

     save_path := temp_path;

     label("$A$", origin) ddbl_tab_picture;
     label.urt("$A$", mediate(S8, S10)) W;

     for i = 1 upto ssides:
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
        shift temp_path ((temp_mag - h_offset + .5cm), 0);
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
        shift temp_path ((temp_mag - h_offset + .5cm), 0);
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, 1};
        tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_a, -1};
        shift save_path (0, -(2tab_height + .25cm));
        temp_path := save_path;
     endfor;

     if hheight_c <= 0:

     	 temp_mag := magnitude (S8 - S9);

         temp_val := -ssides;
         temp_val *= (2tab_height + .25cm);
         temp_val -= .25cm;

     	 temp_path := (0, temp_val) -- (temp_mag, temp_val);
     	 save_path := temp_path;

     	 label.lft("$B$", (0, temp_val)) ddbl_tab_picture;
     	 label.urt("$B$", mediate(get_point 1 r1, get_point 2 r1)) W;

     	 for i = 1 upto ssides:
     	    tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};
     	    tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, -1};
     	    shift temp_path ((temp_mag - h_offset + .5cm), 0);
     	    tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};
     	    tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, -1};
     	    shift temp_path ((temp_mag - h_offset + .5cm), 0);
     	    tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, 1};
     	    tab (temp_path, ddbl_tab_picture, h_offset, tab_height) {0, 1, .875, .75, .2, ccross_b, -1};
     	    shift save_path (0, -(2tab_height + .25cm));
     	    temp_path := save_path;
     	 endfor;

     fi;  %% if hheight_c <= 0:


  fi;  %% Truncating pyramid

%% **** (4)

  s :=   "\vbox{\halign{#:\quad\hfil&\hfil#\cr "
       & "Sides&" & decimal ssides & "\cr "
       & "Base diameter&$" & decimal ddiameter & "\rm{cm}$\cr ";

  if (hheight_b <= 0) or (hheight_b >= hheight_a):
     s := s & "Height&$" & decimal hheight_a & "\rm{cm}$";
  elseif hheight_c <= 0:
     s := s & "Height of non-truncated pyramid&$" & decimal hheight_a & "\rm{cm}$\cr "
            & "Height of truncated pyramid&$" & decimal hheight_b & "\rm{cm}$\cr "
            & "Diameter of upper polygon&$" & decimal ddiameter_two & "\rm{cm}$";
  else:
     s := s & "Height of lower section&$" & decimal hheight_b & "\rm{cm}$\cr "
            & "Height of upper section&$" & decimal hheight_c & "\rm{cm}$\cr "
            & "Diameter of upper polygon&$" & decimal ddiameter_two & "\rm{cm}$";
  fi;

  s := s & "\cr}}";

  if is_picture ttext_picture:
     label(s, origin) ttext_picture;
  fi;


enddef;

%% *** (3)

macro obelisk;

def obelisk (UU, VV, WW, TT, DD) {numeric SSIDES, numeric DDIAM, 
                                  numeric HHEIGHT_A, numeric HHEIGHT_B, numeric HHEIGHT_C,
                                  numeric CCROSS_A, numeric CCROSS_B, 
                                  boolean DDO_GUIDELINES, boolean DDO_LABELS} = 

   picture u, v, w, text_picture, uu, vv, ww, tttext_picture, dddbl_tab_picture;
   numeric diameter_two;
   triangle t;
   reg_polygon R;

   pyramid (u, v, w, text_picture, dddbl_tab_picture, 
            diameter_two, ZERO, R) {SSIDES, DDIAM, HHEIGHT_A, HHEIGHT_B, HHEIGHT_C, 
                                    CCROSS_A, CCROSS_B, 
                                    DDO_GUIDELINES, DDO_LABELS};

   if is_picture TT:
     TT := text_picture;
   fi;

   if is_picture DD:
     DD := dddbl_tab_picture;
   fi;

   pyramid (uu, vv, ww, ttttext_picture, dddbl_tab_picture, 
            ZERO, t, ZERO) {SSIDES, diameter_two, HHEIGHT_C, 0, 0, 
                            CCROSS_B, 0, DDO_GUIDELINES, 
                            DDO_LABELS};
   UU += u;
   VV += v;
   WW += w;

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

   rotate vv (0, 0, 180);
   rotate ww (0, 0, 180);
   rotate t (0, 0, 180);

   %%current_picture += vv;

   shift t by (get_point 1 R - get_point 2 t);

   rotate_around t (get_point 0 R, get_point 1 R) 180;

   draw t rotated (-90, 0) on_picture UU;
   draw t on_picture VV;
   draw t on_picture WW;

   label.urt("$B$", mediate(get_point 1 t, get_point 2 t)) WW;

   path temp_path;

   numeric h_offset, tab_height;

   tab (t, VV, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B, 1};
   tab (t, VV, h_offset, tab_height) {1, 2, .875, .75, .2, CCROSS_B, -1};

   tab (t, WW, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B, -1};
   tab (t, WW, h_offset, tab_height) {1, 2, .875, .75, .2, CCROSS_B, -1};

   numeric temp_val;

   temp_val := size R;
   temp_val := 1 / temp_val;
   temp_val *= 360;

   for i = 0 upto size R - 2:
     rotate t (0, 0, temp_val);
     draw t rotated (-90, 0) on_picture UU;
     draw t on_picture VV;
     draw t on_picture WW;

     tab (t, VV, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B, 1};
     tab (t, VV, h_offset, tab_height) {1, 2, .875, .75, .2, CCROSS_B, -1};

     tab (t, WW, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B, -1};
     tab (t, WW, h_offset, tab_height) {1, 2, .875, .75, .2, CCROSS_B, -1};

   endfor;


   temp_val := -SSIDES;
   temp_val *= (2tab_height + .25cm);
   temp_val -= .25cm;

   numeric temp_mag;
   temp_mag := magnitude (get_point 1 t - get_point 2 t);

   path save_path;

   temp_path := (0, temp_val) -- (temp_mag, temp_val);
   save_path := temp_path;

   label.lft("$B$", (0, temp_val)) DD;

   for i = 1 upto SSIDES:
      tab (temp_path, DD, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B,  1};
      tab (temp_path, DD, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B, -1};
      shift temp_path ((temp_mag - h_offset + .5cm), 0);
      tab (temp_path, DD, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B,  1};
      tab (temp_path, DD, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B, -1};
      shift temp_path ((temp_mag - h_offset + .5cm), 0);
      tab (temp_path, DD, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B,  1};
      tab (temp_path, DD, h_offset, tab_height) {0, 1, .875, .75, .2, CCROSS_B, -1};
      shift save_path (0, -(2tab_height + .25cm));
      temp_path := save_path;
   endfor;

   %draw R with_color green with_pen big_pen;    



enddef;


%% *** (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 "bldelem3.ldf")
%% eval:(set-register ?, "bldelem3.lmc")
%% eval:(set-register ?. "bldelem3.txt")
%% End: