old/PAS/!SPbSTU/Graph/OBJECTS.PAS

{$R-}
Unit Objects;
{‡¤¥áì ­ å®¤ïâáï ¢á¥ ®¡ê¥ªâë (ª« ááë) ¨á¯®«ì§ã¥¬ë¥ ¢ ¯à®£à ¬¬¥}
{$DEFINE WaitRetrace}

INTERFACE
Uses Graph;
type
  FLAGS = set of (NONE,CAN_DRAW);
Const
 FIELD_X : word = 600;
 TRES_LX : word = 10;
 TRES_MX : word = 630;
 TRES_LY : word = 10;
 TRES_MY : word = 470;
 SIZE_Y  : word = 480;
 FPS     : WORD = 1;
 TIME_FACTOR : real = 0.1;
 OBJTYPES : array [1..1] of string[10] = ('RAH-66');


type
{Globals}
 Vector = record
  x,y   : real;
 end;

 TSprites = array [0..(65536 shr 2)-2] of Pointer;
 PSprites = ^TSprites;

 TWordArray = array [0..(65536 shr 1)-2] of word;
 PWordArray = ^TWordArray;

 TByteArray = array [0..65534] of Byte;
 PByteArray = ^TByteArray;

 TParams = record
  Pos,Speed,Accel : Vector;
 end;

 PWorld = ^TWorld;

{ MAIN OBJECT (Global Parent) }
 PWorldObject = ^TWorldObject;
 TWorldObject = object
   ObjType   : string[50];
   Flag      : FLAGS;
   World     : PWorld;
   LocTime   : LONGINT;
   Params    : TParams;
   ZORDER    : Byte;
   Constructor Init;
   Procedure   Frame(t:longInt);virtual; {�à®æ¥¤ãà , ¢ë¯®«­ï¥¬ ï ­  ª ¦¤®¬
                                          è £¥, t - ¢à¥¬ï í⮣® è £  (®â१®ª)
                                          „«ï  ¡á®«îâ­®á⨠¢à¥¬¥­¨}
   Destructor  Done;virtual;
 end;

 pDrawable    = ^tDrawAble;
 tDrawable    = object (TWorldObject)
   BgX,BgY     : integer;
   BackGround  : Pointer;
   LastSize    : integer;
   Constructor Init;
   Procedure Draw;virtual;
 end;

 pRAH         = ^tRAH;
 tRAH         = object (TDrawAble)
 { For animation. Just for speed not in class }
   Frames      : Psprites;
   Masks       : PSprites;
   FileCount   : integer;
   FramesCount : integer;
   FrameSize   : PWordArray;
   xsize,ysize : PWordArray;
   CurFrame    : integer;
 {}

   Constructor Init(AnimDat:string;aPar : TParams;Zord:byte);
   Procedure Frame(t : longint);virtual;
   Procedure Draw;virtual;
   Destructor Done;virtual;
 end;

 pSting         = ^tSting;
 tSting         = object (TDrawable)
 { For animation. Just for speed not in class }
   Frames      : Psprites;
   FramesCount : word;
   FrameSize   : PWordArray;
   xsize,ysize : PWordArray;
   CurFrame    : word;
 {}
   Angle : integer;
   Omega : real;

   Constructor Init(AnimDat:string;aPar : TParams;Zord:byte);
   Procedure Frame(t : longint);virtual;
   Procedure Draw;virtual;
   Destructor Done;virtual;
 end;

{ - - - - - - - - - - - - - - - -}
 PWOsList = ^TWOsList;
 TWOsList = record
  o    : PworldObject;
  next : PWOsLIst;
 end;

 TWorld = object
 Public
   Ending    : boolean;
   Procedure   Gone(aObj : PWorldObject); {Objects, that needs to be killed}
   Constructor Init(aBGn : string); {aBGN - BackGround fileName}
   Procedure   Draw;
   Procedure   Frame(t:longint);
   Function AddObject(aOb : PWorldObject):boolean;
   Function RemoveObject(aOb:PWorldObject):boolean;
   Destructor Done;
 Private
   WObjects        : PWOsList;
   ToGone          : PWOsList; {‘⥪ ®¡ê¥ªâ®¢ ­  "㡨©á⢮"}
  { BackGround }
   xpos, ypos      : PWordArray;
   xsize,ysize     : PWordArray;
   FrameCount      : Byte;
   BackGround      : Psprites;
   FrameSize       : PWordArray;
  {}
 end;
{-----------  END OF OBJECTS ----------------------}

      IMPLEMENTATION
{ TWorldObject Dummy }
{------------------------------------------}
Constructor TworldObject.Init;
begin
 ObjType := 'dummy';
 Flag := [NONE];
 LocTime := 0;
