PROGRAM _3D;
USES Intuition,Graphics;

{ geschrieben von:         Michael Janich 1989             }
{ bearbeitet von:          Jens "Himpelsoft" Gelhar        }
{ ALL RIGHTS REVERSED.                                     }

{ MaxonPascal3-Anpassung:  Falk Zühlsdorff (PackMAN) 1994  }

{ Programm wird mit ESC beendet.                           }
{ Mit den Cursortasten kann man die Rotationsrichtung des  }
{ Objekts ändern, mit einigen Tasten des Ziffernblocks     }
{ den Standpunkt des Betrachters.                          }
{ In der vorliegenden Version gibt es noch Fehler, wenn    }
{ Linien den Bildschirmrand überschreiten.                 }

CONST width=640;
      height=256; { Screen }

      file_name = 'MPascal3:Demo/3D_coords/coords.haus';
      { Aus dieser Datei werden die Koordinaten gelesen }

      rot_angle=0.12; { rotation in one step }

TYPE Point = REAL;
     Ptr2Point_3d = ^Point_3d;
     Point_3d = RECORD x, y, z: Point;
                END; { Rec Point_3d }
     Ptr2Point_2d = ^Point_2d;
     Point_2d = RECORD x, y: Point;
                END; { Rec Point_2d }
     Ptr2Coords = ^Coords;
     Coords = RECORD c: Point_3d;
         next: Ptr2Coords;
     END;

VAR  fin,helpscreen : BOOLEAN;
     FP             : Point_3d;
     chain          : Ptr2Coords;
     W1,W2          :^Window;
     Rast1          :^RastPort;
     MyScreen1      : ^Screen;
     Rast2          :^RastPort;
     Rast           : ^RastPort;
     MyScreen2      : ^Screen;
     t1             : IntuiText;
     sin_rot_angle,
     cos_rot_angle  : REAL;
     act_pos        : STRING[99];
     Pointer        : ^Byte; { Requiered for key-codes }
     LastKey        : Byte;
     i              : INTEGER;
     pro_Res,last   : Point_2d; { Result of projetion-function }
     rot_res        : Point_3d; { Result of rotation-func }
     rot,scr_no     : INTEGER;

(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* Open Screen                                                          *)
(************************************************************************)

PROCEDURE Init;
VAR i: INTEGER;

   BEGIN { Init }
      fin := FALSE;
      Pointer := Ptr($bfec01);
      LastKey := 0;
      MyScreen1:=Open_Screen(0, 0, width, height, 1, 0, 1, HIRES or GENLOCK_VIDEO,'3d-Haus');
      MyScreen2:=Open_Screen(0, 0, width, height, 1, 0, 1, HIRES or GENLOCK_VIDEO,'3d-Haus');
      W1:=Open_Window(0,0,width,height,1,0,$0800,Nil,MyScreen1,width,height,width,height);
      W2:=Open_Window(0,0,width,height,1,0,$0800,Nil,MyScreen2,width,height,width,height);
      Rast1:=W1^.RPort;
      Rast2:=W2^.RPort;
      Rast := Rast1;
      SetRGB4(^MyScreen1^.ViewPort,0,1,1,1); { almost black }
      SetRGB4(^MyScreen2^.ViewPort,0,1,1,1);
      SetRGB4(^MyScreen1^.ViewPort,1,14,14,14); { almost withe }
      SetRGB4(^MyScreen2^.ViewPort,1,14,14,14);
      FP.x := -40; { Point of eye }
      FP.y := -40;
      FP.z := -40;
      sin_rot_angle := sin(rot_angle);
      cos_rot_angle := cos(rot_angle);
      last.x := width div 2; { else undefinded }
      last.y := height div 2;
      scr_no := 1; { screen_number toggles between 1 and 2 }
      rot := 2;    { rotation axis 1,2,3 }
   END; { Proc Init }

(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* 3d-Point; call by reference                                          *)
(************************************************************************)
(* Output:                                                              *)
(*                                                                      *)
(* 3d-Point                                                             *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* rotate point by the rot_angle                                        *)
(************************************************************************)

PROCEDURE Rotate_alfa (VAR a: Point_3d); { We change the original point }
BEGIN
   a.y := a.y * cos_rot_angle - a.z * sin_rot_angle;
   a.z := a.y * sin_rot_angle + a.z * cos_rot_angle;
