old/PAS/!SPbSTU/Graph/objects3.pas

{$R-}
Unit Objects3;
{Здесь находятся все объекты (классы) используемые в программе}
{Версия 3я, используется страницы и память EMS}

INTERFACE
Uses Graph, Draw10H,My_MEM;
type
  FLAG_ENUM = (NONE,CAN_DRAW,HEAT);
  FLAGS = set of FLAG_ENUM;
Const
 M_360_2PI = 360/(2*Pi);
 GLOB_G  : real = 0.01;
 FIELD_X : word = 600;
 TRES_LX : word = 10;
 TRES_MX : word = 630;
 TRES_LY : word = 10;
 TRES_MY : word = 340;
 SIZE_Y  : word = 350;
 FPS     : WORD = 1;
 TIME_FACTOR : real = 0.1;

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;

 TEMMFrames = record    {For all frames allocating one memory block, with}
  Mem    : EMMRec;      { 'framecount' pages}
  Page   : PWordArray;  {This array handles number of pages, linked with
                         framenum's}
  Offs   : PWordArray;
 end;

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

 PWorld = ^TWorld;

{ MAIN OBJECT (Global Parent) }
 PWorldObject = ^TWorldObject;
 TWorldObject = object
   ObjType   : string[20];
   Flag      : FLAGS;
   World     : PWorld;
   LocTime   : LONGINT;
   Params    : TParams;
   Angle     : integer;
   ZORDER    : Byte;

   Started   : boolean;

   Constructor Init;
   Procedure   Frame(t:longInt);virtual; {Процедура, выполняемая на каждом
                                          шаге, t - время этого шага (отрезок)
                                          Для абсолютности времени}
   Destructor  Done;virtual;
 end;

 pDrawable    = ^tDrawAble;
 tDrawable    = object (TWorldObject)
 {  Frames      : Psprites;}
   Frames      : TEMMFrames;
   FramesCount : integer;
   FrameSize   : PWordArray;
   xsize,ysize : PWordArray;
   CurFrame    : integer;
   Constructor Init;
   Procedure Draw;virtual;
   Function Inside(aPos:Vector):boolean;virtual;
 end;

 pRAH         = ^tRAH;
 tRAH         = object (TDrawable)
   Masks       : TEMMFrames;
   FileCount   : integer;
   NextTrap    : longint;
   FrameTime   : longint;
   TrapBase,  TrapVar  : longint;
   SpeedBase, SpeedVar : longint;
   CountBase, CountVar : integer;
   A,B         : Vector;
   Constructor Init(AnimDat:string;aPar : TParams;Zord:byte);
   Procedure DropTraps(aCount:byte);
   Procedure Frame(t : longint);virtual;
   Procedure Draw;virtual;
   Function Inside(aPos:Vector):boolean;virtual;
   Destructor Done;virtual;
 end;

 pTrap          = ^tTrap;
 tTrap          = object(TDrawable)
   MFrames     : Psprites;
   Constructor Init(AnimDat:string;var aPos:vector; var aSpeed,aG : real; aAng:integer;zOrd:byte);
   Procedure   Frame(t : longint);virtual;
   Procedure   Draw;virtual;
   Function Inside(aPos:Vector):boolean;virtual;
   Destructor  Done;virtual;
 end;

 pSting         = ^tSting;
 tSting         = object (TDrawable)
   dAngle  : integer;
   Nose    : Vector;
   Constructor Init(AnimDat:string;aPar : TParams;adAng:integer;Zord:byte);
   Procedure GetAngle;
   Procedure FindTarget(aDa:integer);
   Procedure ChangeAngle(dA : integer);
   Procedure Frame(t : longint);virtual;
   Procedure Draw;virtual;
   Destructor Done;virtual;
 end;

 pExpl         = ^tExpl;
 tExpl         = object (TDrawAble)
   Masks       : TEMMFrames;
   LifeTime    : Longint;
   Constructor Init(AnimDat:string;aLifeTime:longint;aPos:vector;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
   Ending      : boolean;
   MSG         : string;
   MSGSize     : word;
   MSGColor    : byte;
   Procedure   Gone(aObj : PWorldObject); {Objects, that needs to be killed}
   Constructor Init(aBGn : string); {aBGN - BackGround fileName}
   Procedure   Draw;
   Procedure   Frame(t:longint);
   Function    Radar(aSelf:PWorldObject;aFlg:FLAG_ENUM;var a0:integer;a1:integer;var aDist:real):PWorldObject;
   Procedure   StartObjects(aT:string);
   Procedure   Explosion(aPos:vector);
   Procedure   Message(aS:string;aSize:word;aColor:byte);
   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      : TEMMFrames;
   FrameSize       : PWordArray;
  {}
 end;
{-----------  END OF OBJECTS ----------------------}

      IMPLEMENTATION
{ TWorldObject Dummy }
{------------------------------------------}
Procedure Error(aMSG : string);
begin
  CloseGraph;
  WriteLn(aMSG);
  Halt(2);
end;{Error}
{------------}
Constructor TworldObject.Init;
begin
 ObjType := 'dummy';
 Flag := [NONE];
 Zorder := 0;
 LocTime := 0;
 Started := false;
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];
   Frames.Mem.EMMHandle:=0;
   Frames.Mem.PageCount:=0;
   Frames.Page:=nil;
   Frames.Offs:=nil;
   FramesCount:=0;
   FrameSize:=nil;
   xsize:=nil;ysize:=nil;
   CurFrame:=0;
end;{TDrawable.Init}
{----}
Procedure TDrawable.Draw;
begin
end;{TDrawable.Draw}
Function TDrawable.Inside;
begin
 Inside:=false;
end;{TDrawable.Inside}
{------------------------------------------}
{  First object - Helicopter Commanche RAH-66}
Constructor tRAH.Init;
var
  i : byte;
  F : FILE;
  cOffs,cPage : word;
  AbsAddr : Pointer;
begin
  Inherited Init;
  Randomize;
  FLAG := FLAG + [HEAT] - [NONE];
  ObjType := 'RAH-66';
  TrapBase := 100;
  TrapVar  := 30;
{  NextTrap := TrapBase + random(TrapVar) - (TrapVar shr 1);}

  Params := aPar;
  ZOrder := zOrd;

  Assign(F,AnimDat);
  {$I-}
    Reset(F,1);
    If IOResult <> 0 then
      Error('Error opening animation library for RAH-66');
  {$I+}
  BlockRead(F,FileCount,2);
  FramesCount := (FileCount-1)*2;

  if not TestAllocEMM(FileSize(F)+1 shl 13) then
  begin CloseGraph;
     WriteLn('Sorry, not enough EMS memory, need ',FileSize(F)+1 shl 13,' get ',MaxEMM);
     Halt(255);
  end;

  if not AllocEMM(FileSize(F) shr 1 +1 shl 13,Frames.Mem) then
   Error('Error while allocating EMS memory for tRAH');

  if not AllocEMM(FileSize(F) shr 1 +1 shl 13,Masks.Mem) then
   Error('Error while allocating EMS memory for tRAH');

  GetMem(Frames.Page,FramesCount*sizeof(word));
  GetMem(Frames.Offs,FramesCount*sizeof(word));
  GetMem(Masks .Page,FramesCount*sizeof(word));
  GetMem(Masks .Offs,FramesCount*sizeof(word));
  GetMem(xsize,    FramesCount*sizeof(Word));
  GetMem(ysize,    FramesCount*sizeof(Word));
  GetMem(FrameSize,FramesCount*sizeof(Word));

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

   if ((FrameSize^[i]+cOffs) shr 14) > 3 then begin inc(cPage); cOffs:=0; end;
   Frames.Page^[i] := cPage;
   Frames.Offs^[i] := cOffs;
   if not MapEMMMemory(Frames.Mem,cPage,cPage+(FrameSize^[i]+cOffs) shr 14) Then
    Error('Error mapping tRAH frame');

   AbsAddr := Ptr(SegEMMFrame,cOffs);
   BlockRead(F,AbsAddr^,FrameSize^[i]);

   Masks.Page^[i] := cPage;
   Masks.Offs^[i] := cOffs;
   if not MapEMMMemory(Masks.Mem,cPage,cPage+(FrameSize^[i]+cOffs) shr 14) then
      Error('Error mapping tRAH mask');

   AbsAddr := Ptr(SegEMMFrame,cOffs);
   BlockRead(F,AbsAddr^,FrameSize^[i]);

   Inc(cOffs, FrameSize^[i]);
   Inc(cPage, cOffs shr 14);
   cOffs := cOffs and $3FFF;
  end;

  A.X := -(xsize^[0] shr 1);
  B.X := xsize^[0] shr 1;
  A.Y := -(ysize^[0] shr 1);
  B.Y := ysize^[0] shr 1;

  for i := FileCount to FramesCount-1 do
  begin
    Frames.Page^[i] := Frames.Page^[FramesCount-i];
    Frames.Offs^[i] := Frames.Offs^[FramesCount-i];
     Masks.Page^[i] :=  Masks.Page^[FramesCount-i];
     Masks.Offs^[i] :=  Masks.Offs^[FramesCount-i];
      FrameSize^[i] :=   FrameSize^[FramesCount-i];
          xsize^[i] :=       xsize^[FramesCount-i];
          ysize^[i] :=       ysize^[FramesCount-i];
  end;
  Close(F);

  CurFrame := 0;
end;{tRAH.Init}
{----}
Function tRAH.Inside;
begin
 with Params.pos do
  Inside := (aPos.x > A.X+X) and (aPos.x < B.X+X) and
            (aPos.y > A.y+y) and (aPos.y < B.y+y);
end;{tRAH.Inside}
{----------------------}
Procedure tRAH.Frame;
begin
 if started then
 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);
  end;
  LocTime := LocTime + t;
  inc(FrameTime,t);
  if LocTime > NextTrap then
  begin
    DropTraps(CountBase + random(Countvar)-(countvar shr 1));
    NextTrap := LocTime + TrapBase + random(TrapVar) - (TrapVar shr 1);
  end;
 end;