end;{TworldObject.Init}
{----}
Procedure TWorldObject.Frame;
begin {Nothing here now}
end; {TWorldObject.Frame}
{----}
Destructor TWorldObject.Done;
begin {Nothing here now}
end; {TWorldObject.Done}
{----}
Constructor TDrawable.Init;
begin
 Inherited Init;
 Flag := Flag + [CAN_DRAW];
 BgX:=0;BgY:=0;
 BackGround:=nil;
 LastSize:=0;
end;{TDrawable.Init}
Procedure TDrawable.Draw;
begin
end;{TDrawable.Draw}
{------------------------------------------}
{  First object - Helicopter Commanche RAH-66}
Constructor tRAH.Init;
var
  i : byte;
  F : FILE;
begin
  Inherited Init;
  ObjType := 'RAH-66';

  Params := aPar;
  ZOrder := zOrd;

  Assign(F,AnimDat);
  {$I-}
    Reset(F,1);
    If IOResult <> 0 then
     begin
      CloseGraph;
      WriteLn('Error opening animation library for RAH-66 (',AnimDat,')');
      Halt(255);
     end;
  {$I+}
  BlockRead(F,FileCount,2);
  FramesCount := (FileCount-1)*2;
  GetMem(Frames,FramesCount*sizeof(Pointer));
  GetMem( Masks,FramesCount*sizeof(Pointer));
  GetMem(xsize,FramesCount*sizeof(Word));
  GetMem(ysize,FramesCount*sizeof(Word));
  GetMem(FrameSize,FramesCount*sizeof(Word));

  for i := 0 to FileCount-1 do
  begin
   BlockRead(F,FrameSize^[i],2);
   GetMem(Frames^[i],FrameSize^[i]);
   BlockRead(F,xsize^[i],2);inc(xsize^[i]);
   BlockRead(F,ysize^[i],2);inc(ysize^[i]);
   Seek(F,FilePos(F)-4);
   BlockRead(F,Frames^[i]^,FrameSize^[i]);
   GetMem(Masks^[i],FrameSize^[i]);
   BlockRead(F,Masks^[i]^,FrameSize^[i]);
  end;

  for i := FileCount to FramesCount-1 do
  begin
    Frames^[i] := Frames^[FramesCount-i];
    Masks^[i]  := Masks^[FramesCount-i];
    FrameSize^[i] := FrameSize^[FramesCount-i];
    xsize^[i]  := xsize^[FramesCount-i];
    ysize^[i]  := ysize^[FramesCount-i];
  end;

  LastSize := ImageSize(0,0,xsize^[0],ysize^[0]);
  if LastSize = 0 then
   begin
    CloseGraph;
    WriteLn('Fucked Error');
    Halt(255);
   end;
  GetMem(BackGround,LastSize);
  BgX := round(Params.Pos.x-(xsize^[0] shr 1));
  BgY := SIZE_Y-round(Params.Pos.y+(ysize^[0] shr 1));
  GetImage(BgX,BgY,BgX+xsize^[0],BgY+ysize^[0],BackGround^);
  CurFrame := 0;
end;{tRAH.Init}
{----}
Procedure tRAH.Frame;
begin
  with Params do begin
    Speed.x := Speed.x+Accel.x*t*TIME_FACTOR;
    Speed.y := Speed.y+Accel.y*t*TIME_FACTOR;
    Pos.x := Pos.x + Speed.X*t*TIME_FACTOR;
    Pos.y := Pos.y + Speed.y*t*TIME_FACTOR;
    if Pos.x > FIELD_X then
      World^.Gone(@Self);
    LocTime := LocTime + t;
  end;
end;{tRAH.Frame}
{----}
Procedure tRAH.Draw;
var
 Top,Left : word;
