MODULE MakeRawCylinder EXPORTS Main;

(*
  Creates a ".top" file for a cylinder whose wall 
  is a triangulated grid of M by N cells, as created by 
  Triang.MakeGrid; and whose top and bottom faces are 
  M-sided sliced pizzas.
  
  The cylinder is centered on the Z axis, with base at Z=0,
  top at Z=2N.  Its radius is M/Pi (giving approximately square cells).
  Cell corners have even Z, cell centers have odd Z.
  The first cell corner has Y=0.


*)

IMPORT LR3, Wr, Thread, ParseParams, Math, Process, Fmt;
IMPORT Oct, Map, Triang, Color;
FROM Triang IMPORT Topology, Coords, Org, OrgV, LeftF, Write, MakeTopology; 
FROM Map IMPORT Arc;
FROM Oct IMPORT Rot, Lnext, Sym, Flip;
FROM Stdio IMPORT stderr;

TYPE
  Options = RECORD
      height: CARDINAL;
      perimeter: CARDINAL;
      fixBorder: BOOLEAN;
    END;

PROCEDURE Main() =
  BEGIN
    WITH
      o = GetOptions(),
      ca = Triang.MakeGrid(o.perimeter, o.height),
      base = Flip(ca[1]),
      g =  Triang.Glue(ca[0], Flip(ca[3]), o.height),
      eTop = Sym(Triang.AddSpokes(ca[6])),
      eBot = Sym(Triang.AddSpokes(ca[2])),
      top = MakeTopology(eTop),
      c = ComputeCoordinates(top, eTop, eBot, base, o.perimeter, o.height)^
    DO
      SetAttributes(top, c, o.perimeter, o.height, o.fixBorder);
      WITH
        tag = ARRAY BOOLEAN OF TEXT{"", "-fix"}[o.fixBorder],
        name = "cylinder-" 
          & Fmt.Int(o.perimeter) & "x" & Fmt.Int(o.height)
          & tag
      DO
        Write(name, top, c)
      END
    END
  END Main;
  
PROCEDURE ComputeCoordinates(
    READONLY top: Triang.Topology;
    eTop, eBot, base: Arc; 
    M, N: CARDINAL;
  ): REF Coords =
  (* 
    Computes vertex coordinates for a cylinder whose wall has 
    "M" cells around and "N" cells along the axis.
    Assumes "eBot" and "eTop" are spokes of the base and top faces, 
    respectively; and "base" is a right-pointing arc along the
    bottom edge of the wall.  Adjusts the coordinates so that the 
    radius is "2*M" and the height is "2*N", with center 
    of base at (0,0,0). 
  *)
  BEGIN
    WITH
      radius = FLOAT(M, LONGREAL)/FLOAT(Math.Pi, LONGREAL),
      dA = FLOAT(Math.Pi, LONGREAL)/FLOAT(M, LONGREAL),
      dZ = 1.0d0,
      r = NEW(REF Coords, top.NV),
      c = r^
    DO
    
      PROCEDURE SetVertexCoords(e: Arc; x, y: CARDINAL) =
        BEGIN
          c[OrgV(e).num] := LR3.T{
            radius * Math.cos(dA*FLOAT(x, LONGREAL)),
            radius * Math.sin(dA*FLOAT(x, LONGREAL)),
            FLOAT(y, LONGREAL)*dZ
          };
        END SetVertexCoords;

      BEGIN
        c[Org(eBot).num] := LR3.T{0.0d0, 0.0d0, 0.0d0};
        c[Org(eTop).num] := LR3.T{0.0d0, 0.0d0, FLOAT(N,LONGREAL)*dZ};
        Triang.EnumGridVertices(base, M, N, SetVertexCoords)
      END;
      RETURN r
    END;
  END ComputeCoordinates;

PROCEDURE SetAttributes(
    READONLY top: Topology; 
    READONLY c: Coords;
    <*UNUSED*> M: CARDINAL; N: CARDINAL; 
    fixBorder: BOOLEAN;
  ) =
  (* Sets the "exists" and "fixed" attributes of edges, faces, and
    vertices. Assumes that the base has Z=0 and the top has Z=2*N. *)
  BEGIN
    WITH 
      zTop = 2*N
    DO
      (* Set vertex properties: *)
      FOR i := 0 TO top.NV - 1 DO
        WITH 
          v = top.vertex[i],
          vc = c[v.num],
          iz = ROUND(vc[2]),
          distBorder = MIN(iz, zTop - iz),
          exists = NOT (vc[0] = 0.0d0 AND vc[1] = 0.0d0),
          fixed = distBorder = 0 OR (fixBorder AND distBorder <= 2)
        DO
          v.exists := exists;
          v.fixed := fixed;
          IF exists THEN
            v.radius := 0.02;
            v.color := Color.T{0.60, 0.80, 1.00};
          END;
        END
      END;
      
      (* Set face properties *)
      FOR i := 0 TO top.NF-1 DO
        WITH f = top.face[i], s = Rot(top.side[i]) DO 
          VAR 
            exists: BOOLEAN := TRUE;
            p: Triang.Arc := s;
          BEGIN
            REPEAT
              exists := exists AND OrgV(p).exists;
              p := Lnext(p)
            UNTIL p = s;
            f.exists := exists;
            IF exists THEN 
              f.patch := 1;
              f.color := Color.T{1.00, 0.95, 0.70};
              f.transp := Color.T{0.80, 0.80, 0.80};
            END;
          END
        END;
      END;
      
      (* Set edge properties *)
      FOR i := 0 TO top.NE-1 DO 
        WITH a = top.edge[i], e = NARROW(a.edge, Triang.Edge) DO 
          e.exists := OrgV(a).exists AND OrgV(Sym(a)).exists;
          e.spring := LeftF(a).exists AND LeftF(Sym(a)).exists;
          e.color := Color.T{0.00, 0.10, 0.70};
          e.radius := 0.01;
        END
      END
    END
  END SetAttributes;

PROCEDURE GetOptions (): Options =
  <* FATAL Thread.Alerted, Wr.Failure *>
  VAR o: Options;
  BEGIN
    WITH pp = NEW(ParseParams.T).init(stderr) DO
      TRY
        pp.getKeyword("-perimeter");                               
        o.perimeter := pp.getNextInt(3, 100); 

        pp.getKeyword("-height");                               
        o.height := pp.getNextInt(1, 100); 

        o.fixBorder := pp.keywordPresent("-fixBorder"); 

        pp.finish();                                       
      EXCEPT                                                            
      | ParseParams.Error =>                                              
          Wr.PutText(stderr, "Usage: MakeRawCylinder\\\n");
          Wr.PutText(stderr, "  -gridOrder <num>\\\n");
          Wr.PutText(stderr, "  [ -fixBorder ]\n");        
          Process.Exit (1);                                              
      END
    END;
    RETURN o
  END GetOptions;

BEGIN 
  Main();
END MakeRawCylinder.