Changeset 59 for trunk

Timestamp:

Dec 25, 2022, 2:30:52 PM (2 years ago)

Author:

chronos

Message:

• Added: Main menu, new round screen, terrain map screen.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (3 diffs)
• UEngine.pas (modified) (14 diffs)

trunk/Forms/UFormMain.lfm

@@ -46 +46 @@
     ParentFont = False
     SimplePanel = False
+    Visible = False
   end
   object Image1: TImage

trunk/Forms/UFormMain.pas

@@ -219 +219 @@
   Shift: TShiftState);
 begin
-  Engine.KeyBoard.KeyState[Key] := True;
+  Engine.KeyDown(Key);
   StatusBar1.Panels[0].Text := IntToStr(Key);
 end;
@@ -225 +225 @@
 procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
   );
-const
-  KeyF11 = 112;
-var
-  I: Integer;
-begin
-  Engine.KeyBoard.KeyState[Key] := False;
-  {$IFDEF DEBUG}
-  if Key = KeyF11 then begin
-    // Destroy first alive player
-    for I := 0 to Engine.Players.Count - 1 do
-    with Engine.Players[I] do begin
-      if not Exploded then begin
-        Energy := -100;
-        Break;
-      end;
-    end;
-  end;
-  {$ENDIF}
+begin
+  Engine.KeyUp(Key);
 end;
 
@@ -250 +234 @@
   PersistentForm.Load(Self, False, True);
   FullScreenEnabled := PersistentForm.FormFullScreen;
+  {$IFDEF DEBUG}
+  StatusBar1.Visible := True;
+  {$ENDIF}
 end;
 

trunk/UEngine.pas

@@ -29 +29 @@
   PlayerHouseDoorSize = 8;
   ExplosionDelay = 2;
+  NewRoundDelay = 2;
+  clTuna = $5555ff;
+  clPurple = $aa00aa;
+  clDarkOrange = $0000aa;
+  clDarkGreen = $00aa00;
 
 type
@@ -159 +164 @@
     procedure LoadConfig(Config: TXMLConfig; Path: string);
     procedure SaveConfig(Config: TXMLConfig; Path: string);
+    function GetAliveCount: Integer;
   end;
 
@@ -212 +218 @@
 
   TDrawThread = class(TListedThread)
+  private
+    procedure DrawSync;
+  public
     Engine: TEngine;
     procedure Execute; override;
   end;
 
-  TGameState = (gsMenu, gsRunning, gsNewRound, gsMap, gsMenuStats, gsInformation,
+  TCanvasMethod = procedure (Canvas: TCanvas) of object;
+
+  TGameState = (gsMenu, gsGame, gsNewRound, gsMap, gsInformation,
     gsInstructions);
 
@@ -230 +241 @@
     FBitmapLower: TBitmapTColor;
     FDrawThread: TDrawThread;
+    FState: TGameState;
     FSystemThread: TSystemThread;
     ClearBackground: Boolean;
+    FStateTime: TDateTime;
     procedure InitDigMasks;
     procedure SetActive(const AValue: Boolean);
@@ -237 +250 @@
     procedure Redraw;
     function IsInsideHouses(Pos: TPoint): Boolean;
-    procedure DoDrawToBitmap;
     procedure InitPlayerPool;
     procedure InitPlayers;
     procedure CheckGameEnd;
+    procedure DrawMenu;
+    procedure DrawGamePrepare(Thread: TVirtualThread);
+    procedure DrawGame;
+    procedure DrawInformation;
+    procedure DrawInstructions;
+    procedure DrawNewRound;
+    procedure DrawMap;
+    procedure SetState(AValue: TGameState);
   public
     Keyboard: TKeyboard;
@@ -253 +273 @@
     AudioExplode: TMediaPlayer;
     DrawDuration: TDatetime;
-    State: TGameState;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure ResizePlayerFrames;
     procedure Tick;
-    procedure Draw(Thread: TVirtualThread);
+    procedure Draw;
+    procedure DrawThread(Thread: TVirtualThread);
     procedure NewGame;
     procedure NewRound;
     procedure LoadConfig(Config: TXMLConfig; Path: string);
     procedure SaveConfig(Config: TXMLConfig; Path: string);
+    procedure KeyUp(Key: Word);
+    procedure KeyDown(Key: Word);
     property Bitmap: TBitmap read FBitmap write SetBitmap;
     property Active: Boolean read FActive write SetActive;
+    property State: TGameState read FState write SetState;
     property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
   end;
@@ -343 +366 @@
   for I := 0 to Count - 1 do
     Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));