begin
  Left := round(Params.Pos.x-(xsize^[CurFrame] shr 1));
  Top  := SIZE_Y-round(Params.Pos.y+(ysize^[CurFrame] shr 1));
{   repeat until (Port[$03DA] and 8) <> 8;
   repeat until (Port[$03DA] and 8) =  8;
}  PutImage(BgX,BgY,BackGround^,NormalPut);
  if (Top<TRES_LY) or ((Top+ysize^[CurFrame])>=TRES_MY) or
     (Left<TRES_LX) or ((Left+xsize^[CurFrame])>=TRES_MX) then
      exit;
  FreeMem(BackGround,LastSize);
  BgX := Left;
  BgY := Top;
  LastSize := ImageSize(BgX,BgY,BgX+xsize^[CurFrame],BgY+ysize^[CurFrame]);
  if LastSize = 0 then
   begin
    CloseGraph;
    WriteLn('Fucked Error');
    Halt(255);
   end;
  GetMem(BackGround,LastSize);
  GetImage(BgX,BgY,BgX+xsize^[CurFrame],BgY+ysize^[CurFrame],BackGround^);
{   repeat until (Port[$03DA] and 8) <> 8;
   repeat until (Port[$03DA] and 8) =  8;
}  PutImage(Left,Top,Masks^[CurFrame]^,AndPut);
  {$IFDEF WaitRetrace}
   repeat until (Port[$03DA] and 8) <> 8;
   repeat until (Port[$03DA] and 8) =  8;
  {$ENDIF}
  PutImage(Left,Top,Frames^[CurFrame]^,OrPut);
  CurFrame := (CurFrame+LocTime div FPS) mod FramesCount;
  LocTime := LocTime mod FPS;
end;{tRAH.Draw}
{----}
Destructor tRAH.Done;
var
 i:byte;
begin
  PutImage(BgX,BgY,BackGround^,NormalPut);
  FreeMem(BackGround,LastSize);

  for i := 0 to FileCount-1 do
  begin
    FreeMem(Frames^[i],FrameSize^[i]);
    FreeMem( Masks^[i],FrameSize^[i]);
  end;

  FreeMem(Frames,FramesCount*sizeof(Pointer));
  FreeMem( Masks,FramesCount*sizeof(Pointer));
  FreeMem(FrameSize,FramesCount*sizeof(Word));
  FreeMem(xsize,FramesCount*sizeof(Word));
  FreeMem(ysize,FramesCount*sizeof(Word));

  Inherited Done;
end; {tRAH.Done}
{-------------------------------------------------}
{  Second object - rocket earth-air Stinger (hand-made) :) }
Constructor tSting.Init;
var
  i : byte;
  F : FILE;
begin
  Inherited Init;
  ObjType := 'Stinger';

  Params := aPar;
  ZOrder := zOrd;
    if Params.Speed.x = 0 then
    begin
     if Params.Speed.y > 0 then Angle := 90 else
     Angle := 270;
    end else
     Angle  := round(360/(2*Pi)*ArcTan(Params.Speed.y/Params.Speed.x));
    if Angle < 0 then Inc(Angle,360);
    if Params.Speed.X < 0 then Inc(Angle, 180);
    if Angle >= 360 then Dec(Angle, 360);

  Assign(F,AnimDat);
  {$I-}
    Reset(F,1);
    If IOResult <> 0 then
     begin
      CloseGraph;
      WriteLn('Error opening animation library for Stinger (',AnimDat,')');
      Halt(255);
     end;
  {$I+}
  BlockRead(F,FramesCount,2);
  GetMem(Frames,FramesCount*sizeof(Pointer));
  GetMem(xsize,FramesCount*sizeof(Word));
  GetMem(ysize,FramesCount*sizeof(Word));
  GetMem(FrameSize,FramesCount*sizeof(Word));

  for i := 0 to FramesCount-1 do
  begin
   BlockRead(F,FrameSize^[i],2);
   GetMem(Frames^[i],FrameSize^[i]);
   BlockRead(F,xsize^[i],2);inc(xsize^[i]);
   BlockRead(F,ysize^[i],2);inc(ysize^[i]);
   Seek(F,FilePos(F)-4);
   BlockRead(F,Frames^[i]^,FrameSize^[i]);
  end;

  CurFrame := (Angle div 6) - 1;
  if CurFrame < 0 then inc(curframe,FramesCount);

  LastSize := ImageSize(0,0,xsize^[CurFrame],ysize^[CurFrame]);
  if LastSize = 0 then
   begin
    CloseGraph;
    WriteLn('Stupid Error! (Can''t get mem for CREATED image)');
    Halt(255);
   end;
  GetMem(BackGround,LastSize);
  BgX := round(Params.Pos.x-(xsize^[CurFrame] shr 1));
  BgY := SIZE_Y-round(Params.Pos.y+(ysize^[CurFrame] shr 1));
  GetImage(BgX,BgY,BgX+xsize^[CurFrame],BgY+ysize^[CurFrame],BackGround^);
