MODULE Pov;  

(*
   This module contains common procedures used with the POVray tracer.
   Last Modification: 17-05-00 by lozada.

*)

IMPORT Wr, Thread, Fmt, R3, LR3;

<* FATAL Thread.Alerted, Wr.Failure *>

PROCEDURE WritePOVCoord(wr: Wr.T; c: LONGREAL) =
  BEGIN
    Wr.PutText(wr, Fmt.LongReal(c, Fmt.Style.Fix, prec := 4))
  END WritePOVCoord;

PROCEDURE WritePOVPoint(wr: Wr.T; READONLY p: LR3.T) =
  BEGIN
    Wr.PutText(wr, "<");
    WritePOVCoord(wr,p[0]); 
    Wr.PutText(wr, ",");
    WritePOVCoord(wr,p[1]); 
    Wr.PutText(wr, ",");
    WritePOVCoord(wr,p[2]);
    Wr.PutText(wr, ">");
  END WritePOVPoint;

PROCEDURE WritePOVColor(wr: Wr.T; READONLY cr: R3.T) =
  BEGIN
    Wr.PutText(wr, "rgb <");
    Wr.PutText(wr, Fmt.Real(cr[0], Fmt.Style.Fix, 4));
    Wr.PutText(wr, ",");
    Wr.PutText(wr, Fmt.Real(cr[1], Fmt.Style.Fix, 4));
    Wr.PutText(wr, ",");
    Wr.PutText(wr, Fmt.Real(cr[2], Fmt.Style.Fix, 4));
    Wr.PutText(wr, ">");
  END WritePOVColor;

PROCEDURE WritePOVColorTransp(wr: Wr.T; READONLY cr: R3.T; tr: REAL) =
  BEGIN
    Wr.PutText(wr, "rgbf <");
    Wr.PutText(wr, Fmt.Real(cr[0], Fmt.Style.Fix, 4));
    Wr.PutText(wr, ",");
    Wr.PutText(wr, Fmt.Real(cr[1], Fmt.Style.Fix, 4));
    Wr.PutText(wr, ",");
    Wr.PutText(wr, Fmt.Real(cr[2], Fmt.Style.Fix, 4));
    Wr.PutText(wr, ",");
    Wr.PutText(wr, Fmt.Real(tr));
    Wr.PutText(wr, ">");
  END WritePOVColorTransp;

PROCEDURE WritePOVSphere(
  wr: Wr.T;
  READONLY p: LR3.T;
  radius: REAL;
  READONLY cr: R3.T;
  tr: REAL;
  tag1, tag2: TEXT := "";
  ) =		   
  BEGIN
    Wr.PutText(wr, "  sphere {\n");
    Wr.PutText(wr, "    "); WritePOVPoint(wr,p);
    Wr.PutText(wr, ", " & Fmt.Real(radius) & "\n");
    Wr.PutText(wr, "    texture { pigment { color ");
      WritePOVColorTransp(wr,cr,tr);
      Wr.PutText(wr, " } } // " & tag1 & " " & tag2 & " \n");
    Wr.PutText(wr, "  } \n");
    Wr.PutText(wr, "\n");
    Wr.Flush(wr);
  END WritePOVSphere;

PROCEDURE WritePOVCylinder(
  wr: Wr.T;
  READONLY o,d: LR3.T;
  radius: REAL;
  READONLY cr: R3.T;
  tr: REAL;
  tag1, tag2: TEXT := "";
  ) =      
  BEGIN
    Wr.PutText(wr, "  cylinder {\n");
    Wr.PutText(wr, "    "); WritePOVPoint(wr,o); Wr.PutText(wr, ",\n");
    Wr.PutText(wr, "    "); WritePOVPoint(wr,d); Wr.PutText(wr, ",\n");
    Wr.PutText(wr, "    " & Fmt.Real(radius) & "\n");
    Wr.PutText(wr, "    open\n");
    Wr.PutText(wr, "    texture { pigment { color ");
      WritePOVColorTransp(wr, cr, tr);
      Wr.PutText(wr, " } } // " & tag1 & " " & tag2 & " \n");
    Wr.PutText(wr, "  }\n");
    Wr.PutText(wr, "\n");
    Wr.Flush(wr);
  END WritePOVCylinder;