end;{tRAH.Frame}
{-----}
Procedure tRAH.DropTraps;
var
 aNewTrap : pTrap;
 i        : byte;
 nspeed   : real;
 nangle   : integer;
begin
 Randomize;
 for i := 1 to aCount do
 begin
  nangle := random(360);
  nspeed := speedBase + random*SpeedVar - (SpeedVar shr  1);
  New(aNewTrap,Init('trap.dat',Params.pos,nspeed,GLOB_G,nangle,Zorder+random(11)-5));
  World^.AddObject(aNewTrap);
 end;
end;{tRAH.DropTrap}
{----}
Procedure tRAH.Draw;
var
 Top,Left : word;
 AbsMem   : pointer;
begin
  Left := round(Params.Pos.x-(xsize^[CurFrame] shr 1));
  Top  := SIZE_Y-round(Params.Pos.y+(ysize^[CurFrame] shr 1));

  if (Top<TRES_LY) or ((Top+ysize^[CurFrame])>=TRES_MY) or
     (Left<TRES_LX) or ((Left+xsize^[CurFrame])>=TRES_MX) then
      exit;

  if not MapEMMMemory(Masks.Mem,Masks.Page^[CurFrame],
                      Masks.Page^[CurFrame]+(FrameSize^[CurFrame]+Masks.Offs^[CurFrame]) shr 14) then
    Error('Error mapping memory for mask while drawing tRAH');
  AbsMem := Ptr(SegEMMFrame,Masks.Offs^[CurFrame]);
  PutImage(Left,Top,AbsMem^,AndPut);

  if not MapEMMMemory(Frames.Mem,Frames.Page^[CurFrame],
                      Frames.Page^[CurFrame]+(FrameSize^[CurFrame]+Frames.Offs^[CurFrame]) shr 14) then
    Error('Error mapping memory for frame while drawing tRAH');

  AbsMem := Ptr(SegEMMFrame,Frames.Offs^[CurFrame]);
  PutImage(Left,Top,AbsMem^,OrPut);

  CurFrame := (CurFrame+FrameTime div FPS) mod FramesCount;
  FrameTime := FrameTime mod FPS;