+end;
+
+function TPlayers.GetAliveCount: Integer;
+var
+  I: Integer;
+begin
+  Result := 0;
+  for I := 0 to Count - 1 do
+  with Items[I] do
+    if not Exploded then Inc(Result);
 end;
 
@@ -372 +405 @@
 { TDrawThread }
 
+procedure TDrawThread.DrawSync;
+begin
+  with Engine do
+  if Assigned(Bitmap) then begin
+    Lock.Acquire;
+    Bitmap.BeginUpdate(True);
+    try
+      Draw;
+    finally
+      Bitmap.EndUpdate;
+      Lock.Release;
+    end;
+  end;
+end;
+
 procedure TDrawThread.Execute;
 begin
   repeat
-    Engine.Draw(Self);
+    Engine.DrawThread(Self);
+    if not Terminated then Synchronize(DrawSync);
     Sleep(50);
   until Terminated;
@@ -1186 +1235 @@
 end;
 
-procedure TEngine.DoDrawToBitmap;
+procedure TEngine.DrawGame;
 var
   X, Y: Integer;
@@ -1208 +1257 @@
   BgColor: Cardinal;
 begin
-  if Assigned(FBitmap) then begin
-  Lock.Acquire;
+  // TODO: To be able to draw into Bitmap not just through Canvas
+  Bitmap.EndUpdate;
   Bitmap.BeginUpdate;
-  try
-    {$IFDEF WINDOWS}
-    Bitmap.PixelFormat := pf32bit;
-    {$ENDIF}
-    RawImage := Bitmap.RawImage;
-    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
-    BytePerRow := RawImage.Description.BytesPerLine;
-    if ClearBackground then begin
-      BgColor := World.Matters[Integer(miBorder)].Color;
-      BgColor := SwapBRComponent(BgColor);
-      FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor);
-      ClearBackground := False;
-    end;
-
-    if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then
-      Ratio := FBitmap.Width / FBitmapLower.Width
-      else Ratio := FBitmap.Height / FBitmapLower.Height;
-
-    // Preserve aspect ratio
-    TargetWidth := Trunc(FBitmapLower.Width * Ratio);
-    TargetHeight := Trunc(FBitmapLower.Height * Ratio);
-
-    Shift.X := Trunc((Bitmap.Width - TargetWidth) / 2);
-    Shift.Y := Trunc((Bitmap.Height - TargetHeight) / 2);
-
-    XDiv := TargetWidth div FBitmapLower.Width;
-    XMod := TargetWidth mod FBitmapLower.Width;
-    YDiv := TargetHeight div FBitmapLower.Height;
-    YMod := TargetHeight mod FBitmapLower.Height;
-
-    PixelRowPtr := PInteger(RawImage.Data + BytePerRow * Shift.Y);
-    YAcc := FBitmapLower.Height div 2;
-    for Y := 0 to FBitmapLower.Height - 1 do begin
-      SubPixelSizeY := YDiv;
-      Inc(YAcc, YMod);
-      if YAcc >= FBitmapLower.Height then begin
-        Dec(YAcc, FBitmapLower.Height);
-        Inc(SubPixelSizeY);
+
+  {$IFDEF WINDOWS}
+  Bitmap.PixelFormat := pf32bit;
+  {$ENDIF}
+  RawImage := Bitmap.RawImage;
+  BytePerPixel := RawImage.Description.BitsPerPixel div 8;
+  BytePerRow := RawImage.Description.BytesPerLine;
+  if ClearBackground then begin
+    BgColor := World.Matters[Integer(miBorder)].Color;
+    BgColor := SwapBRComponent(BgColor);
+    FillDWord(RawImage.Data^, Bitmap.Height * BytePerRow div 4, BgColor);
+    ClearBackground := False;
+  end;
+
+  if (FBitmap.Width / FBitmapLower.Width) < (FBitmap.Height / FBitmapLower.Height) then
+    Ratio := FBitmap.Width / FBitmapLower.Width
+    else Ratio := FBitmap.Height / FBitmapLower.Height;
+
+  // Preserve aspect ratio
+  TargetWidth := Trunc(FBitmapLower.Width * Ratio);
+  TargetHeight := Trunc(FBitmapLower.Height * Ratio);
+
+  Shift.X := Trunc((Bitmap.Width - TargetWidth) / 2);
+  Shift.Y := Trunc((Bitmap.Height - TargetHeight) / 2);
+
+  XDiv := TargetWidth div FBitmapLower.Width;
+  XMod := TargetWidth mod FBitmapLower.Width;
+  YDiv := TargetHeight div FBitmapLower.Height;
+  YMod := TargetHeight mod FBitmapLower.Height;
+
+  PixelRowPtr := PInteger(RawImage.Data + BytePerRow * Shift.Y);
+  YAcc := FBitmapLower.Height div 2;
+  for Y := 0 to FBitmapLower.Height - 1 do begin
+    SubPixelSizeY := YDiv;
+    Inc(YAcc, YMod);
+    if YAcc >= FBitmapLower.Height then begin
+      Dec(YAcc, FBitmapLower.Height);
+      Inc(SubPixelSizeY);
+    end;
+
+    PixelPtr := PixelRowPtr + Shift.X;
+    XAcc := FBitmapLower.Width div 2;
+    for X := 0 to FBitmapLower.Width - 1 do begin
+      SubPixelSizeX := XDiv;
+      Inc(XAcc, XMod);
+      if XAcc >= FBitmapLower.Width then begin
+        Dec(XAcc, FBitmapLower.Width);
+        Inc(SubPixelSizeX);
       end;
