{ Пример программы для процедуры InitGraph }

uses Graph, CRT, DOS;

var
  grDriver : Integer;
  grMode   : Integer;
  ErrCode  : Integer;

  InitSec100 : Integer;

procedure DoInitSec100;
var
  Hour, Minute, Second, Sec100: Word;
begin
 GetTime(Hour, Minute, Second, Sec100);
  InitSec100 := Second * 100 + Sec100;
end;

function RealTime : Real;
var
  Hour, Minute, Second, Sec100: Word;
begin
 GetTime(Hour, Minute, Second, Sec100);
  RealTime := ((Second * 100 + Sec100 + 6000 - InitSec100) mod 6000) / 6000;
end;

{ begin Векторная арифметика }

type XY = LongInt;

{
  XY -- это 32битное число вида 65536 * X + Y,
        причём X и Y могут быть отрицательнымию
        Это число можно умножать, складывать, вычитать,
        как если бы это был вектор. Абстракция не
        нарушается до тех пор, пока X и Y не превосходят
        32767 по модулю. В Паскале нет перегрузки
        операций, именно эту проблему и исправляет
        данный хак.

  Сами компоненты X, Y, в свою очередь, являются
  32 * на пиксель. Это позволяет адресовать дробные
  координаты.

}

function X(V : XY) : Integer;
begin
  X := Integer(V and $FFFF);
end;

function Y(V : XY) : Integer;
begin
  Y := Integer((V + LongInt($8000)) shr 16);
end;

function V(X, Y : Integer) : XY;
begin
  V := LongInt(Y) shl 16 + LongInt(X);
end;

{ end Векторная арифметика }

function ei(psi : Real) : XY;
begin
  ei := V(Trunc(Cos(psi) * 32.0), Trunc(Sin(psi) * 32.0));
end;

function MMul(MV, MX, MY : XY) : XY;
var
  MV_X, MV_Y, MX_X, MX_Y, MY_X, MY_Y : Integer;
begin
  MV_X := X(MV); MV_Y := Y(MV);
  MX_X := X(MX); MX_Y := Y(MX);
  MY_X := X(MY); MY_Y := Y(MY);

  MMul := V(Integer((MV_X * LongInt(MX_X) + MV_Y * LongInt(MY_X)) shr 5),
           Integer((MV_X * LongInt(MX_Y) + MV_Y * LongInt(MY_Y)) shr 5));
end;

function MMul2(_X, _Y, _Z : Integer; MX, MY, MZ : XY) : XY;
var
  MX_X, MX_Y, MY_X, MY_Y, MZ_X, MZ_Y : Integer;
begin
  MX_X := X(MX); MX_Y := Y(MX);
  MY_X := X(MY); MY_Y := Y(MY);
  MZ_X := X(MZ); MZ_Y := Y(MZ);

  MMul2 := V(Integer((_X * LongInt(MX_X) +
                      _Y * LongInt(MY_X) +
                      _Z * LongInt(MZ_X)) shr 5),
            Integer((_X * LongInt(MX_Y) +
                      _Y * LongInt(MY_Y) +
                      _Z * LongInt(MZ_Y)) shr 5));
end;

procedure LineXY(Src, Dst: XY);
begin
  Line(X(Src) shr 5, Y(Src) shr 5, X(Dst) shr 5, Y(Dst) shr 5);
end;

procedure Poly4XY(P1, P2, P3, P4 : XY);
var
  Coords : array[0 .. 9] of Integer;
begin
  Coords[0] := X(P1) shr 5;
  Coords[1] := Y(P1) shr 5;
  Coords[2] := X(P2) shr 5;
  Coords[3] := Y(P2) shr 5;
  Coords[4] := X(P3) shr 5;
  Coords[5] := Y(P3) shr 5;
  Coords[6] := X(P4) shr 5;
  Coords[7] := Y(P4) shr 5;
  Coords[8] := Coords[0];
  Coords[9] := Coords[1];
  FillPoly(5, Coords);
  DrawPoly(5, Coords);
end;

procedure MoveToXY(Dst : XY);
begin
  MoveTo(X(Dst) shr 5, Y(Dst) shr 5);
end;

procedure LineToXY(Dst : XY);
begin
  LineTo(X(Dst) shr 5, Y(Dst) shr 5);
end;

function Area4XY(P1, P2, P3, P4 : XY) : LongInt;
begin
  Area4XY :=
   (LongInt(Y(P1)) * LongInt(X(P2)) - LongInt(X(P1)) * LongInt(Y(P2)) +
   LongInt(Y(P2)) * LongInt(X(P3)) - LongInt(X(P2)) * LongInt(Y(P3)) +
   LongInt(Y(P3)) * LongInt(X(P4)) - LongInt(X(P3)) * LongInt(Y(P4)) +
   LongInt(Y(P4)) * LongInt(X(P1)) - LongInt(X(P4)) * LongInt(Y(P1))) div 2;
end;

var
  Center : XY;

procedure DrawFrame(Time: Real; Erase: Boolean);
var
  BookTL, BookTR, BookBL, BookBR : XY;
 { T = top, B = bottom, L = left, R = right }
  Book2TL, Book2TR, Book2BL, Book2BR : XY;
  CoverT, CoverB : XY;
  Dir_X, Dir_Y, Dir_Z : XY;
  RotateXY : XY;
  SeeFront : Boolean;
