Changeset 59


Ignore:
Timestamp:
Dec 25, 2022, 2:30:52 PM (23 months ago)
Author:
chronos
Message:
  • Added: Main menu, new round screen, terrain map screen.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormMain.lfm

    r55 r59  
    4646    ParentFont = False
    4747    SimplePanel = False
     48    Visible = False
    4849  end
    4950  object Image1: TImage
  • trunk/Forms/UFormMain.pas

    r57 r59  
    219219  Shift: TShiftState);
    220220begin
    221   Engine.KeyBoard.KeyState[Key] := True;
     221  Engine.KeyDown(Key);
    222222  StatusBar1.Panels[0].Text := IntToStr(Key);
    223223end;
     
    225225procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
    226226  );
    227 const
    228   KeyF11 = 112;
    229 var
    230   I: Integer;
    231 begin
    232   Engine.KeyBoard.KeyState[Key] := False;
    233   {$IFDEF DEBUG}
    234   if Key = KeyF11 then begin
    235     // Destroy first alive player
    236     for I := 0 to Engine.Players.Count - 1 do
    237     with Engine.Players[I] do begin
    238       if not Exploded then begin
    239         Energy := -100;
    240         Break;
    241       end;
    242     end;
    243   end;
    244   {$ENDIF}
     227begin
     228  Engine.KeyUp(Key);
    245229end;
    246230
     
    250234  PersistentForm.Load(Self, False, True);
    251235  FullScreenEnabled := PersistentForm.FormFullScreen;
     236  {$IFDEF DEBUG}
     237  StatusBar1.Visible := True;
     238  {$ENDIF}
    252239end;
    253240
  • trunk/UEngine.pas

    r58 r59  
    2929  PlayerHouseDoorSize = 8;
    3030  ExplosionDelay = 2;
     31  NewRoundDelay = 2;
     32  clTuna = $5555ff;
     33  clPurple = $aa00aa;
     34  clDarkOrange = $0000aa;
     35  clDarkGreen = $00aa00;
    3136
    3237type
     
    159164    procedure LoadConfig(Config: TXMLConfig; Path: string);
    160165    procedure SaveConfig(Config: TXMLConfig; Path: string);
     166    function GetAliveCount: Integer;
    161167  end;
    162168
     
    212218
    213219  TDrawThread = class(TListedThread)
     220  private
     221    procedure DrawSync;
     222  public
    214223    Engine: TEngine;
    215224    procedure Execute; override;
    216225  end;
    217226
    218   TGameState = (gsMenu, gsRunning, gsNewRound, gsMap, gsMenuStats, gsInformation,
     227  TCanvasMethod = procedure (Canvas: TCanvas) of object;
     228
     229  TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation,
    219230    gsInstructions);
    220231
     
    230241    FBitmapLower: TBitmapTColor;
    231242    FDrawThread: TDrawThread;
     243    FState: TGameState;
    232244    FSystemThread: TSystemThread;
    233245    ClearBackground: Boolean;
     246    FStateTime: TDateTime;
    234247    procedure InitDigMasks;
    235248    procedure SetActive(const AValue: Boolean);
     
    237250    procedure Redraw;
    238251    function IsInsideHouses(Pos: TPoint): Boolean;
    239     procedure DoDrawToBitmap;
    240252    procedure InitPlayerPool;
    241253    procedure InitPlayers;
    242254    procedure CheckGameEnd;
     255    procedure DrawMenu;
     256    procedure DrawGamePrepare(Thread: TVirtualThread);
     257    procedure DrawGame;
     258    procedure DrawInformation;
     259    procedure DrawInstructions;
     260    procedure DrawNewRound;
     261    procedure DrawMap;
     262    procedure SetState(AValue: TGameState);
    243263  public
    244264    Keyboard: TKeyboard;
     
    253273    AudioExplode: TMediaPlayer;
    254274    DrawDuration: TDatetime;
    255     State: TGameState;
    256275    constructor Create(AOwner: TComponent); override;
    257276    destructor Destroy; override;
    258277    procedure ResizePlayerFrames;
    259278    procedure Tick;
    260     procedure Draw(Thread: TVirtualThread);
     279    procedure Draw;
     280    procedure DrawThread(Thread: TVirtualThread);
    261281    procedure NewGame;
    262282    procedure NewRound;
    263283    procedure LoadConfig(Config: TXMLConfig; Path: string);
    264284    procedure SaveConfig(Config: TXMLConfig; Path: string);
     285    procedure KeyUp(Key: Word);
     286    procedure KeyDown(Key: Word);
    265287    property Bitmap: TBitmap read FBitmap write SetBitmap;
    266288    property Active: Boolean read FActive write SetActive;
     289    property State: TGameState read FState write SetState;
    267290    property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
    268291  end;
     
    343366  for I := 0 to Count - 1 do
    344367    Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));
     368end;
     369
     370function TPlayers.GetAliveCount: Integer;
     371var
     372  I: Integer;
     373begin
     374  Result := 0;
     375  for I := 0 to Count - 1 do
     376  with Items[I] do
     377    if not Exploded then Inc(Result);
    345378end;
    346379
     
    372405{ TDrawThread }
    373406
     407procedure TDrawThread.DrawSync;
     408begin
     409  with Engine do
     410  if Assigned(Bitmap) then begin
     411    Lock.Acquire;
     412    Bitmap.BeginUpdate(True);
     413    try
     414      Draw;
     415    finally
     416      Bitmap.EndUpdate;
     417      Lock.Release;
     418    end;
     419  end;
     420end;
     421
    374422procedure TDrawThread.Execute;
    375423begin
    376424  repeat
    377     Engine.Draw(Self);
     425    Engine.DrawThread(Self);
     426    if not Terminated then Synchronize(DrawSync);
    378427    Sleep(50);
    379428  until Terminated;
     
    11861235end;
    11871236
    1188 procedure TEngine.DoDrawToBitmap;
     1237procedure TEngine.DrawGame;
    11891238var
    11901239  X, Y: Integer;
     
    12081257  BgColor: Cardinal;
    12091258begin
    1210   if Assigned(FBitmap) then begin
    1211   Lock.Acquire;
     1259  // TODO: To be able to draw into Bitmap not just through Canvas
     1260  Bitmap.EndUpdate;
    12121261  Bitmap.BeginUpdate;
    1213   try
    1214     {$IFDEF WINDOWS}
    1215     Bitmap.PixelFormat := pf32bit;
    1216     {$ENDIF}
    1217     RawImage := Bitmap.RawImage;
    1218     BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    1219     BytePerRow := RawImage.Description.BytesPerLine;
    1220     if ClearBackground then begin
    1221       BgColor := World.Matters[Integer(miBorder)].Color;
    1222       BgColor := SwapBRComponent(BgColor);
    1223       FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor);
    1224       ClearBackground := False;
    1225     end;
    1226 
    1227     if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then
    1228       Ratio := FBitmap.Width / FBitmapLower.Width
    1229       else Ratio := FBitmap.Height / FBitmapLower.Height;
    1230 
    1231     // Preserve aspect ratio
    1232     TargetWidth := Trunc(FBitmapLower.Width * Ratio);
    1233     TargetHeight := Trunc(FBitmapLower.Height * Ratio);
    1234 
    1235     Shift.X := Trunc((Bitmap.Width - TargetWidth) / 2);
    1236     Shift.Y := Trunc((Bitmap.Height - TargetHeight) / 2);
    1237 
    1238     XDiv := TargetWidth div FBitmapLower.Width;
    1239     XMod := TargetWidth mod FBitmapLower.Width;
    1240     YDiv := TargetHeight div FBitmapLower.Height;
    1241     YMod := TargetHeight mod FBitmapLower.Height;
    1242 
    1243     PixelRowPtr := PInteger(RawImage.Data + BytePerRow * Shift.Y);
    1244     YAcc := FBitmapLower.Height div 2;
    1245     for Y := 0 to FBitmapLower.Height - 1 do begin
    1246       SubPixelSizeY := YDiv;
    1247       Inc(YAcc, YMod);
    1248       if YAcc >= FBitmapLower.Height then begin
    1249         Dec(YAcc, FBitmapLower.Height);
    1250         Inc(SubPixelSizeY);
     1262
     1263  {$IFDEF WINDOWS}
     1264  Bitmap.PixelFormat := pf32bit;
     1265  {$ENDIF}
     1266  RawImage := Bitmap.RawImage;
     1267  BytePerPixel := RawImage.Description.BitsPerPixel div 8;
     1268  BytePerRow := RawImage.Description.BytesPerLine;
     1269  if ClearBackground then begin
     1270    BgColor := World.Matters[Integer(miBorder)].Color;
     1271    BgColor := SwapBRComponent(BgColor);
     1272    FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor);
     1273    ClearBackground := False;
     1274  end;
     1275
     1276  if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then
     1277    Ratio := FBitmap.Width / FBitmapLower.Width
     1278    else Ratio := FBitmap.Height / FBitmapLower.Height;
     1279
     1280  // Preserve aspect ratio
     1281  TargetWidth := Trunc(FBitmapLower.Width * Ratio);
     1282  TargetHeight := Trunc(FBitmapLower.Height * Ratio);
     1283
     1284  Shift.X := Trunc((Bitmap.Width - TargetWidth) / 2);
     1285  Shift.Y := Trunc((Bitmap.Height - TargetHeight) / 2);
     1286
     1287  XDiv := TargetWidth div FBitmapLower.Width;
     1288  XMod := TargetWidth mod FBitmapLower.Width;
     1289  YDiv := TargetHeight div FBitmapLower.Height;
     1290  YMod := TargetHeight mod FBitmapLower.Height;
     1291
     1292  PixelRowPtr := PInteger(RawImage.Data + BytePerRow * Shift.Y);
     1293  YAcc := FBitmapLower.Height div 2;
     1294  for Y := 0 to FBitmapLower.Height - 1 do begin
     1295    SubPixelSizeY := YDiv;
     1296    Inc(YAcc, YMod);
     1297    if YAcc >= FBitmapLower.Height then begin
     1298      Dec(YAcc, FBitmapLower.Height);
     1299      Inc(SubPixelSizeY);
     1300    end;
     1301
     1302    PixelPtr := PixelRowPtr + Shift.X;
     1303    XAcc := FBitmapLower.Width div 2;
     1304    for X := 0 to FBitmapLower.Width - 1 do begin
     1305      SubPixelSizeX := XDiv;
     1306      Inc(XAcc, XMod);
     1307      if XAcc >= FBitmapLower.Width then begin
     1308        Dec(XAcc, FBitmapLower.Width);
     1309        Inc(SubPixelSizeX);
    12511310      end;
    1252 
    1253       PixelPtr := PixelRowPtr + Shift.X;
    1254       XAcc := FBitmapLower.Width div 2;
    1255       for X := 0 to FBitmapLower.Width - 1 do begin
    1256         SubPixelSizeX := XDiv;
    1257         Inc(XAcc, XMod);
    1258         if XAcc >= FBitmapLower.Width then begin
    1259           Dec(XAcc, FBitmapLower.Width);
    1260           Inc(SubPixelSizeX);
     1311      Color := FBitmapLower.Pixels[X, Y] and $ffffff;
     1312
     1313      Color := SwapBRComponent(Color);
     1314
     1315      // Draw large pixel
     1316      SubPixelRowPtr := PixelPtr;
     1317      for PixelY := 0 to SubPixelSizeY - 1 do begin
     1318        SubPixelPtr := SubPixelRowPtr;
     1319        for PixelX := 0 to SubPixelSizeX - 1 do begin
     1320          SubPixelPtr^ := Color;
     1321          Inc(PByte(SubPixelPtr), BytePerPixel);
    12611322        end;
    1262         Color := FBitmapLower.Pixels[X, Y] and $ffffff;
    1263 
    1264         Color := SwapBRComponent(Color);
    1265 
    1266         // Draw large pixel
    1267         SubPixelRowPtr := PixelPtr;
    1268         for PixelY := 0 to SubPixelSizeY - 1 do begin
    1269           SubPixelPtr := SubPixelRowPtr;
    1270           for PixelX := 0 to SubPixelSizeX - 1 do begin
    1271             SubPixelPtr^ := Color;
    1272             Inc(PByte(SubPixelPtr), BytePerPixel);
    1273           end;
    1274           Inc(PByte(SubPixelRowPtr), BytePerRow);
    1275         end;
    1276         Inc(PByte(PixelPtr), BytePerPixel * SubPixelSizeX);
     1323        Inc(PByte(SubPixelRowPtr), BytePerRow);
    12771324      end;
    1278       Inc(PByte(PixelRowPtr), BytePerRow * SubPixelSizeY);
    1279     end;
    1280   finally
    1281     Bitmap.EndUpdate;
    1282     Lock.Release;
    1283   end;
    1284   end;
     1325      Inc(PByte(PixelPtr), BytePerPixel * SubPixelSizeX);
     1326    end;
     1327    Inc(PByte(PixelRowPtr), BytePerRow * SubPixelSizeY);
     1328      end;
     1329end;
     1330
     1331procedure TEngine.DrawInformation;
     1332begin
     1333  with Bitmap.Canvas do begin
     1334
     1335  end;
     1336end;
     1337
     1338procedure TEngine.DrawInstructions;
     1339begin
     1340
     1341end;
     1342
     1343procedure TEngine.DrawNewRound;
     1344var
     1345  Text: string;
     1346  I: Integer;
     1347  Y: Integer;
     1348begin
     1349  with Bitmap.Canvas do begin
     1350    Brush.Style := bsSolid;
     1351    Brush.Color := clBlack;
     1352    Clear;
     1353
     1354    Brush.Style := bsClear;
     1355    Pen.Style := psSolid;
     1356    Pen.Color := clWhite;
     1357    Font.Color := clTuna;
     1358    Font.Size := 30;
     1359    Text := 'Round ' + IntToStr(CurrentRound);
     1360    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5, Text);
     1361
     1362    Y := 0;
     1363    for I := 0 to Players.Count - 1 do
     1364    with TPlayer(Players[I]) do begin
     1365      if Enabled then begin
     1366        Font.Color := Color1;
     1367        Text := SPlayer + ' ' + Name + ': ' + IntToStr(Score);
     1368        TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5 * 2 + Y, Text);
     1369        Inc(Y, 50);
     1370      end;
     1371    end;
     1372  end;
     1373end;
     1374
     1375procedure TEngine.DrawMap;
     1376begin
     1377  Bitmap.EndUpdate;
     1378  Bitmap.BeginUpdate;
     1379
     1380  World.DrawToBitmap(Bitmap);
     1381end;
     1382
     1383procedure TEngine.SetState(AValue: TGameState);
     1384begin
     1385  if FState = AValue then Exit;
     1386  FState := AValue;
     1387  FRedrawPending := True;
     1388  FStateTime := Now;
    12851389end;
    12861390
     
    14851589procedure TEngine.CheckGameEnd;
    14861590var
    1487   AliveCount: Integer;
    1488   I: Integer;
    1489 begin
    1490   AliveCount := 0;
    1491   for I := 0 to Players.Count - 1 do
    1492   with Players[I] do
    1493     if not Exploded then Inc(AliveCount);
    1494   if AliveCount <= 1 then begin
     1591  I: Integer;
     1592begin
     1593  if Players.GetAliveCount <= 1 then begin
    14951594    for I := 0 to Players.Count - 1 do
    14961595    with Players[I] do
    14971596      if not Exploded then Inc(Score);
    1498     if CurrentRound < MaxRound then
    1499       NewRound else
     1597    if CurrentRound < MaxRound then begin
     1598      Inc(CurrentRound);
     1599      NewRound;
     1600      State := gsNewRound;
     1601    end else
     1602      State := gsMap;
    15001603      if Assigned(FOnGameEnd) then
    15011604        FOnGameEnd(Self);
     1605  end;
     1606end;
     1607
     1608procedure TEngine.DrawMenu;
     1609var
     1610  Text: string;
     1611begin
     1612  with Bitmap.Canvas do begin
     1613    Brush.Style := bsSolid;
     1614    Brush.Color := clBlack;
     1615    Clear;
     1616
     1617    Brush.Style := bsClear;
     1618    Pen.Style := psSolid;
     1619    Pen.Color := clWhite;
     1620    Font.Color := clTuna;
     1621    Font.Size := 30;
     1622    Text := 'TUNNELER';
     1623    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
     1624
     1625    Font.Color := clDarkOrange;
     1626    Font.Size := 20;
     1627    Text := 'by Chronosoft';
     1628    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 + 50, Text);
     1629
     1630    Pen.Color := clPurple;
     1631    Pen.Width := 6;
     1632    Frame((Bitmap.Width - 400) div 2, Bitmap.Height div 10 * 4 - 40,
     1633      (Bitmap.Width + 400) div 2, Bitmap.Height div 10 * 4 + 200);
     1634
     1635    Font.Color := clPurple;
     1636    Font.Size := 20;
     1637    Text := '<F1>  start game';
     1638    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4, Text);
     1639    Text := '<F2>  instructions';
     1640    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 40, Text);
     1641    Text := '<F3>  information';
     1642    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 80, Text);
     1643    Text := '<F10>  exit';
     1644    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 120, Text);
     1645
     1646    Font.Color := clDarkGreen;
     1647    Font.Size := 20;
     1648    Text := '(world ready)';
     1649    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
     1650  end;
     1651end;
     1652
     1653procedure TEngine.DrawGamePrepare(Thread: TVirtualThread);
     1654var
     1655  I: Integer;
     1656  OldCount: TBitmapTColorIndex;
     1657begin
     1658  Lock.Acquire;
     1659  try
     1660    // TODO: Without this (re)initialization we get range error
     1661    OldCount := FBitmapLower.Count;
     1662    FBitmapLower.Count := FBitmapLower.CreateIndex(0, 0);
     1663    FBitmapLower.Count := OldCount;
     1664
     1665    if ClearBackground then FBitmapLower.FillAll(clNavy);
     1666    for I := 0 to Players.Count - 1 do
     1667    if Players[I].Enabled then begin
     1668      Players[I].Paint;
     1669    end;
     1670  finally
     1671    Lock.Release;
    15021672  end;
    15031673end;
     
    15791749  I: Integer;
    15801750begin
    1581   Lock.Acquire;
    1582   try
    1583     for I := 0 to Players.Count - 1 do begin
    1584       Players[I].Control;
    1585       Players[I].Tick;
    1586     end;
    1587   finally
    1588     Lock.Release;
    1589   end;
    1590 end;
    1591 
    1592 procedure TEngine.Draw(Thread: TVirtualThread);
    1593 var
    1594   I: Integer;
     1751  if State = gsGame then begin
     1752    Lock.Acquire;
     1753    try
     1754      for I := 0 to Players.Count - 1 do begin
     1755        Players[I].Control;
     1756        Players[I].Tick;
     1757      end;
     1758    finally
     1759      Lock.Release;
     1760    end;
     1761  end else
     1762  if State = gsNewRound then begin
     1763    if SecondOf(Now - FStateTime) > NewRoundDelay then begin
     1764      State := gsGame;
     1765    end;
     1766  end;
     1767end;
     1768
     1769procedure TEngine.Draw;
     1770var
    15951771  DrawStart: TDateTime;
    1596   OldCount: TBitmapTColorIndex;
    15971772begin
    15981773  if FRedrawPending then begin
    15991774    DrawStart := NowPrecise;
    16001775    FRedrawPending := False;
    1601     Lock.Acquire;
    1602     try
    1603       // TODO: Without this (re)initialization we get range error
    1604       OldCount := FBitmapLower.Count;
    1605       FBitmapLower.Count := FBitmapLower.CreateIndex(0, 0);
    1606       FBitmapLower.Count := OldCount;
    1607 
    1608       if ClearBackground then FBitmapLower.FillAll(clNavy);
    1609       for I := 0 to Players.Count - 1 do
    1610       if Players[I].Enabled then begin
    1611         Players[I].Paint;
    1612       end;
    1613     finally
    1614       Lock.Release;
    1615     end;
    1616     if not Thread.Terminated then Thread.Synchronize(DoDrawToBitmap);
     1776    case State of
     1777      gsGame: DrawGame;
     1778      gsMenu: DrawMenu;
     1779      gsInformation: DrawInformation;
     1780      gsInstructions: DrawInstructions;
     1781      gsMap: DrawMap;
     1782      gsNewRound: DrawNewRound;
     1783    end;
     1784
    16171785    DrawDuration := NowPrecise - DrawStart;
    16181786  end;
     1787end;
     1788
     1789procedure TEngine.DrawThread(Thread: TVirtualThread);
     1790begin
     1791  if State = gsGame then DrawGamePrepare(Thread);
    16191792end;
    16201793
     
    16241797  InitPlayers;
    16251798  ResizePlayerFrames;
    1626   CurrentRound := 0;
     1799  CurrentRound := 1;
    16271800  NewRound;
    16281801
     
    16521825end;
    16531826
     1827procedure TEngine.KeyUp(Key: Word);
     1828const
     1829  KeyF1 = 112;
     1830  KeyF2 = 113;
     1831  KeyF3 = 114;
     1832  KeyF4 = 115;
     1833  KeyEsc = 27;
     1834var
     1835  I: Integer;
     1836begin
     1837  KeyBoard.KeyState[Key] := False;
     1838
     1839  if State = gsMenu then begin
     1840    if Key = KeyF1 then begin
     1841      State := gsNewRound;
     1842      NewGame;
     1843    end else
     1844    if Key = KeyF2 then begin
     1845      State := gsInstructions;
     1846      NewGame;
     1847    end else
     1848    if Key = KeyF3 then begin
     1849      State := gsInformation;
     1850      NewGame;
     1851    end;
     1852  end else
     1853  if State = gsMap then begin
     1854    if Key = KeyEsc then begin
     1855      State := gsMenu;
     1856    end;
     1857  end;
     1858
     1859  {$IFDEF DEBUG}
     1860  if Key = KeyF4 then begin
     1861    // Destroy first alive player
     1862    for I := 0 to Players.Count - 1 do
     1863    with Players[I] do begin
     1864      if not Exploded then begin
     1865        Energy := -100;
     1866        Break;
     1867      end;
     1868    end;
     1869  end;
     1870  {$ENDIF}
     1871end;
     1872
     1873procedure TEngine.KeyDown(Key: Word);
     1874begin
     1875  KeyBoard.KeyState[Key] := True;
     1876end;
     1877
    16541878end.
    16551879
Note: See TracChangeset for help on using the changeset viewer.