-
-      PixelPtr := PixelRowPtr + Shift.X;
-      XAcc := FBitmapLower.Width div 2;
-      for X := 0 to FBitmapLower.Width - 1 do begin
-        SubPixelSizeX := XDiv;
-        Inc(XAcc, XMod);
-        if XAcc >= FBitmapLower.Width then begin
-          Dec(XAcc, FBitmapLower.Width);
-          Inc(SubPixelSizeX);
+      Color := FBitmapLower.Pixels[X, Y] and $ffffff;
+
+      Color := SwapBRComponent(Color);
+
+      // Draw large pixel
+      SubPixelRowPtr := PixelPtr;
+      for PixelY := 0 to SubPixelSizeY - 1 do begin
+        SubPixelPtr := SubPixelRowPtr;
+        for PixelX := 0 to SubPixelSizeX - 1 do begin
+          SubPixelPtr^ := Color;
+          Inc(PByte(SubPixelPtr), BytePerPixel);
         end;
-        Color := FBitmapLower.Pixels[X, Y] and $ffffff;
-
-        Color := SwapBRComponent(Color);
-
-        // Draw large pixel
-        SubPixelRowPtr := PixelPtr;
-        for PixelY := 0 to SubPixelSizeY - 1 do begin
-          SubPixelPtr := SubPixelRowPtr;
-          for PixelX := 0 to SubPixelSizeX - 1 do begin
-            SubPixelPtr^ := Color;
-            Inc(PByte(SubPixelPtr), BytePerPixel);
-          end;
-          Inc(PByte(SubPixelRowPtr), BytePerRow);
-        end;
-        Inc(PByte(PixelPtr), BytePerPixel * SubPixelSizeX);
+        Inc(PByte(SubPixelRowPtr), BytePerRow);
       end;
