Load font from memory

parmaja · Jul 12, 2022 · 8769610 · 8769610
1 parent 86c216e
commit 8769610
Show file tree

Hide file tree

Showing 7 changed files with 129 additions and 36 deletions.
diff --git a/src/TyroEngines.pas b/src/TyroEngines.pas
@@ -240,7 +240,7 @@ procedure TTyroEngine.Init;
       if SysUtils.FileExists(RunFile) then
       begin
         if LeftStr(RunFile, 1) = '.' then
-          RunFile := ExpandFileName(WorkSpace + RunFile);
+          RunFile := ExpandFileName(Resources.WorkSpace + RunFile);
         aScript.AssetsFolder := ExtractFilePath(RunFile);
         aScript.LoadFile(RunFile);
         if RunInMain then

diff --git a/src/raylib/RayClasses.pas b/src/raylib/RayClasses.pas
@@ -140,6 +140,7 @@   TRayFont = class(TRayObject)
     constructor Create;
     destructor Destroy; override;
     procedure LoadFromFile(FileName: utf8string);
+    procedure LoadFromString(const DataString: rawbytestring; fontSize: Integer);
     procedure LoadDefault;
   end;
 
@@ -187,6 +188,17 @@ procedure TRayFont.LoadFromFile(FileName: utf8string);
   Data := LoadFont(PUTF8Char(FileName));
 end;
 
+procedure TRayFont.LoadFromString(const DataString: rawbytestring; fontSize: Integer);
+var
+  img: TImage;
+const
+  DEFAULT_FIRST_CHAR = 32;
+begin
+  img := LoadImageFromMemory('.png', PByte(DataString), Length(DataString));
+  Data := LoadFontFromImage(img, clMagenta, 32);
+  UnloadImage(img);
+end;
+
 { TRayAudio }
 
 constructor TRayAudio.Create(SampleRate: Cardinal; BitRate: Cardinal; Channels: Cardinal);

diff --git a/src/raylib/RayLib.pas b/src/raylib/RayLib.pas
@@ -1524,7 +1524,7 @@   TMatrix = record
   // Load image sequence from file (frames appended to image.data)
   LoadImageAnim: function(const fileName: PUTF8Char; frames: Integer): TImage; cdecl = nil;
   // Load image from memory buffer, fileType refers to extension: i.e. "png"
-  LoadImageFromMemory: function(const fileType: PUTF8Char; fileData: PByte; dataSize: Integer): TImage; cdecl = nil;
+  LoadImageFromMemory: function(const fileType: PUTF8Char; fileData: Pointer; dataSize: Integer): TImage; cdecl = nil;
   // Load image from GPU texture data
   LoadImageFromTexture: function(texture: TTexture2D): TImage; cdecl = nil;
   // Load image from screen buffer and (screenshot)

diff --git a/src/tyro.lpr b/src/tyro.lpr
@@ -194,9 +194,9 @@ constructor TTyroApplication.Create(AOwner: TComponent);
     Main.RunFile := Files[0];
   WorkPaths := GetOptionValues('w', 'workpath');
   if Length(WorkPaths) > 0  then
-    WorkSpace := WorkPaths[0]
+    Resources.WorkSpace := WorkPaths[0]
   else
-    WorkSpace := Location;
+    Resources.WorkSpace := Location;
 
   if IsConsole then
   begin

diff --git a/src/tyrolib/TyroClasses.pas b/src/tyrolib/TyroClasses.pas
@@ -53,7 +53,6 @@   TTyroCanvas = class abstract(TObject)
     FBackColor: TColor;
     FPenWidth: Integer;
     FWidth, FHeight: Integer;
-    Font: TRayFont;
     function GetPenAlpha: Byte;
     procedure SetPenAlpha(AValue: Byte);
     procedure SetHeight(AValue: Integer);
@@ -110,6 +109,24 @@   TTyroTextureCanvas = class(TTyroCanvas)
     property Texture: TRenderTexture2D read FTexture;
   end;
 
