(*  VERSION 0016 *)

(*.......................................................................*)
(*                           HIDELINE                                    *)
(*  Hideline is a three-dimensional graphics program. The program        *)
(* was written by Franklin C Crow and published as 'Three-Dimensional    *)
(* Computer Graphics', BYTE, March/April 1981. The program was adapted   *)
(* to run with a MicroAngelo graphics terminal by Ray Hopkins, 8         *)
(* Chestnut Hill CT., Cinnaminson N.J. (609) 829-4686.                   *)
(* Hl3.src builds the data files used by hl.src,the main display routine *)
(* Hl1.src and Hl2 are support modules. Note that Hl1.src must have      *)
(* recursion turned on. Hl.cmd is the linker command file                *)
(*.......................................................................*)

(*Z*)
{$K1}
{$K2}
{$K6}
{$K7}
{$K12}
{$K13}
{$K14}
{$K15}

PROGRAM HIDELINE;

CONST Dotsacross = 511;
      Dotsdown = 479;
      Maxpts = 200;
      Maxpols = 200;
      Maxvtx = 800;
      Maxsides = 8;

TYPE  Counter = 0..Maxvtx;
      Point = RECORD
                X,Y,Z : REAL
              END;
      Vertex = 0..Maxpts;
      Polygon = RECORD
                  Numvtx : Vertex;
                  START : Counter;
                END;
      Onepoly = ARRAY [1..Maxsides] OF Point;
      Matrix = ARRAY [1..4,1..4] OF REAL;
      CHFILE = FILE OF CHAR;

VAR   Polygons : ARRAY [1..Maxpols] OF Polygon;
      Vertices : ARRAY [1..Maxvtx] OF Vertex;
      Points : ARRAY [1..Maxpts] OF Point;
      Outpolys : ARRAY [1..Maxpols] OF Polygon;
      Outvtces : ARRAY [1..Maxvtx] OF Point;
      Eyespace : Matrix;
      Window : Onepoly;
      Eyept , Cntrint : Point;
      Screenscale, Screenctr : Point;
      ScreenX, SCREENY : REAL;
      Numpols, Numvtces,  Windowsize, I : Counter;
      Numpts : Counter;
      Nptsr : REAL;
      NUMDISPLAY, NumvtxOUT : Counter;
      CMDCHAR : CHAR;
      Filename : STRING;
      DONE : BOOLEAN;



PROCEDURE INITIALIZE;

BEGIN
  DONE := FALSE;
  Numpols := 0;
  Numvtces := 0;
  Numpts := 0;
END;

PROCEDURE MODIFY;

VAR PTSOBJ,POLSOBJ,PTSPOL,I,J: Counter;

BEGIN
   {procedure modify to be built on this space}
END;
PROCEDURE DISPOBJ;

VAR PTSOBJ,POLSOBJ,PTSPOL,I,J: Counter;
    OBJFILE: TEXT;

BEGIN
  PTSOBJ:=Numpts;
  POLSOBJ:=Numpols;
  WRITELN('Points in object =',PTSOBJ,' Polygons in object =',POLSOBJ);
  FOR I:=1 TO PTSOBJ DO
    WITH Points[I] DO
      BEGIN
        WRITELN('Point ',I,X,Y,Z);
      END;
  FOR I:=1 TO POLSOBJ DO
    BEGIN
      PTSPOL:=Polygons[I].Numvtx;
      WRITE('Points in polygon ',I,' ',PTSPOL,' Points  ');
      FOR J:=1 TO PTSPOL DO
        BEGIN
          WRITE(Vertices[J+Polygons[I].Start],' ');
        END;
    WRITELN;
  END;
END;

PROCEDURE WRTOBJECT(Filename:STRING);

VAR PTSOBJ,POLSOBJ,PTSPOL,I,J: Counter;
    Result : INTEGER;
    OBJFILE: TEXT;

BEGIN
  PTSOBJ:=Numpts;
  POLSOBJ:=Numpols;
  ASSIGN(OBJFILE,Filename);
  REWRITE(OBJFILE);
  IF IORESULT = 255 THEN
    BEGIN
      WRITELN('Error in opening ',Filename);
      EXIT;
    END;
  WRITELN(OBJFILE,PTSOBJ,POLSOBJ:5);
  FOR I:=1 TO PTSOBJ DO
    BEGIN
        WITH Points[I] DO
          BEGIN
            WRITELN(OBJFILE,I,' ',X,' ',Y,' ',Z);
          END;
    END;
      FOR I:=1 TO POLSOBJ DO
        BEGIN
          PTSPOL:=Polygons[I].Numvtx;
          WRITE(OBJFILE,PTSPOL:5,' ');
          FOR J:=1 TO PTSPOL DO
            BEGIN
              WRITE(OBJFILE,Vertices[J+Polygons[I].Start]:5);
            END;
        END;
  CLOSE(OBJFILE,Result);
  IF Result = 255 THEN
      WRITELN('Error closing ',Filename)
  ELSE
    BEGIN
      WRITELN(Filename,' closed successfully');
    END;
END;
PROCEDURE ENTER;

VAR PTSOBJ,POLSOBJ,PTSPOL,I,J: Counter;

BEGIN
  WRITELN('Enter object ');
  WRITE('Enter points in object ?');
  READLN(PTSOBJ);
  WRITE('Enter polygons in object ?');
  READLN(POLSOBJ);
FOR I:=1 TO PTSOBJ DO
  BEGIN
  WITH Points[I] DO
      BEGIN
        WRITE('Enter X,Y,Z for point ',I,' ');
        READLN(X,Y,Z);
      END;
  END;
  FOR I:=1 TO POLSOBJ DO
    BEGIN
      WRITE('Enter points in polygon ',I,' ');
      READ(PTSPOL);
      FOR J:=1 TO PTSPOL DO
        BEGIN
          WRITE('Enter point ',J,' for polygon ',I,' ');
          READ(Vertices[J+Numvtces]);
          Vertices[J+Numvtces] := Vertices[J+Numvtces]+Numpts;
        END;
      WITH Polygons[I+Numpols] DO
        BEGIN
          START := Numvtces;
          Numvtx := PTSPOL;
        END;
      Numvtces := Numvtces+PTSPOL;
    END;
  Numpts := Numpts+PTSOBJ;
  Numpols := Numpols+POLSOBJ;
END;

PROCEDURE READOBJECT(Filename:STRING);

VAR PTSOBJ,POLSOBJ,PTSPOL,I,J: Counter;
    XPOS,YPOS,ZPOS: REAL;
    OBJFILE: TEXT;

BEGIN
  WRITE('POSITION FOR ',Filename,' X,Y,Z: ');
  READLN(XPOS,YPOS,ZPOS);
  ASSIGN(OBJFILE,Filename);
  RESET(OBJFILE);
  READLN(OBJFILE,PTSOBJ,POLSOBJ);
  FOR I:=1 TO PTSOBJ DO
    BEGIN
      WITH Points[I+Numpts] DO
        BEGIN
          READLN(OBJFILE,J,X,Y,Z);
          X := X+XPOS;
          Y := Y+YPOS;
          Z := Z+ZPOS;
        END;
    END;
  FOR I:=1 TO POLSOBJ DO
    BEGIN
      READ(OBJFILE,PTSPOL);
      FOR J:=1 TO PTSPOL DO
        BEGIN
          READ(OBJFILE,Vertices[J+Numvtces]);
          Vertices[J+Numvtces] := Vertices[J+Numvtces]+Numpts;
        END;
      WITH Polygons[I+Numpols] DO
        BEGIN
          START := Numvtces;
          Numvtx := PTSPOL;
        END;
      Numvtces := Numvtces+PTSPOL;
    END;
  Numpts := Numpts+PTSOBJ;
  Numpols := Numpols+POLSOBJ;
END;

BEGIN
  INITIALIZE;
  WHILE NOT DONE DO
    BEGIN
      WRITE('R)ead, D)isp, M)odify, E)nter, S)ave, Q)uit ? ');
      READLN(CMDCHAR);
      CASE CMDCHAR OF
        'R','r': BEGIN
                   WRITE('FILE NAME ?');
                   READLN(Filename);
                   READOBJECT(Filename);
                 END;
        'M','m': BEGIN
                   Modify;
                 END;
        'E','e': BEGIN
                   ENTER;
                 END;
        'D','d':DISPOBJ;
        'S','s': BEGIN
                   WRITE('FILE NAME ?');
                   READLN(Filename);
                   WRTOBJECT(Filename);
                 END;
        'Q','q': DONE := TRUE;
      END;
    END;
END.