{$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_MY) or (Left=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.XTRES_LY) and (Pos.YTRES_MX) and ((Speed.X>0) or (Accel.X>0))) or ((Pos.xTRES_MY) and ((Speed.Y>0) or (Accel.Y>0))) or ((Pos.y=TRES_MY) or (Left=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_MY) or (Left=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.XTRES_LY) and (Pos.YTRES_MX) and ((Speed.X>0) or (Accel.X>0))) or ((Pos.xTRES_MY) and ((Speed.Y>0) or (Accel.Y>0))) or ((Pos.y=TRES_MY) or (Left=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; {} 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); {} Ang := aSelf^.Angle - Ang; if Ang > 180 then Ang := 360 - Ang; if Ang <-180 then Ang :=-360 - Ang; if (Ang>a0) and (Ang 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.