end;{tRAH.Draw}
{----}
Destructor tRAH.Done;
begin
  FreeEMM(Frames.Mem);
  FreeEMM(Masks.Mem);

  FreeMem(Frames.page,FramesCount*sizeof(word));
  FreeMem( Masks.page,FramesCount*sizeof(word));
  FreeMem(Frames.Offs,FramesCount*sizeof(word));
  FreeMem( Masks.Offs,FramesCount*sizeof(word));
  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;
  cPage, cOffs : word;
  AbsMem       : pointer;
begin
  Inherited Init;
  ObjType := 'Stinger';

  Params := aPar;
  ZOrder := zOrd;
  dAngle := adAng;

  GetAngle;
  Nose.x:=Params.pos.x + xsize^[0]/2*cos(Angle/M_360_2PI);
  Nose.y:=Params.pos.y + xsize^[0]/2*sin(Angle/M_360_2PI);

  Assign(F,AnimDat);
  {$I-}
    Reset(F,1);
    If IOResult <> 0 then
      Error('Error opening animation library for Stinger');
  {$I+}
  BlockRead(F,FramesCount,2);
  GetMem(Frames.Page,FramesCount*sizeof(word));
  GetMem(Frames.Offs,FramesCount*sizeof(word));
  GetMem(xsize,      FramesCount*sizeof(Word));
  GetMem(ysize,      FramesCount*sizeof(Word));
  GetMem(FrameSize,  FramesCount*sizeof(Word));

  if not TestAllocEMM(FileSize(F)+1 shl 13) then
  begin
     CloseGraph;
     WriteLn('Sorry, not enough EMM memory, need ',FileSize(F)+1 shl 13,' get ',MaxEMM);
     Halt(255);
  end;

  if not AllocEMM(FileSize(F)+1 shl 13,Frames.Mem) then
    Error('Error while allocating EMS memory for Stinger');

  cPage:=0;cOffs:=0;
  for i := 0 to FramesCount-1 do
  begin
   BlockRead(F,FrameSize^[i],2);

   BlockRead(F,xsize^[i],2);inc(xsize^[i]);
   BlockRead(F,ysize^[i],2);inc(ysize^[i]);
   Seek(F,FilePos(F)-4);

   if ((FrameSize^[i]+cOffs) shr 14) > 3 then begin inc(cPage); cOffs:=0; end;
   Frames.Page^[i]:=cPage;
   Frames.Offs^[i]:=cOffs;
   if not MapEMMMemory(Frames.Mem,cPage,cPage + (FrameSize^[i]+cOffs) shr 14) then
    Error('Error mapping memory for frame while reading stinger');

   AbsMem := Ptr(SegEMMFrame,cOffs);
   BlockRead(F,AbsMem^,FrameSize^[i]);

   Inc(cOffs, FrameSize^[i]);
   Inc(cPage, cOffs shr 14);
   cOffs := cOffs and $3FFF;
  end;
  Close(F);

  CurFrame := (Angle div (360 div FramesCount));
  if CurFrame < 0 then inc(curframe,FramesCount);
