macintosh_cookbook/units/Graf3DScene/Graf3DScene.pas

unit Graf3DScene;
interface

 uses
  FixMath, Graf3D;

 const
  LIMIT_VERTICES = 32;
  LIMIT_EDGES = 40;
  LIMIT_FACES = 8;

 type
  Point3DPtr = ^Point3D;

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

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

  Shape3D = record
    origin: Point3D;
    verticesLength:Integer;
    edgesLength:Integer;
    facesLength: Integer;
    vertices: array[1..LIMIT_VERTICES] of Point3D;
    edges: array[1..LIMIT_EDGES] of Edge3D;
    faces: array[1..LIMIT_FACES] 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 SetScene3D (var scene: Scene3D);
 procedure SetEdge3D (var edge: Edge3D; a, b: Point3DPtr);
 procedure SetFace3D (var face: Face3D; a, b, c: Point3DPtr);
{ basics }
 procedure AddVertice3D (var shape: Shape3D; x, y, z: Fixed);
 procedure AddEdge3D (var shape: Shape3D; a, b: Integer);
 procedure AddFace3D (var shape: Shape3D; a, b, c: Integer);
{ transforms }
 procedure AddShape3D (var scene: scene3D; shape: Shape3DPtr);
 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 DrawEdge3D (edge: Edge3D);
 procedure DrawShape3D (shape: Shape3DPtr);
 procedure DrawScene3D (scene: Scene3D);

implementation

 procedure SceneError (text: string);
 begin
  ShowText;
  Writeln(text);
  Halt;
 end;

 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^.origin.y, shape^.vertices[i].y + shape^.origin.y);
 end;

 procedure TurnYShape3D (shape: Shape3DPtr);
  var
   i: Integer;
 begin
  for i := 1 to shape^.verticesLength do
   SetPt3D(shape^.vertices[i], shape^.origin.z - shape^.vertices[i].z + shape^.origin.x, shape^.vertices[i].y, shape^.vertices[i].x - shape^.origin.x + shape^.origin.z);
 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 SetEdge3D (var edge: Edge3D; a, b: Point3DPtr);
 begin
  edge.a := a;
  edge.b := b;
 end;

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

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

 procedure AddVertice3D (var shape: Shape3D; x, y, z: Fixed);
 begin
  if shape.verticesLength > LIMIT_VERTICES - 1 then
   SceneError('Verticles limit reached');
  shape.verticesLength := shape.verticesLength + 1;
  SetPt3D(shape.vertices[shape.verticesLength], Long2Fix(x), Long2Fix(y), Long2Fix(z));
 end;

 procedure AddEdge3D (var shape: Shape3D; a, b: Integer);
 begin
  if shape.EdgesLength > LIMIT_EDGES - 1 then
   SceneError('Edges limit reached');
  shape.EdgesLength := shape.EdgesLength + 1;
  SetEdge3D(shape.edges[shape.EdgesLength], @shape.vertices[a], @shape.vertices[b]);
 end;

 procedure AddFace3D (var shape: Shape3D; a, b, c: Integer);
 begin
  if shape.facesLength > LIMIT_FACES - 1 then
   SceneError('Edges limit reached');
  shape.facesLength := shape.facesLength + 1;
  SetFc3D(shape.faces[shape.facesLength], @shape.vertices[a], @shape.vertices[b], @shape.vertices[c]);
 end;

 procedure DrawEdge3D (edge: Edge3D);
 begin
  MoveTo3D(edge.a^.x, edge.a^.y, edge.a^.z);
  LineTo3D(edge.b^.x, edge.b^.y, edge.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, white);
  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^.EdgesLength do
   DrawEdge3D(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
{ DrawWidget(50); }
  for i := 1 to scene.length do
   DrawShape3D(scene.shapes[i]);
 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.