Changeset 3 for trunk/UCore.pas


Ignore:
Timestamp:
Mar 6, 2011, 12:13:35 PM (13 years ago)
Author:
george
Message:
  • Added: Drawing of tanks in eight directions.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/UCore.pas

    r2 r3  
    11unit UCore;
    22
    3 {$mode objfpc}{$H+}
     3{$mode Delphi}{$H+}
    44
    55interface
    66
    77uses
    8   Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix;
     8  Dialogs, Classes, SysUtils, Contnrs, Graphics, SpecializedMatrix, SpecializedList;
    99
    1010type
    1111  TEngine = class;
    1212
    13   TSurfaceMatter = (smNothing, smDirt1, smDirt2, smRock1, smRock2, smHouse1, smHouse2);
     13  TSurfaceMatter = (smNothing, smDirt1, smDirt2, smRock,
     14    smPlayer1H, smPlayer1L, smPlayer2H, smPlayer2L, smCannon, smBullet);
    1415
    1516  TPlayerKeys = record
     
    2122  end;
    2223
     24  { TTank }
     25
     26  TTank = class
     27    Image: TMatrixByte;
     28    Mask: TMatrixByte;
     29    constructor Create;
     30    destructor Destroy; override;
     31  end;
     32
    2333  { TPlayer }
    2434
    2535  TPlayer = class
     36  private
     37    function ShowTankProc(Item1, Item2: Byte): Byte;
     38    function HideTankProc(Item1, Item2: Byte): Byte;
     39  public
     40    Id: Integer;
    2641    Engine: TEngine;
    27     Color: TColor;
    2842    Position: TPoint;
     43    Direction: Integer;
    2944    ScreenFrame: TRect;
    3045    Name: string;
    3146    Keys: TPlayerKeys;
     47    Tanks: TListObject;
    3248    procedure Control;
    3349    procedure Paint;
     50    procedure PlaceHouse;
     51    function CheckColision: Boolean;
     52    procedure ShowTank;
     53    procedure HideTank;
     54    procedure InitTanks;
     55    constructor Create;
     56    destructor Destroy; override;
    3457  end;
    3558
     
    5477  private
    5578    FBitmap: TBitmap;
     79    FRedrawPending: Boolean;
    5680    function GetPlayerCount: Integer;
    5781    procedure SetBitmap(const AValue: TBitmap);
    5882    procedure SetPlayerCount(const AValue: Integer);
     83    procedure Redraw;
    5984  public
    6085    KeyState: array[0..High(Word)] of Boolean;
     
    6489    destructor Destroy; override;
    6590    procedure ResizePlayerFrames;
    66     procedure Paint;
     91    procedure Tick;
    6792    property PlayerCount: Integer read GetPlayerCount write SetPlayerCount;
    6893    property Bitmap: TBitmap read FBitmap write SetBitmap;
     94    procedure NewGame;
    6995  end;
    7096
    7197const
    72   SurfaceMatterColors: array[TSurfaceMatter] of TColor = (clBlack, $0756b0, $2170c3, clGray, clGray + $808080, clGreen, clBlue);
     98  SurfaceMatterColors: array[TSurfaceMatter] of TColor = (clBlack, $0756b0,
     99    $2170c3, TColor($9a9a9a), TColor($00ff00), TColor($00a000),
     100    TColor($ff2c2c), TColor($b60000), clYellow, clRed);
    73101
    74102var
     
    76104
    77105implementation
     106
     107{ TTank }
     108
     109constructor TTank.Create;
     110begin
     111  Mask := TMatrixByte.Create;
     112  Image := TMatrixByte.Create;
     113end;
     114
     115destructor TTank.Destroy;
     116begin
     117  Mask.Free;
     118  Image.Free;
     119  inherited Destroy;
     120end;
    78121
    79122{ TWorld }
     
    97140    for X := 0 to Surface.Count.X - 1 do begin
    98141      if Random < 0.5 then
    99         Surface[Y, X] := Byte(smDirt1) else
    100         Surface[Y, X] := Byte(smDirt2);
     142        Surface.ItemsXY[Y, X] := Byte(smDirt1) else
     143        Surface.ItemsXY[Y, X] := Byte(smDirt2);
    101144    end;
    102145end;
     
    107150begin
    108151  Surface := TMatrixByte.Create;
    109   NewSize.X := 5000;
    110   NewSize.Y := 500;
     152  NewSize.X := 100;
     153  NewSize.Y := 100;
    111154  Size := NewSize;
    112155end;
     
    121164
    122165procedure TPlayer.Control;
    123 begin
    124   if Engine.KeyState[Ord(Keys.Up)] then Position.Y := Position.Y + 1;
    125   if Engine.KeyState[Ord(Keys.Down)] then Position.Y := Position.Y - 1;
    126   if Engine.KeyState[Ord(Keys.Right)] then Position.X := Position.X + 1;
    127   if Engine.KeyState[Ord(Keys.Left)] then Position.X := Position.X - 1;
     166var
     167  NewPosition: TPoint;
     168  NewDirection: Integer;
     169  Delta: TPoint;
     170begin
     171  Delta.X := 0;
     172  Delta.Y := 0;
     173  if Engine.KeyState[Ord(Keys.Up)] then Delta.Y := Delta.Y + 1;
     174  if Engine.KeyState[Ord(Keys.Down)] then Delta.Y := Delta.Y - 1;
     175  if Engine.KeyState[Ord(Keys.Right)] then Delta.X := Delta.X + 1;
     176  if Engine.KeyState[Ord(Keys.Left)] then Delta.X := Delta.X - 1;
     177
     178  NewDirection := Direction;
     179  if (Delta.X <> 0) or (Delta.Y <> 0) then begin
     180    if (Delta.X = 0) and (Delta.Y = -1) then NewDirection := 0
     181    else if (Delta.X = 1) and (Delta.Y = -1) then NewDirection := 1
     182    else if (Delta.X = 1) and (Delta.Y = 0) then NewDirection := 2
     183    else if (Delta.X = 1) and (Delta.Y = 1) then NewDirection := 3
     184    else if (Delta.X = 0) and (Delta.Y = 1) then NewDirection := 4
     185    else if (Delta.X = -1) and (Delta.Y = 1) then NewDirection := 5
     186    else if (Delta.X = -1) and (Delta.Y = 0) then NewDirection := 6
     187    else if (Delta.X = -1) and (Delta.Y = -1) then NewDirection := 7;
     188  end;
     189
     190  NewPosition := Point(Position.X + Delta.X, Position.Y + Delta.Y);
     191  if CheckColision then begin
     192    HideTank;
     193    Position := NewPosition;
     194    Direction := NewDirection;
     195    ShowTank;
     196    Engine.Redraw;
     197  end;
    128198end;
    129199
     
    136206    Rectangle(ScreenFrame);
    137207    //FillRect(ScreenFrame);
     208
    138209
    139210    with Engine.World do
     
    143214        YY := Y - ScreenFrame.Top - ((ScreenFrame.Bottom - ScreenFrame.Top) div 2) + Position.Y;
    144215        if (YY >= 0) and (YY < Surface.Count.Y) and (XX >= 0) and (XX < Surface.Count.X) then
    145           Pixels[X, Y] := SurfaceMatterColors[TSurfaceMatter(Surface[YY, XX])];
     216          Pixels[X, Y] := SurfaceMatterColors[TSurfaceMatter(Surface.ItemsXY[YY, XX])];
    146217      end;
     218
    147219    (*CopyRect(ScreenFrame, Engine.World.Surface.Canvas,
    148220    Rect(
     
    157229end;
    158230
     231procedure TPlayer.PlaceHouse;
     232const
     233  HouseSize = 30;
     234  DoorSize = 8;
     235var
     236  X, Y: Integer;
     237  Matter: Byte;
     238begin
     239  for Y := 0 to HouseSize - 1 do
     240    for X := 0 to HouseSize - 1 do begin
     241      if ((Y = 0) or (Y = (HouseSize - 1)) or (X = 0) or (X = (HouseSize - 1))) and
     242      not (((Y = 0) or (Y = (HouseSize - 1))) and (X > ((HouseSize - DoorSize) div 2)) and
     243      (X < ((HouseSize - 1 + DoorSize) div 2)))
     244      then Matter := Byte(smPlayer1H) + Id * 2
     245        else Matter := Byte(smNothing);
     246      Engine.World.Surface.ItemsXY[Position.Y - HouseSize div 2 + Y, Position.X - HouseSize div 2 + X] := Matter;
     247    end;
     248end;
     249
     250function TPlayer.CheckColision: Boolean;
     251begin
     252
     253end;
     254
     255function TPlayer.ShowTankProc(Item1, Item2: Byte): Byte;
     256begin
     257  if Item2 > 0 then Result := Item2 else Result := Item1;
     258end;
     259
     260procedure TPlayer.ShowTank;
     261begin
     262  with Engine.World do begin
     263    Surface.Merge(TMatrixByte.Point(Position.X, Position.Y), TTank(Tanks[Direction]).Image, ShowTankProc);
     264  end;
     265end;
     266
     267function TPlayer.HideTankProc(Item1, Item2: Byte): Byte;
     268begin
     269  if Item2 > 0 then Result := 0 else Result := Item1;
     270end;
     271
     272procedure TPlayer.HideTank;
     273begin
     274  with Engine.World do begin
     275    Surface.Merge(TMatrixByte.Point(Position.X, Position.Y), TTank(Tanks[Direction]).Image, HideTankProc);
     276  end;
     277end;
     278
     279procedure TPlayer.InitTanks;
     280var
     281  NewTank: TTank;
     282  I: Integer;
     283  X, Y: Integer;
     284begin
     285  Tanks.Clear;
     286
     287  NewTank := TTank.Create;
     288  with NewTank do begin
     289    Image.Count := TMatrixByte.Point(7, 7);
     290    for I := 0 to 3 do
     291      Image[I, 3] := Byte(smCannon);
     292    for I := 1 to 6 do begin
     293      Image[I, 1] := Byte(smPlayer1H) + Id * 2;
     294      Image[I, 5] := Byte(smPlayer1H) + Id * 2;
     295    end;
     296    for I := 2 to 5 do begin
     297      Image[I, 2] := Byte(smPlayer1H) + Id * 2 + 1;
     298      Image[I, 4] := Byte(smPlayer1H) + Id * 2 + 1;
     299    end;
     300    Image[4, 3] := Byte(smPlayer1H) + Id * 2 + 1;
     301    Image[5, 3] := Byte(smPlayer1H) + Id * 2 + 1;
     302  end;
     303  Tanks.Add(NewTank);
     304
     305  NewTank := TTank.Create;
     306  with NewTank do begin
     307    Image.Count := TMatrixByte.Point(7, 7);
     308    for I := 0 to 2 do
     309      Image[3 - I, 3 + I] := Byte(smCannon);
     310    for I := 0 to 3 do begin
     311      Image[3 - I, I] := Byte(smPlayer1H) + Id * 2;
     312      Image[6 - I, 3 + I] := Byte(smPlayer1H) + Id * 2;
     313    end;
     314    for I := 0 to 2 do begin
     315      Image[3 - I, 1 + I] := Byte(smPlayer1H) + Id * 2 + 1;
     316      Image[5 - I, 3 + I] := Byte(smPlayer1H) + Id * 2 + 1;
     317    end;
     318    Image[2, 3] := Byte(smPlayer1H) + Id * 2 + 1;
     319    Image[3, 2] := Byte(smPlayer1H) + Id * 2 + 1;
     320    Image[4, 2] := Byte(smPlayer1H) + Id * 2 + 1;
     321    Image[4, 3] := Byte(smPlayer1H) + Id * 2 + 1;
     322    Image[3, 4] := Byte(smPlayer1H) + Id * 2 + 1;
     323  end;
     324  Tanks.Add(NewTank);
     325
     326  NewTank := TTank.Create;
     327  NewTank.Image.Assign(TTank(Tanks[0]).Image);
     328  NewTank.Image.Reverse;
     329  NewTank.Image.ReverseHorizontal;
     330  Tanks.Add(NewTank);
     331
     332  NewTank := TTank.Create;
     333  NewTank.Image.Assign(TTank(Tanks[1]).Image);
     334  NewTank.Image.ReverseVertical;
     335  Tanks.Add(NewTank);
     336
     337  NewTank := TTank.Create;
     338  NewTank.Image.Assign(TTank(Tanks[0]).Image);
     339  NewTank.Image.ReverseVertical;
     340  Tanks.Add(NewTank);
     341
     342  NewTank := TTank.Create;
     343  NewTank.Image.Assign(TTank(Tanks[1]).Image);
     344  NewTank.Image.ReverseVertical;
     345  NewTank.Image.ReverseHorizontal;
     346  Tanks.Add(NewTank);
     347
     348  NewTank := TTank.Create;
     349  NewTank.Image.Assign(TTank(Tanks[0]).Image);
     350  NewTank.Image.Reverse;
     351  Tanks.Add(NewTank);
     352
     353  NewTank := TTank.Create;
     354  NewTank.Image.Assign(TTank(Tanks[1]).Image);
     355  NewTank.Image.ReverseHorizontal;
     356  Tanks.Add(NewTank);
     357
     358  for I := 0 to Tanks.Count - 1 do
     359  with TTank(Tanks[I]) do begin
     360    Mask.Assign(Image);
     361    for Y := 0 to Mask.Count.Y - 1 do
     362    for X := 0 to Mask.Count.X - 1 do
     363      if Mask.ItemsXY[X, Y] > 0 then Mask.ItemsXY[X, Y] := 1;
     364  end;
     365end;
     366
     367constructor TPlayer.Create;
     368begin
     369  Tanks := TListObject.Create;
     370end;
     371
     372destructor TPlayer.Destroy;
     373begin
     374  Tanks.Free;
     375  inherited Destroy;
     376end;
     377
    159378{ TEngine }
    160379
     
    179398      NewPlayer := TPlayer.Create;
    180399      NewPlayer.Engine := Self;
     400      NewPlayer.Id := I;
    181401      NewPlayer.Name := 'Player ' + IntToStr(I);
     402      NewPlayer.InitTanks;
    182403      Players.Add(NewPlayer);
    183404    end;
     
    188409  end;
    189410  ResizePlayerFrames;
     411end;
     412
     413procedure TEngine.Redraw;
     414begin
     415  FRedrawPending := True;
    190416end;
    191417
     
    224450end;
    225451
    226 procedure TEngine.Paint;
     452procedure TEngine.Tick;
    227453var
    228454  I: Integer;
    229455begin
    230   if Assigned(Bitmap) then begin
    231     Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
    232     for I := 0 to Players.Count - 1 do begin
    233       TPlayer(Players[I]).Control;
    234       TPlayer(Players[I]).Paint;
    235     end;
     456  for I := 0 to Players.Count - 1 do begin
     457    TPlayer(Players[I]).Control;
     458  end;
     459
     460  if FRedrawPending then begin
     461    if Assigned(Bitmap) then begin
     462      Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
     463      for I := 0 to Players.Count - 1 do begin
     464        TPlayer(Players[I]).Control;
     465        TPlayer(Players[I]).Paint;
     466      end;
     467    end;
     468    FRedrawPending := False;
     469  end;
     470end;
     471
     472procedure TEngine.NewGame;
     473var
     474  I: Integer;
     475  I2: Integer;
     476begin
     477  World.Generate;
     478
     479  for I := 0 to Players.Count - 1 do
     480  with TPlayer(Players[I]) do
     481  begin
     482    // Reset position
     483    Position := Point(25 + Random(World.Surface.Count.X - 50),
     484      25 + Random(World.Surface.Count.Y - 50));
     485
     486    PlaceHouse;
    236487  end;
    237488end;
Note: See TracChangeset for help on using the changeset viewer.