+  TTyroResource = class(TmnNamedObject)
+  public
+    ResType: string;
+    ResData: rawbytestring;
+    constructor Create(const AResName, AResType: string; const AResData: rawbytestring);
+  end;
+
+  TTyroResources = class(TmnNamedObjectList<TTyroResource>)
+  public
+    Font: TRayFont;
+    WorkSpace: utf8string;
+    function Find(const ResName, ResType: string): TTyroResource; overload;
+    procedure Load; virtual;
+    procedure Add(const ResName, ResType: string; const ResData: rawbytestring); overload;
+    constructor Create; virtual;
+    destructor Destroy; override;
+  end;
+
   function IntToColor(I: integer): TColor;
   function ColorToInt(C: TColor): integer;
 
@@ -122,7 +139,7 @@   TTyroTextureCanvas = class(TTyroCanvas)
   cFramePerSeconds = 60;
 
 var
-  WorkSpace: utf8string;
+  Resources: TTyroResources = nil;
   Lock: TCriticalSection = nil;
 
 implementation
@@ -220,7 +237,6 @@ procedure TTyroCanvas.SetWidth(AValue: Integer);
 constructor TTyroCanvas.Create(AWidth, AHeight: Integer);
 begin
   inherited Create;
-  Font := TRayFont.Create;
   FWidth := AWidth;
   FHeight := AHeight;
   FPenWidth := 1;
@@ -230,32 +246,6 @@ constructor TTyroCanvas.Create(AWidth, AHeight: Integer);
 //  FBackColor := TColor.CreateRGBA($77B5FEFF); //French Sky Blue
   FBackColor := clFrenchSkyBlue;
 
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'alpha_beta.png'));
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'Terminess-Bold.ttf'));
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'dejavu.fnt'));
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'DejaVuSansMono-Bold.ttf'));
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'terminus.ttf'));
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'fonts/Chroma.png'));
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'fonts/alpha_beta.png'));
-  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'fonts/ChiKareGo2.ttf'));
-  //Font := LoadFontEx(PUTF8Char(Main.WorkSpace + 'fonts/terminus.ttf'), 12, nil, 255);
-  //Font := LoadFontEx(PUTF8Char(Main.WorkSpace + 'fonts/AnonymousPro-Regular.ttf'), 12, nil, 255);
-  //Font := LoadFont(PUTF8Char('computer_pixel.fon.ttf'));
-
-  //Font := LoadFontEx(PUTF8Char(Main.WorkSpace + 'fonts/tahoma.ttf'), ScreenFontSize, nil, $FFFF); //Good for arabic but it take huge memory
-
-  if SysUtils.FileExists(WorkSpace + 'font.png') then
-  begin
-    Font.LoadFromFile(WorkSpace + 'font.png');
-    Font.Height := Font.Data.BaseSize;
-  end
-  else
-  begin
-    Font.LoadDefault;
-  end;
-
-  SetTextureFilter(Font.Data.texture, TEXTURE_FILTER_POINT);
-
   {BeginTextureMode(FTexture);
   ClearBackground(BackColor);
   DrawText(10, 10, 'Ready!');
@@ -264,7 +254,6 @@ constructor TTyroCanvas.Create(AWidth, AHeight: Integer);
 
 destructor TTyroCanvas.Destroy;
 begin
-  FreeAndNil(Font);
   inherited;
 end;
 
@@ -337,7 +326,7 @@ procedure TTyroCanvas.DrawRectangle(X, Y, AWidth, AHeight: Single; Color: TColor
 
 procedure TTyroCanvas.DrawText(X, Y: Integer; S: utf8string; Color: TColor);
 begin
-  RayLib.DrawTextEx(Font.Data, PUTF8Char(S), Vector2Of(x + FOriginX, y + FOriginY), Font.Height, 0, Color);
+  RayLib.DrawTextEx(Resources.Font.Data, PUTF8Char(S), Vector2Of(x + FOriginX, y + FOriginY), Resources.Font.Height, 0, Color);
 end;
 
 procedure TTyroCanvas.DrawPixel(X, Y: Integer; Color: TColor);
@@ -422,6 +411,92 @@ procedure TTyroTextureCanvas.EndDraw;
   inherited;
 end;
 
+{ TTyroResources }
+
+procedure TTyroResources.Add(const ResName, ResType: string; const ResData: rawbytestring);
+begin
+  Add(TTyroResource.Create(ResName, ResType, ResData));
+end;
+
+constructor TTyroResources.Create;
+begin
+  inherited;
+  Font := TRayFont.Create;
+end;
+
+destructor TTyroResources.Destroy;
+begin
+  FreeAndNil(Font);
+  if Resources = Self then
+    Resources := nil;
+  inherited;
+end;
+
+function TTyroResources.Find(const ResName, ResType: string): TTyroResource;
+var
+  i: Integer;
+begin
+  Result := nil;
+  for i := 0 to Count - 1 do
+  begin
+    if SameText(Items[i].Name, ResName) and SameText(Items[i].ResType, ResType)  then
+    begin
+      Result := Items[i];
+      break;
+    end;
+  end;
+end;
+
+procedure TTyroResources.Load;
+var
+  res: TTyroResource;
+begin
+  {$include 'font.inc'}
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'alpha_beta.png'));
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'Terminess-Bold.ttf'));
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'dejavu.fnt'));
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'DejaVuSansMono-Bold.ttf'));
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'terminus.ttf'));
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'fonts/Chroma.png'));
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'fonts/alpha_beta.png'));
+  //Font := LoadFont(PUTF8Char(Main.WorkSpace + 'fonts/ChiKareGo2.ttf'));
+  //Font := LoadFontEx(PUTF8Char(Main.WorkSpace + 'fonts/terminus.ttf'), 12, nil, 255);
+  //Font := LoadFontEx(PUTF8Char(Main.WorkSpace + 'fonts/AnonymousPro-Regular.ttf'), 12, nil, 255);
+  //Font := LoadFont(PUTF8Char('computer_pixel.fon.ttf'));
+
+  //Font := LoadFontEx(PUTF8Char(Main.WorkSpace + 'fonts/tahoma.ttf'), ScreenFontSize, nil, $FFFF); //Good for arabic but it take huge memory
+
+  res := Find('font', 'png');
+  if res <> nil then
+  begin
+    Font.LoadFromString(res.ResData, 16);
+    Font.Height := Font.Data.BaseSize * 2;
+  end
+  else if SysUtils.FileExists(WorkSpace + 'font.png') then
+  begin
+    Font.LoadFromFile(WorkSpace + 'font.png');
+    Font.Height := Font.Data.BaseSize * 2;
+  end
+  else
+  begin
+    Font.LoadDefault;
+  end;
+
+  SetTextureFilter(Font.Data.texture, TEXTURE_FILTER_POINT);
+end;
+
+{ TTyroResource }
+
+
+{ TTyroResource }
+
+constructor TTyroResource.Create(const AResName, AResType: string; const AResData: rawbytestring);
+begin
+  Name := AResName;
+  ResType := AResType;
+  ResData := AResData;
+end;
+
 initialization
   Lock := TCriticalSection.Create;
 finalization