PROCEDURE WritePOVTriangle(
  wr: Wr.T;
  READONLY a,b,c: LR3.T;
  READONLY cr: R3.T;
  tr: REAL;
  tag1, tag2: TEXT := "";
  ) =	     		     
  BEGIN
    Wr.PutText(wr,"  triangle { \n");
    Wr.PutText(wr,"    "); WritePOVPoint(wr,a); Wr.PutText(wr, ",\n");
    Wr.PutText(wr,"    "); WritePOVPoint(wr,b); Wr.PutText(wr, ",\n");
    Wr.PutText(wr,"    "); WritePOVPoint(wr,c); Wr.PutText(wr, "\n");
    Wr.PutText(wr, "    texture { pigment { color ");
    WritePOVColorTransp(wr, cr, tr);
    Wr.PutText(wr, " } finish { ambient 0.3 diffuse 0.7} } // " & tag1 & " " & tag2 & " \n");
    Wr.PutText(wr,"  }\n");
    Wr.PutText(wr,"\n");
    Wr.Flush(wr);
  END WritePOVTriangle;

PROCEDURE WritePOVTriangleTex(
  wr: Wr.T;
  READONLY a,b,c: LR3.T;
  <* UNUSED *> READONLY cr: R3.T;
  <* UNUSED *> tr: REAL;
  ) =	     		     
  BEGIN
    Wr.PutText(wr,"  triangle { \n");
    Wr.PutText(wr,"    "); WritePOVPoint(wr,a); Wr.PutText(wr, ",\n");
    Wr.PutText(wr,"    "); WritePOVPoint(wr,b); Wr.PutText(wr, ",\n");
    Wr.PutText(wr,"    "); WritePOVPoint(wr,c); Wr.PutText(wr, "\n");
    Wr.PutText(wr, "    texture { facetexture } \n");
    Wr.PutText(wr, "  } \n");
    Wr.PutText(wr, "\n");
    Wr.Flush(wr);
  END WritePOVTriangleTex;

PROCEDURE WritePOVSquare(
  wr: Wr.T;
  READONLY a,b,c,d: LR3.T;
  READONLY cr: R3.T;
  tr: REAL;
  ) =
  BEGIN
    Wr.PutText(wr,"  union{\n");
    Wr.PutText(wr,"    "); Wr.PutText(wr,"triangle {");   WritePOVPoint(wr,a); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,b); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,c); 
    Wr.PutText(wr,"}\n");
    Wr.PutText(wr,"    "); Wr.PutText(wr,"triangle {");   WritePOVPoint(wr,c); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,d); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,a); 
    Wr.PutText(wr,"}\n");
    Wr.PutText(wr,"texture {\n"); 
    Wr.PutText(wr,"    pigment { color "); 
    WritePOVColorTransp(wr,cr,tr); 
    Wr.PutText(wr, " } finish { ambient 0.25 diffuse 0.75 } }\n");
    Wr.PutText(wr, "  } \n");
    Wr.PutText(wr, "\n");
  END WritePOVSquare;

PROCEDURE WritePOVTetrahedron(
  wr: Wr.T;
  READONLY u,v,w,x: LR3.T;
  READONLY du,dv,dw,dx: LONGREAL;
  color : R3.T;
  trans : REAL;
  ) =
  BEGIN
   Wr.PutText(wr," intersection{\n");
   Wr.PutText(wr,"   plane{"); WritePOVPoint(wr,u); Wr.PutText(wr,", ");
                               WritePOVCoord(wr,du);
   Wr.PutText(wr,"   }\n");
   Wr.PutText(wr,"   plane{"); WritePOVPoint(wr,v); Wr.PutText(wr,", ");
                               WritePOVCoord(wr,dv);
   Wr.PutText(wr,"   }\n");
   Wr.PutText(wr,"   plane{"); WritePOVPoint(wr,w); Wr.PutText(wr,", ");
                               WritePOVCoord(wr,dw);
   Wr.PutText(wr,"   }\n");
   Wr.PutText(wr,"   plane{"); WritePOVPoint(wr,x); Wr.PutText(wr,", ");
                               WritePOVCoord(wr,dx);
   Wr.PutText(wr,"   }\n");
   Wr.PutText(wr,"   pigment { color rgbt <1.0000,1.0000,1.0000,0.925> }\n");
   Wr.PutText(wr,"   interior{\n");
   Wr.PutText(wr,"     media { emission ");  WritePOVColorTransp(wr,color,trans);
                                              Wr.PutText(wr,"   }\n"); 
   Wr.PutText(wr,"   }\n");
   Wr.PutText(wr,"   hollow\n");
   Wr.PutText(wr," }\n\n");
  END WritePOVTetrahedron;

