{$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_MY) or (Left=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.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 8; repeat until (Port[$03DA] and 8) = 8;} PutImage(BgX,BgY,BackGround^,NormalPut); if (Top=TRES_MY) or (Left=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.