-      Inc(PByte(PixelRowPtr), BytePerRow * SubPixelSizeY);
-    end;
-  finally
-    Bitmap.EndUpdate;
-    Lock.Release;
-  end;
-  end;
+      Inc(PByte(PixelPtr), BytePerPixel * SubPixelSizeX);
+    end;
+    Inc(PByte(PixelRowPtr), BytePerRow * SubPixelSizeY);
+      end;
+end;
+
+procedure TEngine.DrawInformation;
+begin
+  with Bitmap.Canvas do begin
+
+  end;
+end;
+
+procedure TEngine.DrawInstructions;
+begin
+
+end;
+
+procedure TEngine.DrawNewRound;
+var
+  Text: string;
+  I: Integer;
+  Y: Integer;
+begin
+  with Bitmap.Canvas do begin
+    Brush.Style := bsSolid;
+    Brush.Color := clBlack;
+    Clear;
+
+    Brush.Style := bsClear;
+    Pen.Style := psSolid;
+    Pen.Color := clWhite;
+    Font.Color := clTuna;
+    Font.Size := 30;
+    Text := 'Round ' + IntToStr(CurrentRound);
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5, Text);
+
+    Y := 0;
+    for I := 0 to Players.Count - 1 do
+    with TPlayer(Players[I]) do begin
+      if Enabled then begin
+        Font.Color := Color1;
+        Text := SPlayer + ' ' + Name + ': ' + IntToStr(Score);
+        TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 5 * 2 + Y, Text);
+        Inc(Y, 50);
+      end;
+    end;
+  end;
+end;
+
+procedure TEngine.DrawMap;
+begin
+  Bitmap.EndUpdate;
+  Bitmap.BeginUpdate;
+
+  World.DrawToBitmap(Bitmap);
+end;
+
+procedure TEngine.SetState(AValue: TGameState);
+begin
+  if FState = AValue then Exit;
+  FState := AValue;
+  FRedrawPending := True;
+  FStateTime := Now;
 end;
 
@@ -1485 +1589 @@
 procedure TEngine.CheckGameEnd;
 var
-  AliveCount: Integer;
-  I: Integer;
-begin
-  AliveCount := 0;
-  for I := 0 to Players.Count - 1 do
-  with Players[I] do
-    if not Exploded then Inc(AliveCount);
-  if AliveCount <= 1 then begin
+  I: Integer;
+begin
+  if Players.GetAliveCount <= 1 then begin
     for I := 0 to Players.Count - 1 do
     with Players[I] do
       if not Exploded then Inc(Score);
-    if CurrentRound < MaxRound then
-      NewRound else
+    if CurrentRound < MaxRound then begin
+      Inc(CurrentRound);
+      NewRound;
+      State := gsNewRound;
+    end else
+      State := gsMap;
       if Assigned(FOnGameEnd) then
         FOnGameEnd(Self);
+  end;
+end;
+
+procedure TEngine.DrawMenu;
+var
+  Text: string;
+begin
+  with Bitmap.Canvas do begin
+    Brush.Style := bsSolid;
+    Brush.Color := clBlack;
+    Clear;
+
+    Brush.Style := bsClear;
+    Pen.Style := psSolid;
+    Pen.Color := clWhite;
+    Font.Color := clTuna;
+    Font.Size := 30;
+    Text := 'TUNNELER';
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10, Text);
+
+    Font.Color := clDarkOrange;
+    Font.Size := 20;
+    Text := 'by Chronosoft';
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 + 50, Text);
+
+    Pen.Color := clPurple;
+    Pen.Width := 6;
+    Frame((Bitmap.Width - 400) div 2, Bitmap.Height div 10 * 4 - 40,
+      (Bitmap.Width + 400) div 2, Bitmap.Height div 10 * 4 + 200);
+
+    Font.Color := clPurple;
+    Font.Size := 20;
+    Text := '<F1>  start game';
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4, Text);
+    Text := '<F2>  instructions';
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 40, Text);
+    Text := '<F3>  information';
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 80, Text);
+    Text := '<F10>  exit';
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 4 + 120, Text);
+
+    Font.Color := clDarkGreen;
+    Font.Size := 20;
+    Text := '(world ready)';
+    TextOut((Bitmap.Width - TextWidth(Text)) div 2, Bitmap.Height div 10 * 9, Text);
+  end;
+end;
+
+procedure TEngine.DrawGamePrepare(Thread: TVirtualThread);
+var
+  I: Integer;
+  OldCount: TBitmapTColorIndex;
+begin
+  Lock.Acquire;
+  try
+    // TODO: Without this (re)initialization we get range error
+    OldCount := FBitmapLower.Count;
+    FBitmapLower.Count := FBitmapLower.CreateIndex(0, 0);
+    FBitmapLower.Count := OldCount;
+
+    if ClearBackground then FBitmapLower.FillAll(clNavy);
+    for I := 0 to Players.Count - 1 do
+    if Players[I].Enabled then begin
+      Players[I].Paint;
+    end;
+  finally
+    Lock.Release;
   end;
 end;