end;{tSting.Init}
{----}
Procedure tSting.Frame;
begin
  with Params do begin
    Speed.x := Speed.x+Accel.x*t*TIME_FACTOR;
    Speed.y := Speed.y+Accel.y*t*TIME_FACTOR;
    if Params.Speed.x = 0 then
    begin
     if Params.Speed.y > 0 then Angle := 90 else
     Angle := 270;
    end else
     Angle  := round(360/(2*Pi)*ArcTan(Params.Speed.y/Params.Speed.x));
    if Angle < 0 then Inc(Angle,360);
    if Speed.X < 0 then Inc(Angle, 180);
    if Angle >= 360 then Dec(Angle, 360);

    Pos.x := Pos.x + Speed.X*t*TIME_FACTOR;
    Pos.y := Pos.y + Speed.y*t*TIME_FACTOR;
    if not ((Pos.X>TRES_LX) and (Pos.X<TRES_MX) and
            (Pos.Y>TRES_LY) and (Pos.Y<TRES_MY)) then
    if (((Pos.x>TRES_MX) and ((Speed.X>0) or (Accel.X>0))) or
        ((Pos.x<TRES_LX) and ((Speed.X<0) or (Accel.X<0))) or
        ((Pos.y>TRES_MY) and ((Speed.Y>0) or (Accel.Y>0))) or
        ((Pos.y<TRES_LY) and ((Speed.Y<0) or (Accel.Y<0))))
     then
      World^.Gone(@Self);

    LocTime := LocTime + t;
  end;
end;{tSting.Frame}
{----}
Procedure tSting.Draw;
var
 Top,Left : integer;
begin
  CurFrame := (Angle div (360 div FramesCount)) - 1;
  if CurFrame < 0 then inc(curframe,FramesCount);
  Left := round(Params.Pos.x-(xsize^[CurFrame] shr 1));
  Top  := SIZE_Y-round(Params.Pos.y+(ysize^[CurFrame] shr 1));
{   repeat until (Port[$03DA] and 8) <> 8;
   repeat until (Port[$03DA] and 8) =  8;}
  PutImage(BgX,BgY,BackGround^,NormalPut);
  if (Top<TRES_LY) or ((Top+ysize^[CurFrame])>=TRES_MY) or
     (Left<TRES_LX) or ((Left+xsize^[CurFrame])>=TRES_MX) then
      exit;
  FreeMem(BackGround,LastSize);
  BgX := Left;
  BgY := Top;
  LastSize := ImageSize(BgX,BgY,BgX+xsize^[CurFrame],BgY+ysize^[CurFrame]);
  if LastSize = 0 then
   begin
    CloseGraph;
    WriteLn('Fucked Error');
    Halt(255);
   end;
  GetMem(BackGround,LastSize);
  GetImage(BgX,BgY,BgX+xsize^[CurFrame],BgY+ysize^[CurFrame],BackGround^);
  {$IFDEF WaitRetrace}
   repeat until (Port[$03DA] and 8) <> 8;
   repeat until (Port[$03DA] and 8) =  8;
  {$ENDIF}
  PutImage(Left,Top,Frames^[CurFrame]^,AndPut);
  LocTime := LocTime mod FPS;
end;{tSting.Draw}
{----}
Destructor tSting.Done;
var
 i:byte;
begin
  PutImage(BgX,BgY,BackGround^,NormalPut);
  FreeMem(BackGround,LastSize);

  for i := 0 to FramesCount-1 do
    FreeMem(Frames^[i],FrameSize^[i]);

  FreeMem(Frames,FramesCount*sizeof(Pointer));
  FreeMem(FrameSize,FramesCount*sizeof(Word));
  FreeMem(xsize,FramesCount*sizeof(Word));
  FreeMem(ysize,FramesCount*sizeof(Word));

  Inherited Done;
end; {tSting.Done}
{-------------------------------------------------}
{ ------  WOLRD OBJECT ( ã¯à ¢«ï¥â ¢á¥¬ ) --------}
Constructor TWorld.Init;
var
  F: FILE;
  k:byte;