end;{tSting.Init}
{----}
Procedure tSting.ChangeAngle(dA : integer);
var
 speed : real;
begin
  Angle := dA;
  while Angle < 0 do Inc(Angle,360);
  while Angle > 360 do dec(Angle,360);
  speed := sqrt(sqr(params.speed.x)+sqr(params.speed.y));
  Params.Speed.x := Speed * cos(Angle/M_360_2PI);
  Params.Speed.y := Speed * sin(Angle/M_360_2PI);
end;
{---------------}
Procedure tSting.FindTarget;
var
 ang:integer;
 dist  : real;
 ob    : PWorldObject;
begin
  ang:=-ada;
  ob := World^.Radar(@Self,HEAT,ang,-ang,dist);
  if (ob <> nil) then
   begin
    ChangeAngle(ang);
   end
  else GetAngle;

  ang:=-30;
  ob := World^.Radar(@Self,HEAT,ang,-ang,dist);
  if ob = nil then exit;
  if PDrawable(ob)^.Inside(Nose) then
  begin
   World^.Explosion(ob^.params.pos);
   World^.Gone(@Self);
   World^.Gone(ob);
   if ob^.objtype = 'RAH-66' then World^.Message('You Win',4,LightRed)
   else World^.Message('You Lose',4,LightGray);
  end;