@@ -1579 +1749 @@
   I: Integer;
 begin
-  Lock.Acquire;
-  try
-    for I := 0 to Players.Count - 1 do begin
-      Players[I].Control;
-      Players[I].Tick;
-    end;
-  finally
-    Lock.Release;
-  end;
-end;
-
-procedure TEngine.Draw(Thread: TVirtualThread);
-var
-  I: Integer;
+  if State = gsGame then begin
+    Lock.Acquire;
+    try
+      for I := 0 to Players.Count - 1 do begin
+        Players[I].Control;
+        Players[I].Tick;
+      end;
+    finally
+      Lock.Release;
+    end;
+  end else
+  if State = gsNewRound then begin
+    if SecondOf(Now - FStateTime) > NewRoundDelay then begin
+      State := gsGame;
+    end;
+  end;
+end;
+
+procedure TEngine.Draw;
+var
   DrawStart: TDateTime;
-  OldCount: TBitmapTColorIndex;
 begin
   if FRedrawPending then begin
     DrawStart := NowPrecise;
     FRedrawPending := False;
-    Lock.Acquire;
-    try
-      // TODO: Without this (re)initialization we get range error
-      OldCount := FBitmapLower.Count;
-      FBitmapLower.Count := FBitmapLower.CreateIndex(0, 0);
-      FBitmapLower.Count := OldCount;
-
-      if ClearBackground then FBitmapLower.FillAll(clNavy);
-      for I := 0 to Players.Count - 1 do
-      if Players[I].Enabled then begin
-        Players[I].Paint;
-      end;
-    finally
-      Lock.Release;
-    end;
-    if not Thread.Terminated then Thread.Synchronize(DoDrawToBitmap);
+    case State of
+      gsGame: DrawGame;
+      gsMenu: DrawMenu;
+      gsInformation: DrawInformation;
+      gsInstructions: DrawInstructions;
+      gsMap: DrawMap;
+      gsNewRound: DrawNewRound;
+    end;
+
     DrawDuration := NowPrecise - DrawStart;
   end;
+end;
+
+procedure TEngine.DrawThread(Thread: TVirtualThread);
+begin
+  if State = gsGame then DrawGamePrepare(Thread);
 end;
 
@@ -1624 +1797 @@
   InitPlayers;
   ResizePlayerFrames;
-  CurrentRound := 0;
+  CurrentRound := 1;
   NewRound;
 
@@ -1652 +1825 @@
 end;
 
+procedure TEngine.KeyUp(Key: Word);
+const
+  KeyF1 = 112;
+  KeyF2 = 113;
+  KeyF3 = 114;
+  KeyF4 = 115;
+  KeyEsc = 27;
+var
+  I: Integer;
+begin
+  KeyBoard.KeyState[Key] := False;
+
+  if State = gsMenu then begin
+    if Key = KeyF1 then begin
+      State := gsNewRound;
+      NewGame;
+    end else
+    if Key = KeyF2 then begin
+      State := gsInstructions;
+      NewGame;
+    end else
+    if Key = KeyF3 then begin
+      State := gsInformation;
+      NewGame;
+    end;
+  end else
+  if State = gsMap then begin
+    if Key = KeyEsc then begin
+      State := gsMenu;
+    end;
+  end;
+
+  {$IFDEF DEBUG}
+  if Key = KeyF4 then begin
+    // Destroy first alive player
+    for I := 0 to Players.Count - 1 do
+    with Players[I] do begin
+      if not Exploded then begin
+        Energy := -100;
+        Break;
+      end;
+    end;
+  end;
+  {$ENDIF}
+end;
+
+procedure TEngine.KeyDown(Key: Word);
+begin
+  KeyBoard.KeyState[Key] := True;
+end;
+
 end.