Collection of Hack-Phreak Scene Programs/cleanhpvac.zip/cleanhpvac/PHRO.ZIP/BILL.PAS

Pascal/Delphi Source File | 1995-07-21 | 9KB | 318 lines

{   Image Warping Source file                  }
{   PHRO!                                      }
{   Phred/OTM                                  }
{   [e-mail]                      }
{   DO NOT DISTRIBUTE THIS SOURCE FILE         }
Unit Bill;

Interface

Procedure ClintonMorph;

Implementation

Uses Pcx, Polygons, Palettes;

Const
  XGrid = 16;  { Number of grid points going horizontal }
  YGrid = 13;  { Number of grid points going vertical   }
  NumGrids = 7;

Type
  tArray = Array[0..256*256-2] of Byte;
  pArray = ^tArray;
  PointType = Record
    x, y : Integer;
  End;
  tGrid = Array[0..(XGrid - 1), 0..(YGrid - 1)] of PointType;
  pGrid = ^tGrid;

Const
  Box : Array[0..3] of PointType = ((x:-100;y:100),(x:100;y:100),
                                      (x:100;y:-100),(x:-100;y:-100));


Var
  WorldPoints : Array[0..3] of PointType;
  GrdPtr : Pointer;
  OGrid : tGrid;
  Grids : Array[0..10] of pGrid;
  Billy : pArray;
  vPage : pArray;
  Sine, CoSine : Array[0..255] of Longint;

Procedure CalcSine;

Var
  Count : Integer;

Begin
  For Count := 0 to 255 do
    Begin
      Sine[Count] := Round(Sin(2*Pi*Count/256)*256);
      CoSine[Count] := Round(Cos(2*Pi*Count/256)*256);
    End;
End;

Procedure RotateBox(Angle : Integer; Scale : Longint);

Var
  TempX, TempY : Longint;
  Count : Integer;

Begin
  For Count := 0 to 3 do
    Begin
      TempX := Box[Count].x;
      TempY := Box[Count].y;
      WorldPoints[Count].x := Longint(TempX*CoSine[Angle]-TempY*Sine[Angle]) Div 256;
      WorldPoints[Count].y := Longint(TempX*Sine[Angle]+TempY*CoSine[Angle]) Div 256;
      WorldPoints[Count].x := (WorldPoints[Count].x * Scale) Div 256+ 160;
      WorldPoints[Count].y := (WorldPoints[Count].y * Scale) Div 256 + 100;
    End;
End;

Procedure WhirlOut;

Var
  Count, Angle : Integer;

Begin
  FillChar(Mem[$A000:0], 64000, 0);
  Angle := 0;
  For Count := 255 downto 0 do
    Begin
      RotateBox(Angle, Count Shr 1);
      Angle := (Angle + 1) And 255;
      Asm
        Les  di,VPage
        db 66h; Xor  ax,ax
        db 66h; Mov  cx,16000; dw 0;
        db 66h; Rep  Stosw
      End;
      GouraudClipPolygon(WorldPoints[0].x, WorldPoints[0].y,
                       WorldPoints[1].x, WorldPoints[1].y,
                       WorldPoints[2].x, WorldPoints[2].y,
                       100, 100, 100, Seg(VPage^));
      GouraudClipPolygon(WorldPoints[0].x, WorldPoints[0].y,
                       WorldPoints[2].x, WorldPoints[2].y,
                       WorldPoints[3].x, WorldPoints[3].y,
                       100, 100, 100,Seg(VPage^));
      Asm
        Push  ds
        Mov   ax,$A000
        Mov   es,ax
        Xor   di,di
        Lds   si,VPage
        db 66h; Mov  cx, 16000; dw 0;
        db 66h; Rep  Movsw;
        Pop   ds
      End;
    End;
End;

Procedure InitGrid;
{ Standardizes the grid points }

Var
  x, y : Integer;

Begin
  For x := 0 to (XGrid - 1) do
    For y := 0 to (YGrid - 1) do
      Begin
        oGrid[x, y].x := x Shl 4;
        oGrid[x, y].y := y Shl 4;
      End;
End;

Procedure DrawBill(Grid : tGrid);

Var
  xCount, yCount : Integer;

Begin
  Asm
    Les  di,VPage
    db 66h; Xor ax,ax
    db 66h; Mov cx,16000; dw 0;
    db 66h; Rep Stosw
  End;
  For xCount := 0 to (xGrid - 2) do
    For yCount := 0 to (yGrid - 2) do
      Begin
        PhongClipPolygon(Grid[xCount, yCount].x, Grid[xCount, yCount].y,
                         Grid[xCount, yCount+1].x, Grid[xCount, yCount+1].y,
                         Grid[xCount+1, yCount+1].x, Grid[xCount+1, yCount+1].y,
                         oGrid[xCount, yCount].x, oGrid[xCount, yCount].y,
                         oGrid[xCount, yCount+1].x, oGrid[xCount, yCount+1].y,
                         oGrid[xCount+1, yCount+1].x, oGrid[xCount+1, yCount+1].y,
                         Seg(VPage^), Billy);
        PhongClipPolygon(Grid[xCount, yCount].x, Grid[xCount, yCount].y,
                         Grid[xCount+1, yCount].x, Grid[xCount+1, yCount].y,
                         Grid[xCount+1, yCount+1].x, Grid[xCount+1, yCount+1].y,
                         oGrid[xCount, yCount].x, oGrid[xCount, yCount].y,
                         oGrid[xCount+1, yCount].x, oGrid[xCount+1, yCount].y,
                         oGrid[xCount+1, yCount+1].x, oGrid[xCount+1, yCount+1].y,
                         Seg(VPage^), Billy);
      End;
  For xCount := 0 to 199 do
    Move(VPage^[xCount*320], Mem[$A000:xCount*320+32], 256);