END; { Proc Rotate_alfa }

PROCEDURE Rotate_beta (VAR a: Point_3d); { We change the original point }
BEGIN
   a.x := a.x * cos_rot_angle + a.z * sin_rot_angle;
   a.z := a.z * cos_rot_angle - a.x * sin_rot_angle ;
END; { Proc Rotate_beta }

PROCEDURE Rotate_gamma (VAR a: Point_3d); { We change the original point }
BEGIN
   a.x := a.x * cos_rot_angle - a.y * sin_rot_angle;
   a.y := a.x * sin_rot_angle + a.y * cos_rot_angle;
END; { Proc Rotate_gamma }

{ please verify the +- in r_gamma }

(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* 3d-Point                                                             *)
(************************************************************************)
(* Output:                                                              *)
(*                                                                      *)
(* 2d-Point                                                             *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* Convert py central-perspectiv                                        *)
(************************************************************************)

PROCEDURE Projection (a: Point_3d); { result in global Pro_res }
VAR t: Point;

   BEGIN { Func Projection }
      {$if def debug}
         WriteLn("Projection: Eingabe: (",a.x,",",a.y,",",a.z,").");
      {$endif debug}
      IF abs(a.y - FP.y) <1e-3
         THEN t := 0
         ELSE t := a.y / (2*(a.y - FP.y));
      pro_res.x := 2*(a.x - t*(a.x - FP.x))+width/2;
      pro_res.y :=   (a.z - t*(a.z - FP.z))+height/2;
      {$if def debug}
         WriteLn("----------- Ausgabe: (",pro_res.x,",",pro_res.y,").");
      {$endif debug}
 END; { Func Projection }

(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* 2d-Points                                                            *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* Check Point for screen-dimens. cut, if neccessary                    *)
(************************************************************************)

PROCEDURE Check (VAR a: Point_2d);
VAR temp: Point_2d;

BEGIN
   temp := a;
   IF a.x < 0 THEN { right of screen }
      IF (last.x-a.x)=0 THEN a.x := -1 ELSE BEGIN { check for division by 0 }
         a.y := last.y - (last.y-a.y)*last.x/(last.x-a.x); a.x := 0;
      END;
   IF a.y >= height THEN
      IF (last.y-a.y)=0 THEN a.x := -1 ELSE BEGIN
         a.x := a.x - (a.x-last.x)*(last.y-height)/(a.y-last.y); a.y := height-1;
      END;
   IF a.x >= width THEN BEGIN
      {$if def debug}
         WriteLn("a.x ist zu gross: ",a.x," >= ",width);
      {$endif}
      IF (a.x-last.x)=0 THEN a.x := -1 ELSE BEGIN
         a.y := last.y - (last.y-a.y)*(last.x-width)/(a.x-last.x); { an dieser Stelle gabs immer den /0-error }
         a.x := width-1;
      END;
   END;
   IF a.y < 0 THEN
      IF (last.y-a.y)=0 THEN a.x := -1 ELSE BEGIN
         a.x := a.x - (a.x-last.x)*last.y/(last.y-a.y); a.y :=  0;
      END; { letztes ist noch zu überprüfen }
   {$if def debug}
      IF(a.x <> temp.x) OR (a.y <> temp.y) THEN
         WriteLn("Changes in Check-Procedure.");
   {$endif debug}
   last := temp;

END; { Proc Check }
(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* Two 2d-Points (from-Coord, to-Coord)                                 *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* Draw Line on Screen                                                  *)
(************************************************************************)

PROCEDURE Draw_line(a: Point_2d);
   BEGIN
      Check (a);
      {$if def debug}
          WriteLn("Linie nach (",a.x,",",a.y,").");
      {$endif}
      IF a.x <> -1 THEN Draw (Rast, round(a.x), round(a.y));
   END; { Proc Draw }

(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* 2d-Point (to-Coord)                                                  *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* Move Grafik-Cursor                                                   *)
(************************************************************************)

PROCEDURE Move_Line(a: Point_2d);
   BEGIN
      Check (a);
        {$if def debug}
           WriteLn("Bewegen nach (",a.x,",",a.y,").");
        {$endif}
      IF a.x <> -1 THEN Move(Rast, round(a.x), round(a.y));
   END; { Proc Move_line }

(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* Keyboard                                                             *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* change point of eye                                                  *)
(************************************************************************)

