jarroddavis68 · July 13, 2023 13:28 · Jun 20, 2022 · Jun 20, 2022
diff --git a/uSingleUnit.pas b/uSingleUnit.pas
@@ -0,0 +1,273 @@
+{==============================================================================
+  ____                   _
+ / ___| _ __   __ _ _ __| | __
+ \___ \| '_ \ / _` | '__| |/ /
+  ___) | |_) | (_| | |  |   <
+ |____/| .__/ \__,_|_|  |_|\_\
+       |_|   Game Toolkit™
+
+ Copyright © 2022 tinyBigGAMES™ LLC
+ All Rights Reserved.
+
+ Website: https://tinybiggames.com
+ Email  : [email protected]
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. The origin of this software must not be misrepresented; you must not
+   claim that you wrote the original software. If you use this software in
+   a product, an acknowledgment in the product documentation would be
+   appreciated but is not required.
+
+2. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+3. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in
+   the documentation and/or other materials provided with the
+   distribution.
+
+4. Neither the name of the copyright holder nor the names of its
+   contributors may be used to endorse or promote products derived
+   from this software without specific prior written permission.
+
+5. All video, audio, graphics and other content accessed through the
+   software in this distro is the property of the applicable content owner
+   and may be protected by applicable copyright law. This License gives
+   Customer no rights to such content, and Company disclaims any liability
+   for misuse of content.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+============================================================================= }
+
+unit uSingleUnit;
+
+interface
+
+uses
+  System.SysUtils,
+  System.IOUtils,
+  System.Classes;
+
+type
+
+  { TUnitSection }
+  TUnitSection = (usInterface, usImplementation);
+
+  { TSingleUnit }
+  TSingleUnit = class
+  protected
+    FFilename: string;
+    FCode: TStringList;
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+    procedure Open(const aFilename: string);
+    procedure Close;
+    procedure InsertTextFile(const aFilename: string);
+    procedure InsertUnitSection(const aFilename: string; aSection: TUnitSection);
+    procedure EmptyLine; overload;
+    procedure A(const aMsg: string; const aArgs: array of const); overload;
+  end;
+
+procedure Run;
+
+implementation
+
+{ TSingleUnit }
+constructor TSingleUnit.Create;
+begin
+  inherited;
+  FCode := TStringList.Create;
+end;
+
+destructor TSingleUnit.Destroy;
+begin
+  FreeAndNil(FCode);
+  inherited;
+end;
+
+procedure TSingleUnit.Open(const aFilename: string);
+begin
+  if aFilename.IsEmpty then Exit;
+  FFilename := aFilename;
+  FCode.Clear;
+end;
+
+procedure TSingleUnit.Close;
+begin
+  FCode.SaveToFile(FFilename);
+end;
+
+procedure TSingleUnit.InsertTextFile(const aFilename: string);
+var
+  LLine: string;
+  LTextFile: TStringList;
+begin
+  if not TFile.Exists(aFilename) then Exit;
+
+  LTextFile := TStringList.Create;
+  LTextFile.LoadFromFile(aFilename);
+
+  for LLine in LTextFile do
+  begin
+    FCode.Add(LLine);
+  end;
+
+  FreeAndNil(LTextFile);
+end;
+
+procedure TSingleUnit.InsertUnitSection(const aFilename: string; aSection: TUnitSection);
+var
+  LUnitFile: TStringList;
+  LLine,LText,LSection: string;
+  LFoundSection, LInsert: Boolean;
+begin
+  if not TFile.Exists(aFilename) then Exit;
+
+  A('{$REGION ''%s''}', [TPath.GetFileNameWithoutExtension(aFilename)]);
+
+  case aSection of
+    usInterface     : LSection := 'interface';
+    usImplementation: LSection := 'implementation';
+  end;
+
+  LUnitFile := TStringList.Create;
+  LUnitFile.LoadFromFile(aFilename);
+
+  LFoundSection := False;
+  LInsert := False;
+  for LLine in LUnitFile do
+  begin
+    LText := LLine.Trim;
+    if SameText(LText, LSection) then
+    begin
+      LFoundSection := True;
+      continue;
+    end;
+
+    if not LFoundSection then
+      continue;
+
+    if SameText(LText, 'const') or
+       SameText(LText, 'type')  or
+       SameText(LText, 'var') then
+      LInsert := True;
+
+    case aSection of
+      usInterface:
+        begin
+          if SameText(LText, 'implementation') then
+            break;
+
+        end;
+      usImplementation:
+        begin
+          if LText.StartsWith('{', true) or
+             LText.StartsWith('//', true) or
+             LText.StartsWith('(*', true) or
+             LText.StartsWith('constructor', true) or
+             LText.StartsWith('destructor', true) or
+             LText.StartsWith('procedure', true) or
+             LText.StartsWith('function', true) then
+           LInsert := True;
+
+          if SameText(LText, 'initialization') or
+             SameText(LText, 'finalization') or
+             SameText(LText, 'end.') then
+            break;
+        end;
+    end;
+
+    if not LInsert then
+      continue;
+
+    FCode.Add(LLine);
+
+  end;
+
+  A('{$ENDREGION}', []);
+
+  FreeAndNil(LUnitFile);
+end;
+
+procedure TSingleUnit.EmptyLine;
+begin
+  FCode.Add('');
+end;
+
+procedure TSingleUnit.A(const aMsg: string; const aArgs: array of const);
+begin
+  FCode.Add(Format(aMsg, aArgs));
+end;
+
+// Example of how to use
+procedure Run;
+var
+  SU: TSingleUnit;
+begin
+  SU := TSingleUnit.Create;
+  SU.Open('Spark.pas');
+  SU.InsertTextFile('sources\Header.inc');
+  SU.EmptyLine;
+  SU.A('unit Spark;', []);
+  SU.EmptyLine;
+  SU.A('interface', []);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.WinApi.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Allegro.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Math.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Utils.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.System.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Graphics.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Window.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Audio.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Game.pas', usInterface);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.pas', usInterface);
+  SU.EmptyLine;
+  SU.A('implementation', []);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Math.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Utils.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.System.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Graphics.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Window.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Audio.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.Game.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertUnitSection('sources\Spark.pas', usImplementation);
+  SU.EmptyLine;
+  SU.InsertTextFile('sources\Footer.inc');
+  SU.EmptyLine;
+  SU.A('end.', []);
+  SU.Close;
+  FreeAndNil(SU);
+end;
+
+end.