macintosh_cookbook/units/Graf3DScene/Graf3DScene.pas

unit Graf3DScene;
interface

 uses
  FixMath, Graf3D;

 type
  Point3DPtr = ^Point3D;

  Link3D = record
    a: Point3DPtr;
    b: Point3DPtr;
   end;

  Face3D = record
    a: Point3DPtr;
    b: Point3DPtr;
    c: Point3DPtr;
   end;

  Shape3D = record
    origin: Point3D;
    length, verticesLength, facesLength: Integer;
    vertices: array[1..9] of Point3D;
    edges: array[1..13] of Link3D;
    faces: array[1..6] of Face3D;
   end;

  Shape3DPtr = ^Shape3D;

  Scene3D = record
    length: Integer;
    shapes: array[1..20] of Shape3DPtr;
   end;

  Scene3DPtr = ^Scene3D;

 var
  drawingRect: Rect; {A window Size}
  viewWidth, viewHeight, padLeft, padTop: Integer;
  myPort: GrafPort;
  myPort3D: Port3D;
  pa, pb: Point3D;
  hangle, vangle: Longint;
{cursor}
  cursor, prev: Point;
  isDown: Boolean;
  scene: Scene3D;

 procedure InitWindow;
{scene}
 procedure AddShape3D (var scene: scene3D; shape: Shape3DPtr);
 procedure SetScene3D (var scene: Scene3D);
 procedure SetLk3D (var lk3D: Link3D; a, b: Point3DPtr);
 procedure SetFc3D (var fc3D: Face3D; a, b, c: Point3DPtr);
{ transforms }
 procedure MoveShape3D (shape: Shape3DPtr; x, y, z: Fixed);
 procedure ScaleShape3D (shape: Shape3DPtr; x, y, z: LongInt);
 procedure TurnXShape3D (shape: Shape3DPtr);
 procedure TurnYShape3D (shape: Shape3DPtr);
 procedure TurnZShape3D (shape: Shape3DPtr);
{ draw }
 procedure DrawLink3D (link: Link3D);
 procedure DrawShape3D (shape: Shape3DPtr);
 procedure DrawScene3D (scene: Scene3D);

