Changeset 69 for trunk/UEngine.pas

Timestamp:

Jan 9, 2023, 1:05:50 AM (23 months ago)

Author:

chronos

Message:

• Fixed: Show informations and instructions texts.

File:

• trunk/UEngine.pas (modified) (9 diffs)

trunk/UEngine.pas

@@ -4 +4 @@
 
 uses
-  Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, URegistry,
+  Dialogs, Classes, SysUtils, Graphics, SpecializedMatrix, URegistry, UCommon,
   IntfGraphics, FPImage, LCLType, SpecializedBitmap, GraphType, Math, URectangle,
   Syncobjs, UThreading, Forms, DateUtils, UAudioSystem, Generics.Collections,
@@ -232 +232 @@
     procedure DrawMap;
     procedure SetState(AValue: TGameState);
+    function TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer;
   public
     ThreadErrorMessage: string;
@@ -281 +282 @@
   SStartGame = 'Start game';
   SInstructions = 'Instructions';
+  SInstructionsDetails = 'Tunneler is a two player game. The objective of the game is to be the first to win three rounds. ' +
+    'A round continues until one tank blows up (from being shot or simply running out of energy).';
+  SInstructionsDetails2 = 'The display: Each player has a view screen and an instrument panel with two meters. ' +
+    'The view screen shows your surroundings from above (about 1% of the entire "worlds"). ' +
+    'The two meters indicate the player''s energy and shield condition.';
+  SInstructionsDetails3 = 'The Game: Players can move in one of 8 directions. ' +
+    'Movement in tunnels is three times as fast as normal digging. ' +
+    'Fast digging can be accomplished by firing the tank''s cannon while moving. ' +
+    'Various actions use up different amounts of energy : moving costs some energy, digging costs more, and shotting costs the most. ' +
+    'Shields are damaged when hit by the other player''s cannon. ' +
+    'Players can refuel at either base but can repair their shields only at their own bases.';
+  SInstructionsDetails4 = 'Controls: \n ' +
+    'Blue: W - up, A - left, S - down, D - right, E - shoot \n ' +
+    'Green: arrows key, CTRL - shoot';
   SInformation = 'Information';
+  SInformationDetails = 'Tunneler is written from scratch in Lazarus/FPC. ' +
+    'It is designed to be as similar as the original MS-DOS game (https://tunneler.org/) but also with some modern extensions. ' +
+    'The program uses standard canvas drawing with combination of low resolution fast pixel matrix. ' +
+    'It supports High DPI scaling. It supports up to eight players.';
+  SInformationDetails2 = 'This is a public domain open source program: feel free to copy it for friends and study the source code. \n ' +
+    'Homepage: https://app.zdechov.net/Tunneler';
   SWorldReady = 'World ready';
   SExit = 'Exit';
@@ -1186 +1207 @@
   Text: string;
   X: Integer;
+  Y: Integer;
+const
+  LineHeight = 60;
 begin
   with Bitmap.Canvas do begin
@@ -1193 +1217 @@
 
     X := Bitmap.Width div 2;
+    Y := Bitmap.Height div 20;
 
     Brush.Style := bsClear;
     Pen.Style := psSolid;
     Pen.Color := clWhite;
-    Font.Color := clTuna;
+    Font.Color := clGreen;
     Font.Size := 30;
     Text := SInformation;
-    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
+    TextOut(X - TextWidth(Text) div 2, Y, Text);
+    Inc(Y, 2 * LineHeight);
+
+    X := 30;
+
+    Font.Color := clYellow;
+    Font.Size := 20;
+    Text := SInformationDetails;
+    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
+    Inc(Y, LineHeight);
+
+    Text := SInformationDetails2;
+    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
+    Inc(Y, LineHeight);
+
+    X := Bitmap.Width div 2;
 
     Font.Color := clGreen;
@@ -1213 +1253 @@
   Text: string;
   X: Integer;
+  Y: Integer;
+const
+  LineHeight = 60;
 begin
   with Bitmap.Canvas do begin
@@ -1220 +1263 @@
 
     X := Bitmap.Width div 2;
+    Y := Bitmap.Height div 20;
 
     Brush.Style := bsClear;
@@ -1227 +1271 @@
     Font.Size := 30;
     Text := SInstructions;
-    TextOut(X - TextWidth(Text) div 2, Bitmap.Height div 10, Text);
-
+    TextOut(X - TextWidth(Text) div 2, Y, Text);
+    Inc(Y, 2 * LineHeight);
+
+    X := 30;
+
+    Font.Color := clTeal;
+    Font.Size := 20;
+    Text := SInstructionsDetails;
+    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
+    Inc(Y, LineHeight);
+
+    Text := SInstructionsDetails2;
+    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
+    Inc(Y, LineHeight);
+
+    Text := SInstructionsDetails3;
+    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
+    Inc(Y, LineHeight);
+
+    Text := SInstructionsDetails4;
+    Inc(Y, LineHeight * TextOutWordWrap(Bitmap.Canvas, X, Y, Text,  Bitmap.Width - 60));
+    Inc(Y, LineHeight);
+
+    X := Bitmap.Width div 2;
     Font.Color := clGreen;
     Font.Size := 30;
@@ -1295 +1361 @@
   FRedrawPending := True;
   FStateTime := Now;
+end;
+
+function TEngine.TextOutWordWrap(Canvas: TCanvas; X, Y: Integer; Text: string; Width: Integer): Integer;
+var
+  Parts: TStringArray;
+  I: Integer;
+  XX: Integer;
+begin
+  Result := 1;
+  XX := 0;
+  Parts := Explode(' ', Text);
+  for I := 0 to Length(Parts) - 1 do begin
+    if (X + XX + Canvas.TextWidth(Parts[I]) > Width) or (Parts[I] = '\n') then begin
+      Y := Y + Canvas.TextHeight(Parts[I]);
+      XX := 0;
+      Inc(Result);
+    end;
+    if Parts[I] = '\n' then Continue;
+    Canvas.TextOut(X + XX, Y, Parts[I]);
+    XX := XX + Canvas.TextWidth(Parts[I]) + Canvas.TextWidth(' ');
+  end;
 end;