Changeset 61 for trunk


Ignore:
Timestamp:
Dec 25, 2022, 10:44:53 PM (2 years ago)
Author:
chronos
Message:
  • Fixed: Do not regenerate world on new round. Correctly reset players tanks position and state.
  • Added: Main menu statistics half screen section.
Location:
trunk
Files:
3 added
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.pas

    r59 r61  
    104104    Drawing := False;
    105105  end;
     106  if Engine.ThreadErrorMessage <> '' then begin
     107    ShowMessage(Engine.ThreadErrorMessage);
     108    Engine.ThreadErrorMessage := '';
     109  end;
    106110end;
    107111

  • trunk/Languages/Tunneler.cs.po

    r60 r61  
    162162
    163163#: uengine.sexit
    164 msgid "exit"
    165 msgstr "odejít"
     164msgctxt "uengine.sexit"
     165msgid "Exit"
     166msgstr "Odejít"
    166167
    167168#: uengine.sinformation
    168 msgid "information"
    169 msgstr "informace"
     169msgid "Information"
     170msgstr "Informace"
    170171
    171172#: uengine.sinstructions
    172 msgid "instructions"
    173 msgstr "instrukce"
     173msgid "Instructions"
     174msgstr "Instrukce"
    174175
    175176#: uengine.splayer
    … …  
    186187msgstr "Kolo"
    187188
     189#: uengine.sshotsfired
     190msgid "Shot fired"
     191msgstr "Střel vystřeleno"
     192
    188193#: uengine.sstartgame
    189 msgid "start game"
    190 msgstr "spustit hru"
     194msgid "Start game"
     195msgstr "Spustit hru"
     196
     197#: uengine.sstatistics
     198msgid "Statistics"
     199msgstr "Statistika"
     200
     201#: uengine.swinneris
     202msgid "The winner is"
     203msgstr "Vítězem je"
    191204
    192205#: uengine.sworldready
    193 msgid "world ready"
    194 msgstr "svět připraven"
     206msgid "World ready"
     207msgstr "Svět připraven"
    195208
    196209#: uformmain.sround

  • trunk/Languages/Tunneler.pot

    r60 r61  
    1515
    1616#: tformmain.aexit.caption
     17msgctxt "tformmain.aexit.caption"
    1718msgid "Exit"
    1819msgstr ""
    … …  
    125126
    126127#: uengine.sexit
    127 msgid "exit"
     128msgctxt "uengine.sexit"
     129msgid "Exit"
    128130msgstr ""
    129131
    130132#: uengine.sinformation
    131 msgid "information"
     133msgid "Information"
    132134msgstr ""
    133135
    134136#: uengine.sinstructions
    135 msgid "instructions"
     137msgid "Instructions"
    136138msgstr ""
    137139
    … …  
    148150msgstr ""
    149151
     152#: uengine.sshotsfired
     153msgid "Shot fired"
     154msgstr ""
     155
    150156#: uengine.sstartgame
    151 msgid "start game"
     157msgid "Start game"
     158msgstr ""
     159
     160#: uengine.sstatistics
     161msgid "Statistics"
     162msgstr ""
     163
     164#: uengine.swinneris
     165msgid "The winner is"
    152166msgstr ""
    153167
    154168#: uengine.sworldready
    155 msgid "world ready"
     169msgid "World ready"
    156170msgstr ""
    157171

  • trunk/UEngine.pas

    r60 r61  
    77  IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle,
    88  Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, XMLConf, DOM,
    9   Generics.Collections;
     9  Generics.Collections, UWorld, UMatter;
    1010
    1111const
    … …  
    3232  clTuna = $5555ff;
    3333  clPurple = $aa00aa;
     34  clOrange = $0055aa;
    3435  clDarkOrange = $0000aa;
    3536  clDarkGreen = $00aa00;
     37  clCyan = $ffff00;
    3638
    3739type
    … …  
    8183    procedure Assign(Source: TTanks);
    8284  end;
    83 
    84   TMatterIndex = (miSpace, miDirt1, miDirt2, miRock, miBullet1, miBullet2, miBorder,
    85     miPlayer1Cannon, miPlayer1Home, miPlayer1TankBody, miPlayer1TankBody2,
    86     miPlayer2Cannon, miPlayer2Home, miPlayer2TankBody, miPlayer2TankBody2,
    87     miPlayer3Cannon, miPlayer3Home, miPlayer3TankBody, miPlayer3TankBody2,
    88     miPlayer4Cannon, miPlayer4Home, miPlayer4TankBody, miPlayer4TankBody2,
    89     miPlayer5Cannon, miPlayer5Home, miPlayer5TankBody, miPlayer5TankBody2,
    90     miPlayer6Cannon, miPlayer6Home, miPlayer6TankBody, miPlayer6TankBody2,
    91     miPlayer7Cannon, miPlayer7Home, miPlayer7TankBody, miPlayer7TankBody2,
    92     miPlayer8Cannon, miPlayer8Home, miPlayer8TankBody, miPlayer8TankBody2);
    93 
    94   TMatterKind = (mkSpace, mkDirt, mkRock, mkBullet, mkTankBody,
    95     mkHome, mkBorder);
    9685
    9786  TColisionState = record
    … …  
    116105    function DigProc(Item1, Item2: Byte): Byte;
    117106  public
     107    Name: string;
    118108    Color1: TColor;
    119109    Color2: TColor;
    … …  
    122112    Engine: TEngine;
    123113    Position: TPoint;
     114    StartPosition: TPoint;
    124115    Score: Integer;
    125116    Direction: Integer;
    126117    ScreenFrame: TRectangle;
    127     Name: string;
    128118    Keys: TPlayerKeys;
    129119    Tanks: TTanks;
    … …  
    137127    LastShield: Real;
    138128    House: TRectangle;
     129    ShootCount: Integer;
     130    procedure ResetTank;
    139131    procedure Init;
    140132    procedure Explosion(Position: TPoint; Distance: Integer);
    … …  
    165157    procedure SaveConfig(Config: TXMLConfig; Path: string);
    166158    function GetAliveCount: Integer;
    167   end;
    168 
    169   { TMatter }
    170 
    171   TMatter = class
    172     Kind: TMatterKind;
    173     Player: Integer;
    174     Color: TColor;
    175     Diggable: Boolean;
    176     Blocking: Boolean;
    177   end;
    178 
    179   { TMatters }
    180 
    181   TMatters = class(TObjectList<TMatter>)
    182     function AddNew: TMatter;
    183   end;
    184 
    185   { TWorld }
    186 
    187   TWorld = class
    188   private
    189     function GetSize: TMatrixByteIndex;
    190     procedure SetSize(const AValue: TMatrixByteIndex);
    191     procedure InitMatter;
    192   public
    193     Engine: TEngine;
    194     Surface: TMatrixByte;
    195     Matters: TMatters;
    196     procedure Generate;
    197     constructor Create;
    198     destructor Destroy; override;
    199     procedure DrawToBitmap(Bitmap: TBitmap);
    200     property Size: TMatrixByteIndex read GetSize write SetSize;
     159    function GetWinner: TPlayer;
    201160  end;
    202161
    … …  
    243202    FState: TGameState;
    244203    FSystemThread: TSystemThread;
    245     ClearBackground: Boolean;
     204    FClearBackground: Boolean;
    246205    FStateTime: TDateTime;
     206    FShowMenuStats: Boolean;
    247207    procedure InitDigMasks;
    248208    procedure SetActive(const AValue: Boolean);
    … …  
    254214    procedure CheckGameEnd;
    255215    procedure DrawMenu;
     216    procedure DrawStats;
    256217    procedure DrawGamePrepare(Thread: TVirtualThread);
    257218    procedure DrawGame;
    … …  
    262223    procedure SetState(AValue: TGameState);
    263224  public
     225    ThreadErrorMessage: string;
    264226    Keyboard: TKeyboard;
    265227    World: TWorld;
    … …  
    291253  end;
    292254
    293   TFastBitmapPixelComponents = packed record
    294     B, G, R, A: Byte;
    295   end;
    296 
    297255const
    298256  DirectionToDelta: array[0..7] of TPoint =
    … …  
    300258    (X: 0; Y: 1), (X: -1; Y: 1), (X: -1; Y: 0), (X: -1; Y: -1));
    301259
    302 function SwapBRComponent(Value: Cardinal): Cardinal; inline;
    303 
    304260
    305261implementation
    306262
    307263uses
    308   UPlatform;
     264  UPlatform, UFastPixel;
    309265
    310266resourcestring
    … …  
    312268  SRound = 'Round';
    313269  SPressEsc = 'Press ESC to continue';
    314   SStartGame = 'start game';
    315   SInstructions = 'instructions';
    316   SInformation = 'information';
    317   SWorldReady = 'world ready';
    318   SExit = 'exit';
    319 
    320 function SwapBRComponent(Value: Cardinal): Cardinal; inline;
    321 begin
    322 //  Result := (Value and $00ff00) or ((Value shr 16) and $ff) or ((Value and $ff) shl 16);
    323   Result := Value;
    324   TFastBitmapPixelComponents(Result).R := TFastBitmapPixelComponents(Value).B;
    325   TFastBitmapPixelComponents(Result).B := TFastBitmapPixelComponents(Value).R;
    326 end;
    327 
    328 { TMatters }
    329 
    330 function TMatters.AddNew: TMatter;
    331 begin
    332   Result := TMatter.Create;
    333   Add(Result);
    334 end;
     270  SStartGame = 'Start game';
     271  SInstructions = 'Instructions';
     272  SInformation = 'Information';
     273  SWorldReady = 'World ready';
     274  SExit = 'Exit';
     275  SStatistics = 'Statistics';
     276  SShotsFired = 'Shot fired';
     277  SWinnerIs = 'The winner is';
    335278
    336279{ TTanks }
    … …  
    383326  with Items[I] do
    384327    if not Exploded then Inc(Result);
     328end;
     329
     330function TPlayers.GetWinner: TPlayer;
     331var
     332  I: Integer;
     333  TopScore: Integer;
     334begin
     335  Result := nil;
     336  TopScore := 0;
     337  for I := 0 to Count - 1 do
     338  with Items[I] do
     339  if Enabled and (Score > TopScore) then begin
     340    TopScore := Score;
     341    Result := Items[I];
     342  end;
    385343end;
    386344
    … …  
    404362procedure TSystemThread.Execute;
    405363begin
    406   repeat
    407     Engine.Tick;
    408     Sleep(10);
    409   until Terminated;
     364  try
     365    repeat
     366      Engine.Tick;
     367      Sleep(10);
     368    until Terminated;
     369  except
     370    on E: Exception do
     371      Engine.ThreadErrorMessage := E.Message;
     372  end;
    410373end;
    411374
    … …  
    429392procedure TDrawThread.Execute;
    430393begin
    431   repeat
    432     Engine.DrawThread(Self);
    433     if not Terminated then Synchronize(DrawSync);
    434     Sleep(50);
    435   until Terminated;
     394  try
     395    repeat
     396      Engine.DrawThread(Self);
     397      if not Terminated then Synchronize(DrawSync);
     398      Sleep(50);
     399    until Terminated;
     400  except
     401    on E: Exception do
     402      Engine.ThreadErrorMessage := E.Message;
     403  end;
    436404end;
    437405
    … …  
    473441  FreeAndNil(Image);
    474442  inherited;
    475 end;
    476 
    477 { TWorld }
    478 
    479 function TWorld.GetSize: TMatrixByteIndex;
    480 begin
    481   Result := Surface.Count;
    482 end;
    483 
    484 procedure TWorld.SetSize(const AValue: TMatrixByteIndex);
    485 begin
    486   Surface.Count := AValue;
    487   Generate;
    488 end;
    489 
    490 procedure TWorld.InitMatter;
    491 var
    492   I: Integer;
    493 begin
    494   // Space
    495   with Matters.AddNew do begin
    496     Kind := mkSpace;
    497     Color := clBlack;
    498     Player := -1;
    499   end;
    500   // Dirt1
    501   with Matters.AddNew do begin
    502     Kind := mkDirt;
    503     Color := $0756b0;
    504     Player := -1;
    505     Diggable := True;
    506   end;
    507   // Dirt2
    508   with Matters.AddNew do begin
    509     Kind := mkDirt;
    510     Color := $2170c3;
    511     Player := -1;
    512     Diggable := True;
    513   end;
    514   // Rock
    515   with Matters.AddNew do begin
    516     Kind := mkRock;
    517     Color := TColor($9a9a9a);
    518     Player := -1;
    519     Blocking := True;
    520   end;
    521   // Bullet1
    522   with Matters.AddNew do begin
    523     Kind := mkBullet;
    524     Color := clRed;
    525     Player := -1;
    526   end;
    527   // Bullet2
    528   with Matters.AddNew do begin
    529     Kind := mkBullet;
    530     Color := clRed;
    531     Player := -1;
    532   end;
    533   // Border
    534   with Matters.AddNew do begin
    535     Kind := mkBorder;
    536     Color := clNavy;
    537     Player := -1;
    538   end;
    539 
    540   for I := 0 to 7 do begin
    541     // Player cannon
    542     with Matters.AddNew do begin
    543       Kind := mkTankBody;
    544       Player := I;
    545       Blocking := True;
    546     end;
    547     // Player home
    548     with Matters.AddNew do begin
    549       Kind := mkHome;
    550       Player := I;
    551       Blocking := True;
    552     end;
    553     // Player body1
    554     with Matters.AddNew do begin
    555       Kind := mkTankBody;
    556       Player := I;
    557       Blocking := True;
    558     end;
    559     // Player body2
    560     with Matters.AddNew do begin
    561       Kind := mkTankBody;
    562       Player := I;
    563       Blocking := True;
    564     end;
    565   end;
    566 end;
    567 
    568 procedure TWorld.Generate;
    569 var
    570   X, Y: Integer;
    571   Distance: Double;
    572   Delta: Double;
    573 begin
    574   for Y := 0 to Surface.Count.Y - 1 do
    575     for X := 0 to Surface.Count.X - 1 do begin
    576       if Random < 0.5 then
    577         Surface.ItemsXY[X, Y] := Byte(miDirt1) else
    578         Surface.ItemsXY[X, Y] := Byte(miDirt2);
    579     end;
    580 
    581   Distance := 0.1 * Surface.Count.X;
    582   Delta := 0;
    583   for Y := 0 to Surface.Count.Y - 1 do begin
    584     for X := 0 to Round(Distance) - 1 do begin
    585       Surface.ItemsXY[X, Y] := Byte(miRock);
    586     end;
    587     Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);
    588     Distance := Distance + Delta;
    589   end;
    590 
    591   Distance := 0.1 * Surface.Count.X;
    592   Delta := 0;
    593   for Y := 0 to Surface.Count.Y - 1 do begin
    594     for X := 0 to Round(Distance) - 1 do begin
    595       Surface.ItemsXY[Surface.Count.X - 1 - X, Y] := Byte(miRock);
    596     end;
    597     Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.X) * 2 - 1);
    598     Distance := Distance + Delta;
    599   end;
    600 
    601   Distance := 0.1 * Surface.Count.Y;
    602   Delta := 0;
    603   for X := 0 to Surface.Count.X - 1 do begin
    604     for Y := 0 to Round(Distance) - 1 do begin
    605       Surface.ItemsXY[X, Y] := Byte(miRock);
    606     end;
    607     Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);
    608     Distance := Distance + Delta;
    609   end;
    610 
    611   Distance := 0.1 * Surface.Count.Y;
    612   Delta := 0;
    613   for X := 0 to Surface.Count.X - 1 do begin
    614     for Y := 0 to Round(Distance) - 1 do begin
    615       Surface.ItemsXY[X, Surface.Count.Y - 1 - Y] := Byte(miRock);
    616     end;
    617     Delta := (Random * 2 - 1) * 3 - (Distance / (0.1 * Surface.Count.Y) * 2 - 1);
    618     Distance := Distance + Delta;
    619   end;
    620 end;
    621 
    622 constructor TWorld.Create;
    623 var
    624   NewSize: TMatrixByteIndex;
    625 begin
    626   Matters := TMatters.Create;
    627   InitMatter;
    628   Surface := TMatrixByte.Create;
    629   NewSize.X := 800;
    630   NewSize.Y := 300;
    631   Size := NewSize;
    632 end;
    633 
    634 destructor TWorld.Destroy;
    635 begin
    636   FreeAndNil(Surface);
    637   FreeAndNil(Matters);
    638   inherited;
    639 end;
    640 
    641 procedure TWorld.DrawToBitmap(Bitmap: TBitmap);
    642 var
    643   X, Y: Integer;
    644   PixelPtr: PInteger;
    645   PixelRowPtr: PInteger;
    646   RawImage: TRawImage;
    647   BytePerPixel: Integer;
    648   P: Integer;
    649 begin
    650   Bitmap.BeginUpdate;
    651   try
    652     RawImage := Bitmap.RawImage;
    653     PixelRowPtr := PInteger(RawImage.Data);
    654     BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    655     for Y := 0 to Bitmap.Height - 1 do begin
    656       PixelPtr := PixelRowPtr;
    657       for X := 0 to Bitmap.Width - 1 do begin
    658         P := Matters[Surface.ItemsXY[Trunc(X / Bitmap.Width * Surface.Count.X),
    659             Trunc(Y / Bitmap.Height * Surface.Count.Y)]].Color;
    660         PixelPtr^ := SwapBRComponent(P);
    661         Inc(PByte(PixelPtr), BytePerPixel);
    662       end;
    663       Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
    664     end;
    665   finally
    666     Bitmap.EndUpdate;
    667   end;
    668443end;
    669444
    … …  
    712487    if (Bullets.Count < MaxBulletCount) and
    713488    ((Now - LastShootTime) > ShootDelay * OneSecond) then begin
     489      Inc(ShootCount);
    714490      NewBullet := TBullet.Create;
    715491      NewBullet.Player := Self;
    … …  
    797573  if ExplosionPending and (SecondOf(Now - ExplosionTime) > ExplosionDelay) then begin
    798574    ExplosionPending := False;
    799     Synchronize(Engine.CheckGameEnd);
     575    Engine.CheckGameEnd;
    800576  end;
    801577  if LastEnergy <> Energy then begin
    … …  
    882658  end;
    883659
    884   if not Exploded then ShowTank;
     660  if (Engine.State = gsGame) and not Exploded then ShowTank;
    885661end;
    886662
    … …  
    973749  if FExploded = AValue then Exit;
    974750  FExploded := AValue;
    975   if FExploded then HideTank else ShowTank;
    976   Energy := 0;
    977   Shield := 0;
     751  if FExploded then begin
     752    HideTank;
     753    Energy := 0;
     754    Shield := 0;
     755  end else ShowTank;
    978756end;
    979757
    … …  
    981759begin
    982760  with Engine.World do begin
    983     Surface.Merge(Surface.CreateIndex(Position.X - TTank(Tanks[Direction]).Image.Count.X div 2,
    984       Position.Y - TTank(Tanks[Direction]).Image.Count.Y div 2),
    985       TTank(Tanks[Direction]).Image, ShowTankProc);
     761    Surface.Merge(Surface.CreateIndex(
     762      Position.X - Tanks[Direction].Image.Count.X div 2,
     763      Position.Y - Tanks[Direction].Image.Count.Y div 2),
     764      Tanks[Direction].Image, ShowTankProc);
    986765  end;
    987766end;
    … …  
    998777end;
    999778
    1000 procedure TPlayer.Init;
    1001 begin
    1002   with Engine do
    1003     Position := Point(Round(World.Surface.Count.X * 0.2) + Random(Round(World.Surface.Count.X * 0.6)),
    1004       Round(World.Surface.Count.Y * 0.2) + Random(Round(World.Surface.Count.Y * 0.6)));
    1005   Exploded := False;
     779procedure TPlayer.ResetTank;
     780begin
     781  HideTank;
     782  Position := StartPosition;
    1006783  ExplosionPending := False;
    1007784  Bullets.Clear;
    … …  
    1009786  Shield := 1;
    1010787  Direction := 0;
     788  ShootCount := 0;
     789  ShowTank;
     790  Exploded := False;
     791end;
     792
     793procedure TPlayer.Init;
     794begin
     795  with Engine do
     796    StartPosition := Point(Round(World.Surface.Count.X * 0.2) + Random(Round(World.Surface.Count.X * 0.6)),
     797      Round(World.Surface.Count.Y * 0.2) + Random(Round(World.Surface.Count.Y * 0.6)));
     798  Position := StartPosition;
    1011799  PlaceHouse;
    1012   ShowTank;
    1013800end;
    1014801
    … …  
    1039826begin
    1040827  with Engine.World do begin
    1041     Surface.Merge(Surface.CreateIndex(Position.X - TTank(Tanks[Direction]).Image.Count.X div 2,
    1042       Position.Y - TTank(Tanks[Direction]).Image.Count.Y div 2), TTank(Tanks[Direction]).Image, HideTankProc);
     828    Surface.Merge(Surface.CreateIndex(
     829      Position.X - Tanks[Direction].Image.Count.X div 2,
     830      Position.Y - Tanks[Direction].Image.Count.Y div 2),
     831      Tanks[Direction].Image, HideTankProc);
    1043832  end;
    1044833end;
    … …  
    1161950  Enabled := Source.Enabled;
    1162951  Position := Source.Position;
     952  StartPosition := Source.StartPosition;
    1163953  Score := Source.Score;
     954  ShootCount := Source.ShootCount;
     955  FExploded := Source.FExploded;
    1164956  Tanks.Assign(Source.Tanks);
    1165957end;
    … …  
    12751067  BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    12761068  BytePerRow := RawImage.Description.BytesPerLine;
    1277   if ClearBackground then begin
     1069  if FClearBackground then begin
    12781070    BgColor := World.Matters[Integer(miBorder)].Color;
    12791071    BgColor := SwapBRComponent(BgColor);
    12801072    FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor);
    1281     ClearBackground := False;
     1073    FClearBackground := False;
    12821074  end;
    12831075
    … …  
    13381130
    13391131procedure TEngine.DrawInformation;
     1132var
     1133  Text: string;
     1134  X: Integer;
    13401135begin
    13411136  with Bitmap.Canvas do begin
    1342 
     1137    Brush.Style := bsSolid;
     1138    Brush.Color := clBlack;
     1139    Clear;
     1140
     1141    X := Bitmap.Width div 2;
     1142
     1143    Brush.Style := bsClear;
     1144    Pen.Style := psSolid;
     1145    Pen.Color := clWhite;
     1146    Font.Color := clTuna;
     1147    Font.Size := 30;
     1148    Text := SInformation;
     1149    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
     1150
     1151    Font.Color := clGreen;
     1152    Font.Size := 30;
     1153    Text := SPressEsc;
     1154    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
    13431155  end;
    13441156end;
    13451157
    13461158procedure TEngine.DrawInstructions;
    1347 begin
    1348 
     1159var
     1160  Text: string;
     1161  X: Integer;
     1162begin
     1163  with Bitmap.Canvas do begin
     1164    Brush.Style := bsSolid;
     1165    Brush.Color := clBlack;
     1166    Clear;
     1167
     1168    X := Bitmap.Width div 2;
     1169
     1170    Brush.Style := bsClear;
     1171    Pen.Style := psSolid;
     1172    Pen.Color := clWhite;
     1173    Font.Color := clTuna;
     1174    Font.Size := 30;
     1175    Text := SInstructions;
     1176    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
     1177
     1178    Font.Color := clGreen;
     1179    Font.Size := 30;
     1180    Text := SPressEsc;
     1181    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 * 9, Text);
     1182  end;
    13491183end;
    13501184
    … …  
    16301464var
    16311465  Text: string;
     1466  MenuWidth: Integer;
    16321467begin
    16331468  with Bitmap.Canvas do begin
    … …  
    16351470    Brush.Color := clBlack;
    16361471    Clear;
     1472
     1473    if FShowMenuStats then begin
     1474      MenuWidth := Bitmap.Width div 2;
     1475      DrawStats;
     1476    end else MenuWidth := Bitmap.Width;
    16371477
    16381478    Brush.Style := bsClear;
    … …  
    16421482    Font.Size := 30;
    16431483    Text := 'TUNNELER';
    1644     TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
     1484    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
    16451485
    16461486    Font.Color := clDarkOrange;
    16471487    Font.Size := 20;
    16481488    Text := 'by Chronosoft';
    1649     TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 + 60, Text);
     1489    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 + 70, Text);
    16501490
    16511491    Pen.Color := clPurple;
    16521492    Pen.Width := 6;
    1653     Frame((Bitmap.Width - 400) div 2, Bitmap.Height div 10 * 4 - 40,
    1654       (Bitmap.Width + 400) div 2, Bitmap.Height div 10 * 4 + 200);
     1493    Frame((MenuWidth - 400) div 2, Bitmap.Height div 10 * 4 - 40,
     1494      (MenuWidth + 400) div 2, Bitmap.Height div 10 * 4 + 200);
    16551495
    16561496    Font.Color := clPurple;
    16571497    Font.Size := 20;
    16581498    Text := '<F1>  ' + SStartGame;
    1659     TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4, Text);
     1499    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4, Text);
    16601500    Text := '<F2>  ' + SInstructions;
    1661     TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 40, Text);
     1501    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 40, Text);
    16621502    Text := '<F3>  ' + SInformation;
    1663     TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 80, Text);
    1664     Text := '<F10>  ' + SExit;
    1665     TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 120, Text);
     1503    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 80, Text);
     1504    Text := '<Alt+F4>  ' + SExit;
     1505    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 120, Text);
    16661506
    16671507    Font.Color := clDarkGreen;
    16681508    Font.Size := 20;
    16691509    Text := '(' + SWorldReady + ')';
    1670     TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
     1510    TextOut((MenuWidth - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
     1511  end;
     1512end;
     1513
     1514procedure TEngine.DrawStats;
     1515var
     1516  X: Integer;
     1517  Text: string;
     1518  Winner: TPlayer;
     1519begin
     1520  with Bitmap.Canvas do begin
     1521    X := Bitmap.Width div 4 * 3;
     1522
     1523    Brush.Style := bsClear;
     1524    Pen.Style := psSolid;
     1525
     1526    Pen.Color := clWhite;
     1527    MoveTo(Bitmap.Width div 2, 0);
     1528    LineTo(Bitmap.Width div 2, Bitmap.Height);
     1529
     1530    Font.Color := clCyan;
     1531    Font.Size := 20;
     1532    Text := SStatistics;
     1533    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
     1534
     1535    Font.Color := clOrange;
     1536    Font.Size := 20;
     1537
     1538    //Text := SShotsFired + ' ' + IntToStr(ShootCount);
     1539    //TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
     1540
     1541    Winner := Players.GetWinner;
     1542    if Assigned(Winner) then begin
     1543      Text := SWinnerIs + ' ' + Winner.Name;
     1544      TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10 + 60, Text);
     1545    end;
    16711546  end;
    16721547end;
    … …  
    16841559    FBitmapLower.Count := OldCount;
    16851560
    1686     if ClearBackground then FBitmapLower.FillAll(clNavy);
     1561    if FClearBackground then FBitmapLower.FillAll(clNavy);
    16871562    for I := 0 to Players.Count - 1 do
    16881563    if Players[I].Enabled then begin
    … …  
    17191594    end;
    17201595  end;
    1721   ClearBackground := True;
     1596  FClearBackground := True;
    17221597  Redraw;
    17231598end;
    … …  
    17351610  Keyboard := TKeyboard.Create;
    17361611  World := TWorld.Create;
    1737   World.Engine := Self;
    17381612  //DefaultAudioSystem := TAudioSystemMPlayer.Create(nil);
    17391613  AudioShot := TMediaPlayer.Create(nil);
    … …  
    17471621  InitDigMasks;
    17481622  Redraw;
    1749   MaxRound := 3;
     1623  MaxRound := 5;
    17501624end;
    17511625
    … …  
    18141688
    18151689procedure TEngine.NewGame;
     1690var
     1691  I: Integer;
    18161692begin
    18171693  Active := False;
    … …  
    18191695  ResizePlayerFrames;
    18201696  CurrentRound := 1;
    1821   NewRound;
    1822 
    1823   Active := True;
    1824 end;
    1825 
    1826 procedure TEngine.NewRound;
    1827 var
    1828   I: Integer;
    1829 begin
    18301697  World.Generate;
    1831 
    18321698  for I := 0 to Players.Count - 1 do
    18331699    Players[I].Init;
    1834   ClearBackground := True;
     1700  NewRound;
     1701
     1702  Active := True;
     1703end;
     1704
     1705procedure TEngine.NewRound;
     1706var
     1707  I: Integer;
     1708begin
     1709  for I := 0 to Players.Count - 1 do
     1710    Players[I].ResetTank;
     1711  FClearBackground := True;
    18351712  Redraw;
    18361713end;
    … …  
    18661743    if Key = KeyF2 then begin
    18671744      State := gsInstructions;
    1868       NewGame;
    18691745    end else
    18701746    if Key = KeyF3 then begin
    18711747      State := gsInformation;
    1872       NewGame;
    18731748    end;
    18741749  end else
    … …  
    18761751    if Key = KeyEsc then begin
    18771752      State := gsMenu;
     1753      FShowMenuStats := True;
     1754    end;
     1755  end else
     1756  if State in [gsInformation, gsInstructions] then begin
     1757    if Key = KeyEsc then begin
     1758      State := gsMenu;
    18781759    end;
    18791760  end;
    18801761
    18811762  {$IFDEF DEBUG}
    1882   if Key = KeyF4 then begin
     1763  if (State = gsGame) and (Key = KeyF4) then begin
    18831764    // Destroy first alive player
    18841765    for I := 0 to Players.Count - 1 do
    … …  
    18901771    end;
    18911772  end else
    1892   if Key = KeyF5 then begin
     1773  if (State = gsGame) and (Key = KeyF5) then begin
    18931774    State := gsMap;
    18941775  end;

  • trunk/tunneler.lpi

    r55 r61  
    100100      </Item5>
    101101    </RequiredPackages>
    102     <Units Count="10">
     102    <Units Count="13">
    103103      <Unit0>
    104104        <Filename Value="tunneler.lpr"/>
    … …  
    159159        <ResourceBaseClass Value="DataModule"/>
    160160      </Unit9>
     161      <Unit10>
     162        <Filename Value="UWorld.pas"/>
     163        <IsPartOfProject Value="True"/>
     164      </Unit10>
     165      <Unit11>
     166        <Filename Value="UMatter.pas"/>
     167        <IsPartOfProject Value="True"/>
     168      </Unit11>
     169      <Unit12>
     170        <Filename Value="UFastPixel.pas"/>
     171        <IsPartOfProject Value="True"/>
     172      </Unit12>
    161173    </Units>
    162174  </ProjectOptions>

  • trunk/tunneler.lpr

    r57 r61  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, TemplateGenerics, UPlatform, FileUtil, SysUtils,
    11   Common,
    12   UFormNewGame, UFormMain, UFormMap, UFormGameResult, UCore
     10  Forms, TemplateGenerics, UPlatform, FileUtil, SysUtils, Common, UFormNewGame,
     11  UFormMain, UFormMap, UFormGameResult, UCore, UWorld, UMatter, UFastPixel
    1312  { you can add units after this };
    1413
Note: See TracChangeset for help on using the changeset viewer.