begin
  New(WObjects);         {Init Dummy Element in Objectlist}
  WObjects^.Next:=nil;
  WObjects^.O:=nil;

  ToGone:=nil;

  Ending := false;    {Global variable showing need to end}

  if aBGN <> '' then
   begin
     Assign(F,aBGN);
     {$I-}
       Reset(F,1);
       If IOResult <> 0 then exit;
     {$I+}

     BlockRead(F,FrameCount,1);
     GetMem(Background,FrameCount*sizeof(Pointer));
     GetMem(xpos,FrameCount*sizeof(word));
     GetMem(ypos,FrameCount*sizeof(word));
     GetMem(xsize,FrameCount*sizeof(word));
     GetMem(ysize,FrameCount*sizeof(word));
     GetMem(FrameSize,FrameCount*sizeof(word));

     for k:=0 to FrameCount-1 do
      begin
       BlockRead(F,FrameSize^[k],2);
       BlockRead(F,xPos^[k],2);
       BlockRead(F,yPos^[k],2);
       BlockRead(F,xSize^[k],2);
       BlockRead(F,ySize^[k],2);
       Seek(F,FilePos(F)-4);
       GetMem(BackGround^[k],FrameSize^[k]);
       BlockRead(F,BackGround^[k]^,FrameSize^[k]);
       PutImage(xpos^[k],ypos^[k],BackGround^[k]^,NormalPut);
      end;
      Close(F);
   end
  else
   BackGround := nil;
end;{TWorld.Init}
{------}
Function TWorld.AddObject(aOb : PWorldObject):boolean;
var
 N,C : PWOsList;
begin
  New(N);
  N^.O := aOb;
  n^.Next:=NIL;
  aOb^.World := @Self;
{  LastObj^.Next^.Next:=nil;
  LAstObj:=LastObj^.Next;}

  c:=WObjects; {ˆ­¨æ. "¡¥£ã­®ª"}

  while (c^.next <> nil) and               {�®ª  ­¥ ¯®á«¥¤­¨© í«-â,}
        (aOb^.ZORDER > c^.next^.o^.ZORDER) {¨ ¢ë¯®«­ï¥âáï ®âá®àâ¨à®¢ ­­®áâì}
    do c:=c^.next;

  n^.next := c^.next; {‚áâ ¢«ï¥¬ ­ è í«-â ¬¥¦¤ã "¡¥£ã­ª®¬"}
  c^.next := n;       {¨ á«¥¤ãî騬 §  ­¨¬}

  AddObject:=true;
end;
{------}
Procedure TWorld.Gone;
var
 N : PWOsList;
begin
  New(N);
  N^.O := aObj;
  n^.Next:=ToGone;
  ToGone := n;
end;
{------}
Function TWorld.RemoveObject(aOb:PWorldObject):boolean;
var
 c,g : PWOsList;
begin
  C:=WObjects;
  while (C^.next <> nil) and (c^.next^.o <> aOb) do c:=c^.next;
  if c^.next <> nil then
   begin
     RemoveObject:=true;
     g := c^.next;
     c^.next := g^.next;
     Dispose(g^.O,Done);
     Dispose(g);
   end
  else
   RemoveObject := false;
end;{TWorld.RemoveObject}
{----------------------------}
Procedure  TWorld.Frame;
var
 c,c2 : PWOsList;
 ob   : PDrawable;
begin
 c := ToGone; {Killing dead objects}
 while c<>nil do
  begin
    RemoveObject(c^.o);
    c2:=c^.next;
    dispose(c);
    c:=c2;
  end;
 ToGone:=nil;
 c:=WObjects^.Next;
 if c = nil then Ending:=true;
 while c <> nil do
  begin
    C^.O^.Frame(t);
    C:=C^.next;
  end;
end;{TWorld.Frame}
{----------------------------}
Procedure  TWorld.Draw;
var
 c : PWOsList;
begin
 c:=WObjects^.Next;
 while c <> nil do
  begin
    if CAN_DRAW IN C^.O^.Flag then PDrawable(C^.O)^.Draw;
    C:=C^.next;
  end;
end;{TWorld.Draw}
{----------------------------}
Destructor TWorld.Done;
var
 g:PWOsList;
begin
 while WObjects <> nil do
 begin
   g := WObjects^.next;
    if WObjects^.o <> nil then Dispose(WObjects^.o,Done);
   Dispose(WObjecTs);
   WObjects := g;
 end;
 while ToGone <> nil do
 begin
   g := ToGone^.next;
   Dispose(ToGone^.o,Done);
   Dispose(ToGone);
   ToGone := g;
 end;
 if BackGround <> nil then
  begin
    FreeMem(Background,FrameCount*sizeof(Pointer));
    FreeMem(xpos,FrameCount*sizeof(word));
    FreeMem(ypos,FrameCount*sizeof(word));
    FreeMem(xsize,FrameCount*sizeof(word));
    FreeMem(ysize,FrameCount*sizeof(word));
    FreeMem(FrameSize,FrameCount*sizeof(word));
   end;
end; {TWorld.Done}
{---------------------------------------------}
{------ OTHER PROCEDURES ---------------}
END.