implementation

 procedure AddShape3D (var scene: scene3D; shape: Shape3DPtr);
 begin
  scene.length := scene.length + 1;
  scene.shapes[scene.length] := shape;
 end;

 procedure MoveShape3D (shape: Shape3DPtr; x, y, z: Fixed);
  var
   i: Integer;
 begin
  for i := 1 to shape^.verticesLength do
   SetPt3D(shape^.vertices[i], shape^.vertices[i].x + Long2Fix(x), shape^.vertices[i].y + Long2Fix(y), shape^.vertices[i].z + Long2Fix(z));
 end;

 procedure ScaleShape3D (shape: Shape3DPtr; x, y, z: Fixed);
  var
   i: Integer;
 begin
  for i := 1 to shape^.verticesLength do
   begin
    SetPt3D(shape^.vertices[i], FixMul(shape^.vertices[i].x, Long2Fix(x)), FixMul(shape^.vertices[i].y, Long2Fix(y)), FixMul(shape^.vertices[i].z, Long2Fix(z)));
   end;
 end;

 procedure TurnXShape3D (shape: Shape3DPtr);
  var
   i: Integer;
 begin
  SetPt3D(shape^.origin, shape^.origin.x, shape^.origin.z, shape^.origin.y);
  for i := 1 to shape^.verticesLength do
   SetPt3D(shape^.vertices[i], shape^.vertices[i].x, shape^.vertices[i].z, shape^.vertices[i].y);
 end;

 procedure TurnYShape3D (shape: Shape3DPtr);
  var
   i: Integer;
 begin
  SetPt3D(shape^.origin, shape^.origin.z, shape^.origin.y, shape^.origin.x);
  for i := 1 to shape^.verticesLength do
   SetPt3D(shape^.vertices[i], shape^.vertices[i].z, shape^.vertices[i].y, shape^.vertices[i].x - shape^.origin.x);
 end;

 procedure TurnZShape3D (shape: Shape3DPtr);
  var
   i: Integer;
 begin
  SetPt3D(shape^.origin, shape^.origin.y, shape^.origin.x, shape^.origin.z);
  for i := 1 to shape^.verticesLength do
   SetPt3D(shape^.vertices[i], shape^.vertices[i].y, shape^.vertices[i].x, shape^.vertices[i].z);
 end;

 procedure SetLk3D (var lk3D: Link3D; a, b: Point3DPtr);
 begin
  lk3D.a := a;
  lk3D.b := b;
 end;

 procedure SetFc3D (var fc3D: Face3D; a, b, c: Point3DPtr);
 begin
  fc3D.a := a;
  fc3D.b := b;
  fc3D.c := c;
 end;

 procedure SetScene3D (var scene: Scene3D);
 begin
  scene.length := 0;
 end;

 procedure DrawLink3D (link: Link3D);
 begin
  MoveTo3D(link.a^.x, link.a^.y, link.a^.z);
  LineTo3D(link.b^.x, link.b^.y, link.b^.z);
 end;

 procedure DrawFace3D (face: Face3D);
  var
   tempRgn: RgnHandle;
 begin
  tempRgn := NewRgn;
  OpenRgn;
  MoveTo3D(face.a^.X, face.a^.Y, face.a^.Z);
  LineTo3D(face.b^.X, face.b^.Y, face.b^.Z);
  LineTo3D(face.c^.X, face.c^.Y, face.c^.Z);
  LineTo3D(face.a^.X, face.a^.Y, face.a^.Z);
  CloseRgn(tempRgn);
  FillRgn(tempRgn, ltgray);
  DisposeRgn(tempRgn);
 end;

 procedure DrawShape3D (shape: Shape3DPtr);
  var
   i: Integer;
 begin
  for i := 1 to shape^.facesLength do
   DrawFace3D(shape^.faces[i]);
  for i := 1 to shape^.length do
   DrawLink3D(shape^.edges[i]);
 end;

 procedure DrawWidget (size: Integer);
 begin
  PenPat(black);
  MoveTo3D(Long2Fix(size), 0, 0);
  WriteDraw('x');
  LineTo3D(0, 0, 0);
  LineTo3D(0, Long2Fix(size), 0);
  WriteDraw('y');
  MoveTo3D(0, 0, 0);
  LineTo3D(0, 0, Long2Fix(size));
  WriteDraw('z');
 end;

 procedure DrawScene3D (scene: Scene3D);
  var
   i: Integer;
 begin
  for i := 1 to scene.length do
   DrawShape3D(scene.shapes[i]);
  DrawWidget(50);
 end;

 procedure ClearScreen;
  var
   size: Rect;
 begin
  SetRect(size, 0, 0, viewWidth, viewWidth);
  FillRect(size, white);
 end;

 procedure Redraw;
  var
   i: Integer;
 begin
  ClearScreen;
  LookAt(Long2Fix(-viewWidth), Long2Fix(viewheight), Long2Fix(viewWidth), Long2Fix(-viewHeight));
  ViewAngle(Long2Fix(50));
  Identity;
  Yaw(Long2Fix(hangle));
  Pitch(Long2Fix(vangle)); { roll and pitch the plane }
  DrawScene3D(scene);
 end;

 procedure WhenDownChanged;
  var
   hoff, voff: Integer;
 begin
  hoff := prev.h - cursor.h;
  hangle := hangle + hoff;
  voff := prev.v - cursor.v;
  vangle := vangle + voff;
  Redraw;
  GetMouse(prev);
 end;

 procedure WhenDown;
 begin
  GetMouse(cursor);
  if cursor.h <> prev.h then
   if cursor.v <> prev.v then
    WhenDownChanged;
 end;

 procedure MainLoop;
 begin
  repeat {Until we click outside screen}
   while button do
    begin
     GetMouse(cursor);
     GetMouse(prev);
     repeat {Tight loop until button up}
      WhenDown;
     until not Button;
    end;
  until cursor.h < 0;
 end;

 procedure InitWindow;
 begin
  viewWidth := 500;
  viewHeight := 342;
  padLeft := 60;
  padTop := 60;
  SetRect(drawingRect, padLeft, padTop, padLeft + viewWidth, padTop + viewHeight);
  SetDrawingRect(drawingRect);
  ShowDrawing;
  InitGrf3D(nil);
  Open3DPort(@myPort3D);
  ViewPort(thePort^.portRect);
  Redraw;
  MainLoop;
 end;

end.