end;{tSting.FindTarget}
{--------}
Procedure tSting.GetAngle;
begin
    if Params.Speed.x = 0 then
    begin
     if Params.Speed.y > 0 then Angle := 90 else
     Angle := 270;
    end else
     Angle  := round(M_360_2PI*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);
end;{tSting.GetAngle}
{------}
Procedure tSting.Frame;
begin
 if started then
 begin
  with Params do begin
    Speed.x := Speed.x+Accel.x*t*TIME_FACTOR;
    Speed.y := Speed.y+Accel.y*t*TIME_FACTOR;
    FindTarget(dAngle);

    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;
end;{tSting.Frame}
{----}
Procedure tSting.Draw;
var
 Top,Left : integer;
 x12,x22,y12,y22 : real;
 AbsMem          : pointer;
begin
  CurFrame := (Angle div (360 div FramesCount));
  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));
  if (Top<TRES_LY) or ((Top+ysize^[CurFrame])>=TRES_MY) or
     (Left<TRES_LX) or ((Left+xsize^[CurFrame])>=TRES_MX) then
      exit;

  if not MapEMMMemory(Frames.Mem,Frames.Page^[CurFrame],
          Frames.Page^[CurFrame] + (FrameSize^[CurFrame]+Frames.Offs^[CurFrame]) shr 14) then
    Error('Error mapping memory for frame while drawing stinger');
  AbsMem := Ptr(SegEMMFrame,Frames.Offs^[CurFrame]);
  PutImage(Left,Top,AbsMem^,AndPut);

  Nose.x:=params.pos.x + xsize^[0]/2.1*cos(Angle/M_360_2PI);
  Nose.y:=params.pos.y + xsize^[0]/2.1*sin(Angle/M_360_2PI);
  x12:=Nose.x + 50*cos((Angle-dAngle)/M_360_2PI);
  y12:=Nose.y + 50*sin((Angle-dAngle)/M_360_2PI);

  x22:=Nose.x + 50*cos((Angle+dAngle)/M_360_2PI);
  y22:=Nose.y + 50*sin((Angle+dAngle)/M_360_2PI);

  SetColor(Black);
  Line(round(Nose.x),SIZE_Y-round(Nose.y),round(x12),SIZE_Y-round(y12));
  Line(round(Nose.x),SIZE_Y-round(Nose.y),round(x22),SIZE_Y-round(y22));
end;{tSting.Draw}
{----}
Destructor tSting.Done;
begin
  FreeEMM(Frames.Mem);

  FreeMem(Frames.Page,FramesCount*sizeof(word));
  FreeMem(Frames.Offs,FramesCount*sizeof(word));
  FreeMem(FrameSize,  FramesCount*sizeof(Word));
  FreeMem(xsize,      FramesCount*sizeof(Word));
  FreeMem(ysize,      FramesCount*sizeof(Word));
  Inherited Done;
end; {tSting.Done}
{-------------------------------------------------}
{  Third object - just explosion}
Constructor tExpl.Init;
var
  i : byte;
  F : FILE;
  cPage,cOffs : word;
  AbsMem      : Pointer;