PROCEDURE Read_Change;
   BEGIN
     LastKey := Pointer^;
     CASE LastKey OF
       133: FP.x := FP.x + 1;
       197: FP.x := FP.x - 1;
       131: FP.y := FP.y + 1;
       195: FP.y := FP.y - 1;
       129: FP.z := FP.z + 1;
       193: FP.z := FP.z - 1;
       103: rot := 1;
       101: rot := 1;
       097: rot := 2;
       099: rot := 2;
       139: rot := 3;
       201: rot := 3;
       127, 117, 119: fin := TRUE;
       Otherwise
     END; { CASE }

     CASE scr_no OF
      1: BEGIN Rast:=Rast2; ScreenToFront(MyScreen1) END;
      2: BEGIN Rast:=Rast1; ScreenToFront(MyScreen2) END
     END;

     scr_no := 3-scr_no;
     SetAPen(Rast,0);
     RectFill(Rast,0,0,Width-1,Height-1);
     SetAPen(Rast,1);
   END; { Proc Read_Changes }

(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* Chain of 3d-points                                                   *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* Calculate and Draw 3d-points                                         *)
(************************************************************************)

PROCEDURE Calc_Draw (root: Ptr2Coords);

   BEGIN
      WHILE root <> NIL DO
      BEGIN
        IF root^.c.x = -1 THEN
           BEGIN
              root := root^.next;
              CASE rot OF
                 1: Rotate_alfa (root^.c);
                 2: Rotate_beta (root^.c);
                 3: Rotate_gamma(root^.c);
              ELSE; END; { case }
              Projection (root^.c);
              Move_Line(pro_res);
           END
           ELSE BEGIN
              CASE rot OF
                 1: Rotate_alfa (root^.c);
                 2: Rotate_beta (root^.c);
                 3: Rotate_gamma(root^.c);
              ELSE; END; { case }
              Projection(root^.c);
              Draw_Line(pro_res);
           END;
        root := root^.next;
     END; { WHILE }
   END; { Proc Calc_Draw }

(************************************************************************)
(* Input:                                                               *)
(*                                                                      *)
(* File of coords of object                                             *)
(************************************************************************)
(* Output:                                                              *)
(*                                                                      *)
(* Root of chain                                                        *)
(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* read  file  from extern device                                       *)
(************************************************************************)

FUNCTION Read_Coords: Ptr2Coords;
VAR  f: FILE OF CHAR;
     old_coord, result, temp: Ptr2Coords;

   BEGIN
      New (result);
      WITH result^.c DO
      BEGIN
         x := -1;
         y := 0;
         z := 0;
      END; { WITH }
      old_coord := result;
      Reset (f, file_Name);
      IF EoF(f) THEN Error ("File not Found.");
      WHILE NOT EoF(f) DO
      BEGIN
         New (temp);
         WITH temp^.c DO
         BEGIN
            ReadLn (f, x, y, z);
            {$if def debug}
               WriteLn("Gelesene Coordinaten: (",x,",",y,",",z,").");
            {$endif}
         END; { WITH }
         old_coord^.next := temp;
         old_coord := temp;
      END; { WHILE }
      temp^.next := NIL; { End of chain }
      Read_Coords := result;
   END; { Func Read_Coords }


(************************************************************************)
(* Function:                                                            *)
(*                                                                      *)
(* Close libraries and screen                                           *)
(************************************************************************)


PROCEDURE Close_(list:Ptr2Coords);
VAR temp: Ptr2Coords;
   BEGIN
      WHILE (list <> NIL) DO
      BEGIN
         temp := list^.next;
         dispose (list);
         list := temp;
      END; { WHILE }
      helpscreen:=CloseScreen(MyScreen1);
      helpscreen:=CloseScreen(MyScreen2);
      CloseLib(intuitionbase);
      CloseLib(GfxBase);
   END;

BEGIN { Main }
   Init;
   chain := Read_Coords;
   REPEAT
      Calc_Draw (chain);
      Read_Change;
      act_pos := '('+RealStr(FP.x,0)+','+RealStr(FP.y,0)+','+RealStr(Fp.z,0)+')';
      t1:=IntuiText(1,0,1,0,0,Nil,act_pos,Nil);
      PrintIText (Rast1, ^t1, 10,190);
      PrintIText (Rast2, ^t1, 10,190);
   UNTIL fin;
   Close_(chain);
END.