End;

Procedure Action;

Const
  NumSteps = 30;

Var
  TempGrid : tGrid;
  ValGrid : tGrid;
  StepGrid : tGrid;
  Count, xCount, yCount : Integer;
  FrameCount : Integer;

Begin
  For Count := 0 to (NumGrids-2) do
    Begin
      For xCount := 0 to (xGrid-1) do
        For yCount := 0 to (yGrid-1) do
          Begin
            ValGrid[xCount, yCount].x := Grids[Count]^[xCount, yCount].x Shl 6;
            ValGrid[xCount, yCount].y := Grids[Count]^[xCount, yCount].y Shl 6;
            StepGrid[xCount, yCount].x :=
              (Grids[Count+1]^[xCount, yCount].x-Grids[Count]^[xCount, yCount].x) Shl 6
                Div NumSteps;
            StepGrid[xCount, yCount].y :=
              (Grids[Count+1]^[xCount, yCount].y-Grids[Count]^[xCount, yCount].y) Shl 6
                Div NumSteps;
          End;
      For FrameCount := 0 to (NumSteps-1) do
        Begin
          For xCount := 0 to (xGrid-1) do
            For yCount := 0 to (yGrid-1) do
              Begin
                TempGrid[xCount, yCount].x := ValGrid[xCount, yCount].x Shr 6;
                TempGrid[xCount, yCount].y := ValGrid[xCount, yCount].y Shr 6;
                Inc(ValGrid[xCount, yCount].x, StepGrid[xCount, yCount].x);
                Inc(ValGrid[xCount, yCount].y, StepGrid[xCount, yCount].y);
              End;
          DrawBill(TempGrid);
        End;
    End;
End;

{$F+}
{$L Grid.Obj}
Procedure GridLocations; External;
{$F-}

Procedure GetGrids;

Var
  GrdSeg, GrdOfs : Word;
  Count : Integer;
  xCount, yCount : Integer;

Begin
  GrdSeg := Seg(GrdPtr^);
  GrdOfs := Ofs(GrdPtr^);
  For Count := 0 to (NumGrids-2) do
    Begin
      New(Grids[Count]);
      For xCount := 0 to (xGrid-1) do
        For yCount := 0 to (yGrid-1) do
          Begin
            Grids[Count]^[xCount, yCount].x := MemW[GrdSeg:GrdOfs];
            Inc(GrdOfs, 2);
            Grids[Count]^[xCount, yCount].y := MemW[GrdSeg:GrdOfs];
            Inc(GrdOfs, 2);
          End;
    End;
  New(Grids[NumGrids-1]);
  Move(Grids[0]^, Grids[NumGrids-1]^, Sizeof(tGrid));
End;

Procedure FadeIn;

Type
  RGB = Record
    r,g,b : Byte;
  End;
  palette = Array[0..255] of RGB;

Var
  Pal1, Pal2 : Palette;
  Count, Count1 : Integer;

Begin
  Move(ClintonPalettePtr^, Pal1, 768);
  FillChar(Pal2, 768, 0);
  For Count := 0 to 255 do
    Begin
      Port[$3c8] := Count1;
      Port[$3c9] := Pal2[Count1].r;
      Port[$3c9] := Pal2[Count1].g;
      Port[$3c9] := Pal2[Count1].b;
    End;
  FillChar(Mem[$A000:0], 64000, 0);
  DrawBill(Grids[0]^);
  For Count := 0 to 63 do
    Begin
      For Count1 := 0 to 255 do
        Begin
          If Pal2[Count1].r < Pal1[Count1].r
            Then Inc(Pal2[Count1].r);
          If Pal2[Count1].r > Pal1[Count1].r
            Then Dec(Pal2[Count1].r);
          If Pal2[Count1].g < Pal1[Count1].g
            Then Inc(Pal2[Count1].g);
          If Pal2[Count1].g > Pal1[Count1].g
            Then Dec(Pal2[Count1].g);
          If Pal2[Count1].b < Pal1[Count1].b
            Then Inc(Pal2[Count1].b);
          If Pal2[Count1].b > Pal1[Count1].b
            Then Dec(Pal2[Count1].b);
        End;
      Asm
        Mov  dx,$3da
       @Looper:
        In   al,dx
        And  al,8
        Jz  @Looper
      End;
      For Count1 := 0 to 255 do
        Begin
          Port[$3c8] := Count1;
          Port[$3c9] := Pal2[Count1].r;
          Port[$3c9] := Pal2[Count1].g;
          Port[$3c9] := Pal2[Count1].b;
        End;
    End;
End;

Procedure ClintonMorph;

Var
  Cheap : Pointer;

Begin
  Mark(Cheap);
  New(VPage);
  New(Billy);
  InitGrid;
  DecompressPCX(Billy^, BillClintonPtr^);
  GetGrids;
  FadeIn;
  Action;
  WhirlOut;
  Dispose(Billy);
  Dispose(VPage);
  Release(Cheap);
End;


Begin
  CalcSine;
  GrdPtr := @GridLocations;
End.