begin
  Inherited Init;
  ObjType := 'EXPL';
  LifeTime := aLifeTime;

  Params.pos := aPos;
  ZOrder := zOrd;

  Assign(F,AnimDat);
  {$I-}
    Reset(F,1);
    If IOResult <> 0 then
      Error('Error opening animation library for exposion');
  {$I+}
  BlockRead(F,FramesCount,2);
  GetMem(Frames.Page,FramesCount*sizeof(Word));
  GetMem( Masks.Page,FramesCount*sizeof(Word));
  GetMem(Frames.Offs,FramesCount*sizeof(Word));
  GetMem( Masks.Offs,FramesCount*sizeof(Word));
  GetMem(xsize,      FramesCount*sizeof(Word));
  GetMem(ysize,      FramesCount*sizeof(Word));
  GetMem(FrameSize,  FramesCount*sizeof(Word));

  if not TestAllocEMM(FileSize(F)+1 shl 13) then
  begin
     CloseGraph;
     WriteLn('Sorry, not enough EMM memory, need ',FileSize(F)+1 shl 13,' get ',MaxEMM);
     Halt(255);
  end;

  if not AllocEMM(FileSize(F) shr 1+1 shl 13, Frames.Mem) then
    Error('Error allocating memory for explosion frames');

  if not AllocEMM(FileSize(F) shr 1+1 shl 13, Masks.Mem) then
    Error('Error allocating memory for explosion masks');

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

   if ((FrameSize^[i]+cOffs) shr 14) > 3 then begin inc(cPage); cOffs:=0; end;
   Frames.Page^[i]:=cPage;
   Frames.Offs^[i]:=cOffs;
   if not MapEMMMemory(Frames.Mem,cPage,cPage+(FrameSize^[i] + cOffs) shr 14) then
     Error('Error mapping memory for explosion''s frame while reading');
   AbsMem := Ptr(SegEMMFrame,cOffs);
   BlockRead(F,AbsMem^,FrameSize^[i]);

   Masks.Page^[i]:=cPage;
   Masks.Offs^[i]:=cOffs;
   if not MapEMMMemory(Masks.Mem,cPage,cPage+(FrameSize^[i] + cOffs) shr 14) then
     Error('Error mapping memory for explosion''s mask while reading');
   AbsMem := Ptr(SegEMMFrame,cOffs);
   BlockRead(F,AbsMem^,FrameSize^[i]);

   Inc(cOffs, FrameSize^[i]);
   Inc(cPage, cOffs shr 14);
   cOffs := cOffs and $3FFF;
  end;
  Close(F);

  CurFrame := 0;
end;{tExpl.Init}
{----}
Procedure tExpl.Frame;
begin
 if started then begin
    LocTime := LocTime + t;
    CurFrame := round((LocTime / LifeTime) * (FramesCount-1)) mod FramesCount;
    if LocTime >= LifeTime then World^.Gone(@Self);
 end;
end;{tRAH.Frame}
{----}
Procedure tExpl.Draw;
var
 Top,Left : word;
 AbsMem : pointer;
begin
  Left := round(Params.Pos.x-(xsize^[CurFrame] shr 1));
  Top  := SIZE_Y-round(Params.Pos.y+(ysize^[CurFrame] shr 1));

  if (Top<TRES_LY) or ((Top+ysize^[CurFrame])>=TRES_MY) or
     (Left<TRES_LX) or ((Left+xsize^[CurFrame])>=TRES_MX) then
      exit;

  if not MapEMMMemory(Masks.Mem,Masks.Page^[CurFrame],
          Masks.Page^[CurFrame] + (FrameSize^[CurFrame]+Masks.Offs^[CurFrame]) shr 14) then
    Error('Error mapping memory for explosion''s mask while drawing');
  AbsMem := Ptr(SegEMMFrame,Masks.Offs^[CurFrame]);
  PutImage(Left,Top,AbsMem^,AndPut);

  if not MapEMMMemory(Frames.Mem,Frames.Page^[CurFrame],
          Frames.Page^[CurFrame] +(FrameSize^[CurFrame] + Frames.Offs^[CurFrame]) shr 14) then
    Error('Error mapping memory for explosion''s frame while drawing');
  AbsMem := Ptr(SegEMMFrame,Frames.Offs^[CurFrame]);
  PutImage(Left,Top,AbsMem^,OrPut);
end;{tExpl.Draw}
{----}
Destructor tExpl.Done;
begin
  FreeEMM(Frames.Mem);
  FreeEMM( Masks.Mem);

  FreeMem(Frames.Page,FramesCount*sizeof(Word));
  FreeMem(Masks .Page,FramesCount*sizeof(Word));
  FreeMem(Frames.Offs,FramesCount*sizeof(Word));
  FreeMem(Masks .Offs,FramesCount*sizeof(Word));
  FreeMem(FrameSize,  FramesCount*sizeof(Word));
  FreeMem(xsize,      FramesCount*sizeof(Word));
  FreeMem(ysize,      FramesCount*sizeof(Word));

  Inherited Done;
end; {tExpl.Done}
{ Fourth object - Heat Trap }
Constructor  tTrap.Init(AnimDat:string;var aPos:vector; var aSpeed,aG : real; aAng:integer;zOrd:byte);
var
 F:file;
 i:integer;