begin
 if not Erase then
    SetColor(Black)
 else
 begin
    SetFillStyle(SolidFill, White);
    Bar(0, 0, GetMaxX, GetMaxY);
   Exit;
 end;
 {LineXY(Center, Center + ei(Time * 2.0 * Pi * 8.0) * 20);}
  Dir_X := V(100, 0);
  Dir_Y := V(0, -100);
  Dir_Z := V(-50, 50);
  BookBL  := Center + MMul2(-896, -1200,  150, Dir_X, Dir_Y, Dir_Z);
  BookBR  := Center + MMul2( 896, -1200,  150, Dir_X, Dir_Y, Dir_Z);
  BookTL  := Center + MMul2(-896,  1200,  150, Dir_X, Dir_Y, Dir_Z);
  BookTR  := Center + MMul2( 896,  1200,  150, Dir_X, Dir_Y, Dir_Z);
  Poly4XY(BookTL, BookTR, BookBR, BookBL);
  Book2BL := Center + MMul2(-896, -1200, -150, Dir_X, Dir_Y, Dir_Z);
  Book2BR := Center + MMul2( 896, -1200, -150, Dir_X, Dir_Y, Dir_Z);
  Book2TL := Center + MMul2(-896,  1200, -150, Dir_X, Dir_Y, Dir_Z);
  Book2TR := Center + MMul2( 896,  1200, -150, Dir_X, Dir_Y, Dir_Z);
  LineXY(BookBR, Book2BR);
  LineXY(BookTR, Book2TR);
  LineXY(BookTL, Book2TL);
  LineXY(Book2BR, Book2TR);
  LineXY(Book2TR, Book2TL);
  RotateXY := ei((-Cos(Time * 2.0 * Pi * 4.0) * 0.375 + 0.375) * Pi);
  CoverB := Center + MMul2(-896 + X(RotateXY) * 58,
                          -1200,
                           150 + Y(RotateXY) * 58,
                           Dir_X, Dir_Y, Dir_Z);
  CoverT := Center + MMul2(-896 + X(RotateXY) * 58,
                           1200,
                           150 + Y(RotateXY) * 58,
                           Dir_X, Dir_Y, Dir_Z);
  SeeFront := Area4XY(BookBL, CoverB, CoverT, BookTL) > 0;
 if SeeFront then
    SetFillStyle(SolidFill, Brown)
 else
    SetFillStyle(SolidFill, White);
  Poly4XY(BookBL, CoverB, CoverT, BookTL);
 if SeeFront then
 begin
    MoveToXY(Center + MMul2(-896 + X(RotateXY) * 10,
                            1200 -         32 * 10,
                            150 + Y(RotateXY) * 10,
                            Dir_X, Dir_Y, Dir_Z));
    LineToXY(Center + MMul2(-896 + X(RotateXY) * 10,
                            1200 -         32 * 40,
                            150 + Y(RotateXY) * 10,
                            Dir_X, Dir_Y, Dir_Z));
    MoveToXY(Center + MMul2(-896 + X(RotateXY) * 30,
                            1200 -         32 * 10,
                            150 + Y(RotateXY) * 30,
                            Dir_X, Dir_Y, Dir_Z));
    LineToXY(Center + MMul2(-896 + X(RotateXY) * 10,
                            1200 -         32 * 25,
                            150 + Y(RotateXY) * 10,
                            Dir_X, Dir_Y, Dir_Z));
    LineToXY(Center + MMul2(-896 + X(RotateXY) * 30,
                            1200 -         32 * 40,
                            150 + Y(RotateXY) * 30,
                            Dir_X, Dir_Y, Dir_Z));
 end;
end;

var
  i: Integer;
  BufTime : array[0 .. 1] of Real;
  VisBuf, ActBuf : Integer;
begin
  grDriver := VGA;
  grMode := VGAMed;
  InitGraph(grDriver, grMode, 'X:\BP');
  ErrCode := GraphResult;
 if ErrCode = grOk then
 begin
   { Инициализация }
    Center := V(GetMaxX shl 4, GetMaxY shl 4);

    ActBuf := 1;
    VisBuf := 0;
    DoInitSec100;
    BufTime[0] := RealTime;
    BufTime[1] := RealTime;

    Bar(0, 0, GetMaxX, GetMaxY);
    SetActivePage(1);
    Bar(0, 0, GetMaxX, GetMaxY);

   while not KeyPressed do
   begin
      BufTime[ActBuf] := RealTime;
      DrawFrame(BufTime[ActBuf], False);
      ActBuf := ActBuf xor 1;
      VisBuf := VisBuf xor 1;
      SetVisualPage(VisBuf);
      SetActivePage(ActBuf);
      Delay(200);
      DrawFrame(BufTime[ActBuf], True);
   end;
    CloseGraph;
 end
 else
 begin
   WriteLn('Ошибка инициализации графики:', GraphErrorMsg(ErrCode));
   WriteLn('Возможно, программа была запущена не внутри School Pak.');
 end;
end.