diff --git a/src/tyrolib/TyroControls.pas b/src/tyrolib/TyroControls.pas
@@ -289,7 +289,6 @@ constructor TTyroMain.Create;
 begin
   inherited;
   FOptions := [moWindow, moOpaque];
-  WorkSpace := ExtractFilePath(ParamStr(0));
   RayLibrary.Load;
   FCanvasLock := TCriticalSection.Create;
   MarginSize := cMarginSize;
@@ -367,13 +366,19 @@ procedure TTyroMain.Loop;
 
 procedure TTyroMain.Run;
 begin
+  Resources := TTyroResources.Create;
+  Resources.WorkSpace := ExtractFilePath(ParamStr(0));
+
   Init;
+
   if not Visible and (moWindow in Options) then
   begin
     ShowWindow(cDefaultWindowWidth, cDefaultWindowHeight);
     SetFPS(cFramePerSeconds);
   end;
 
+  Resources.Load;
+
   Load;
   if FPS = 0 then
     SetFPS(cFramePerSeconds);

diff --git a/src/tyrolib/delphi/test/TestMaze.pas b/src/tyrolib/delphi/test/TestMaze.pas
@@ -217,6 +217,7 @@ procedure TMain.Init;
   Stack := TStack<TCell>.Create;
 
   ShowWindow(FWidth + MarginSize * 2, FHeight + MarginSize * 2);
+
   for var row in [0..FRows-1] do
     for var col in [0..FCols-1] do
       Cells.Add(TCell.Create(row, col, FCW));