begin
  Inherited Init;
  ObjType := 'HeatTrap';
  Flag := Flag + [HEAT];

  Params.Pos := aPos;
  Params.Accel.x:=0;
  Params.Accel.y:=-aG;
  Params.Speed.x := aSpeed * cos (aAng/M_360_2PI);
  Params.Speed.y := aSpeed * sin (aAng/M_360_2PI);
  ZOrder := zOrd;

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

  if (MaxAvail < FileSize(F)) then
  begin
     CloseGraph;
     WriteLn('Sorry, not enough conv memory, need ',FileSize(F),' get ',MaxAvail);
     Halt(255);
  end;

  for i := 0 to FramesCount-1 do
  begin
   BlockRead(F,FrameSize^[i],2);
   if MaxAvail < FrameSize^[i] then
    begin
     CloseGraph;
     WriteLn('Sorry, not enough memory, need ',FrameSize^[i],' get ',MaxAvail);
     Halt(255);
    end;
   GetMem(MFrames^[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,MFrames^[i]^,FrameSize^[i]);
  end;
  Close(F);
end;
{----------}
Function tTrap.Inside;
begin
 with params.pos do
 Inside := (sqr(aPos.x-x) + sqr(aPos.y-y)) <= sqr(xsize^[0] shr 1);
end;{tTrap.Inside}
{---------------------}
Procedure tTrap.Frame(t : longint);
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 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);
  end;
  LocTime := LocTime + t;
end;
Procedure tTrap.Draw;
var
 Top,Left : integer;
begin
  Left := round(Params.Pos.x-(xsize^[CurFrame] shr 1));
  Top  := SIZE_Y-round(Params.Pos.y+(ysize^[CurFrame] shr 1));
  if (Top<TRES_LY) or ((Top+ysize^[CurFrame])>=TRES_MY) or
     (Left<TRES_LX) or ((Left+xsize^[CurFrame])>=TRES_MX) then
      exit;
  PutImage(Left,Top,MFrames^[CurFrame]^,AndPut);
end;{tTrap.Draw}
{------------}
Destructor tTrap.Done;
var i : byte;
begin
  for i := 0 to FramesCount-1 do
    FreeMem(MFrames^[i],FrameSize^[i]);

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

  Inherited Done;
end;
{ ------  WOLRD OBJECT ( управляет всем ) --------}
Constructor TWorld.Init;
var
  F: FILE;
  k:byte;
  cPage,cOffs : word;
  AbsMem      : Pointer;
begin
  New(WObjects);         {Init Dummy Element in Objectlist}
  WObjects^.Next:=nil;
  WObjects^.O:=nil;
  MSG := '';

  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.Page, FrameCount*sizeof(Word));
     GetMem(Background.Offs, FrameCount*sizeof(Word));
     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));

    if not TestAllocEMM(FileSize(F)+1 shl 13) then
    begin
      CloseGraph;
      WriteLn('Sorry, not enough EMM memory, need ',FileSize(F)+1 shl 13,' get ',MaxEMM);
      Halt(255);
    end;

    if not AllocEMM(FileSize(F)+1 shl 13, BackGround.Mem) then
      Error('Error allocating memory for background');

    cPage:=0;
    cOffs:=0;
    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);

       if ((FrameSize^[k]+cOffs) shr 14) > 3 then
       begin
        inc(cPage);
        cOffs:=0;
       end;
       if not MapEMMMemory(Background.mem,cPage,cPage + (FrameSize^[k]+cOffs) shr 14) then
         Error('Error mapping memory for background');
       AbsMem := Ptr(SegEMMFrame,cOffs);
       BlockRead(F,AbsMem^,FrameSize^[k]);
       Background.Page^[k]:=cPage;
       background.offs^[k]:=cOffs;
       DrawSprite12H(xpos^[k],ypos^[k],xsize^[k],ysize^[k],CurPage,AbsMem);

       Inc(cOffs, FrameSize^[k]);
       Inc(cPage, cOffs shr 14);
       cOffs := cOffs and $3FFF;
      end;
      Close(F);
   end
  else
   begin
    BackGround.Page := nil;
    BackGround.Offs := nil;
   end;