PROCEDURE WritePOVSmoothTriangle(
  wr: Wr.T;
  READONLY a, an: LR3.T;
  READONLY b, bn: LR3.T;
  READONLY c, cn: LR3.T; 
  READONLY cr: R3.T; 
  tr: REAL
  ) =
  BEGIN
    Wr.PutText(wr, "  smooth_triangle {\n");
    Wr.PutText(wr, "    "); WritePOVPoint(wr,a); Wr.PutText(wr, ", ");
      WritePOVPoint(wr,an); Wr.PutText(wr, ",\n");
    Wr.PutText(wr, "    "); WritePOVPoint(wr,b); Wr.PutText(wr, ", ");
      WritePOVPoint(wr,bn); Wr.PutText(wr, ",\n");
    Wr.PutText(wr, "    "); WritePOVPoint(wr,c); Wr.PutText(wr, ", ");
      WritePOVPoint(wr,cn); Wr.PutText(wr, "\n");
    (*Wr.PutText(wr, "    texture { facetexture } \n");*)  
    Wr.PutText(wr, "    pigment { color "); 
      WritePOVColorTransp(wr,cr, tr); 
      Wr.PutText(wr, " }\n");
    Wr.PutText(wr, "  } \n");
    Wr.PutText(wr, "\n");
    Wr.Flush(wr);
  END WritePOVSmoothTriangle;


PROCEDURE WritePOVPenta(
  wr: Wr.T;
  READONLY a,b,c,d,e: LR3.T;
  READONLY cr: R3.T;
  tr: REAL;
  ) =
  BEGIN
    Wr.PutText(wr,"  union{\n");
    Wr.PutText(wr,"    ");Wr.PutText(wr,"triangle {");    WritePOVPoint(wr,a); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,b); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,c);
    Wr.PutText(wr,"}\n");
    Wr.PutText(wr,"    ");Wr.PutText(wr,"triangle {");    WritePOVPoint(wr,c); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,d); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,a); 
    Wr.PutText(wr,"}\n");
    Wr.PutText(wr,"    ");Wr.PutText(wr,"triangle {");    WritePOVPoint(wr,d); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,e); 
    Wr.PutText(wr,",\n"); Wr.PutText(wr,"              ");WritePOVPoint(wr,a); 
    Wr.PutText(wr,"}\n");
    Wr.PutText(wr,"    pigment { color "); 
    WritePOVColorTransp(wr,cr,tr); 
    Wr.PutText(wr, " }\n");
    Wr.PutText(wr, "  } \n");
    Wr.PutText(wr, "\n");
  END WritePOVPenta;

BEGIN
END Pov.

(**************************************************************************)
(*                                                                        *)
(* Copyright (C) 2000     Universidade Estadual de Campinas (UNICAMP)     *)
(*                                                                        *)
(* Authors:                                                               *)
(*   L. P. Lozada  & J. Stolfi   - UNICAMP <lozada@dcc.unicamp.br>        *)
(*                                                                        *)
(* This file can be freely used, distributed, and modified, provided that *)
(* this copyright and authorship notice is included in every copy or      *)
(* derived version.                                                       *)
(*                                                                        *)
(* DISCLAIMER: This software is offered ``as is'', without any guarantee  *)
(*   as to fitness for any particular purpose.  Neither the copyright     *)
(*   holder nor the authors or their employers can be held responsible    *)
(*   for any damages that may result from its use.                        *)
(*                                                                        *)
(**************************************************************************)