end;{TWorld.Init}
{------}
Function TWorld.Radar(aSelf:PWorldObject;aFlg:FLAG_ENUM;var a0:integer;a1:integer;var aDist:real):PWorldObject;
var
 mo : PWorldObject;
 md,a,b : real;
 Ang : integer;
 aa  : integer;
 c  : PWOsList;
begin
  Radar := nil;
  if (aSelf = nil) or (WObjects^.next = nil) then exit;
  md := 1E30;
  mo := nil;
  c:=Wobjects^.next;
  while (c<>nil) do
  begin
   if (aFLG in c^.o^.flag) then
   begin
    a:=c^.o^.params.pos.x-aSelf^.params.pos.x;
    b:=c^.o^.params.pos.y-aSelf^.params.pos.y;
    {<Calc angle>}
     if abs(a) < 0.001 then
     begin
      if b > 0 then Ang := 90 else
       Ang := 270;
     end else
      Ang  := round(M_360_2PI*ArcTan(b/a));
     if Ang < 0 then Inc(Ang,360);
     if a < 0 then Inc(Ang, 180);
     if Ang >= 360 then Dec(Ang, 360);
    {</Calc angle>}
    Ang := aSelf^.Angle - Ang;
    if Ang > 180 then Ang := 360 - Ang;
    if Ang <-180 then Ang :=-360 - Ang;

    if (Ang>a0) and (Ang<a1) then
    begin
     if a*a+b*b < md then
      begin
        aa := ang;
        md := a*a+b*b;
        mo := c^.o;
      end;
    end;
   end;
   c:=c^.next;
  end;
  Radar := mo;
  a0 := aSelf^.Angle - aa;
  aDist := md;
end;{Radar}
{---------}
Procedure TWorld.Explosion(aPos:vector);
var
 aNew : PExpl;
begin
  New(aNew,Init('expls.dat',round((random(5)+5)/TIME_FACTOR),aPos,255));
  AddObject(aNew);
  aNew^.Started := true;
end;{TWorld.Explosion}
{---------}
Function TWorld.AddObject(aOb : PWorldObject):boolean;
var
 N,C : PWOsList;
begin
  New(N);
  N^.O := aOb;
  n^.Next:=NIL;
  aOb^.World := @Self;

  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.Message;
begin
 MSG := aS;
 MSGSize:=aSize;
 MSGColor:=aColor;
end;{TWorld.Message}
{----------------------------}
Procedure  TWorld.Draw;
var
 c : PWOsList;
 k : byte;
 AbsMem : pointer;
begin
 for k := 0 to FrameCount-1 do
 begin
  if not MapEMMMemory(Background.mem,background.page^[k],
                      background.page^[k] + (FrameSize^[k]+background.offs^[k]) shr 14) then
   Error('Wrror mappinf memory for background while drawing');
  AbsMem := Ptr(SegEMMFrame,background.offs^[k]);
  DrawSprite12H(xpos^[k],ypos^[k],xsize^[k],ysize^[k],1-CurPage,AbsMem);
 end;

 If MSG <> '' then
 begin
   setColor(MSGColor);
   SetTextStyle(DefaultFont, HorizDir, MSGSize);
   SetTextJustify(CENTERTEXT,BOTTOMTEXT);
   OutTextXY(TRES_MX shr 1, TRES_MY,MSG);
 end;

 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}
{----------------------------}
{----------------------------}
Procedure  TWorld.StartObjects;
var
 c : PWOsList;
begin
 c:=WObjects^.Next;
 while c <> nil do
  begin
    if CAN_DRAW IN C^.O^.Flag then
      if c^.o^.ObjType = aT then PDrawable(C^.O)^.Started := true;
    C:=C^.next;
  end;
end;{TWorld.Draw}
{----------------------------}
Destructor TWorld.Done;
var
 g:PWOsList;
 i:byte;
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.Page <> nil then
  begin
    FreeEMM(Background.mem);
    FreeMem(Background.Page,FrameCount*sizeof(Word));
    FreeMem(Background.Offs,FrameCount*sizeof(word));
    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.