├── .github
└── FUNDING.yml
├── .gitignore
├── LICENSE
├── README.md
├── examples
└── testbed
│ ├── Testbed.dpr
│ ├── Testbed.dproj
│ ├── Testbed.res
│ ├── Testbed_Icon.ico
│ ├── UCommon.pas
│ ├── UDemo.Buffer.pas
│ ├── UDemo.Effects.pas
│ ├── UDemo.SpaceInvaders.pas
│ ├── UDemo.Sprite.pas
│ ├── UDemo.StellarAssault.pas
│ ├── UDemo.StellarDefender.pas
│ └── UTestbed.pas
├── media
├── console.jpg
└── delphi.png
└── src
├── Console.Buffer.pas
├── Console.Defines.inc
├── Console.Sprite.pas
└── Console.pas
/.github/FUNDING.yml:
--------------------------------------------------------------------------------
1 | # These are supported funding model platforms
2 |
3 | github: tinyBigGAMES # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2]
4 | patreon: # Replace with a single Patreon username
5 | open_collective: # Replace with a single Open Collective username
6 | ko_fi: # Replace with a single Ko-fi username
7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel
8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry
9 | liberapay: # Replace with a single Liberapay username
10 | issuehunt: # Replace with a single IssueHunt username
11 | lfx_crowdfunding: # Replace with a single LFX Crowdfunding project-name e.g., cloud-foundry
12 | polar: # Replace with a single Polar username
13 | buy_me_a_coffee: # Replace with a single Buy Me a Coffee username
14 | thanks_dev: # Replace with a single thanks.dev username
15 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2']
16 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | # Uncomment these types if you want even more clean repository. But be careful.
2 | # It can make harm to an existing project source. Read explanations below.
3 | #
4 | # Resource files are binaries containing manifest, project icon and version info.
5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
6 | #*.res
7 | #
8 | # Type library file (binary). In old Delphi versions it should be stored.
9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
10 | #*.tlb
11 | #
12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
13 | # Uncomment this if you are not using diagrams or use newer Delphi version.
14 | #*.ddp
15 | #
16 | # Visual LiveBindings file. Added in Delphi XE2.
17 | # Uncomment this if you are not using LiveBindings Designer.
18 | #*.vlb
19 | #
20 | # Deployment Manager configuration file for your project. Added in Delphi XE2.
21 | # Uncomment this if it is not mobile development and you do not use remote debug feature.
22 | #*.deployproj
23 | #
24 | # C++ object files produced when C/C++ Output file generation is configured.
25 | # Uncomment this if you are not using external objects (zlib library for example).
26 | #*.obj
27 | #
28 |
29 | # Default Delphi compiler directories
30 | # Content of this directories are generated with each Compile/Construct of a project.
31 | # Most of the time, files here have not there place in a code repository.
32 | #Win32/
33 | #Win64/
34 | #OSX64/
35 | #OSXARM64/
36 | #Android/
37 | #Android64/
38 | #iOSDevice64/
39 | #Linux64/
40 |
41 | # Delphi compiler-generated binaries (safe to delete)
42 | *.exe
43 | *.dll
44 | *.bpl
45 | *.bpi
46 | *.dcp
47 | *.so
48 | *.apk
49 | *.drc
50 | *.map
51 | *.dres
52 | *.rsm
53 | *.tds
54 | *.dcu
55 | *.lib
56 | *.a
57 | *.o
58 | *.ocx
59 |
60 | # Delphi autogenerated files (duplicated info)
61 | *.cfg
62 | *.hpp
63 | *Resource.rc
64 |
65 | # Delphi local files (user-specific info)
66 | *.local
67 | *.identcache
68 | *.projdata
69 | *.tvsconfig
70 | *.dsk
71 |
72 | # Delphi history and backups
73 | __history/
74 | __recovery/
75 | *.~*
76 |
77 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi)
78 | *.stat
79 |
80 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss
81 | modules/
82 |
83 | *.dsv
84 | zip_latest_commit.cmd
85 | Console-main.zip
86 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | BSD 3-Clause License
2 |
3 | Copyright (c) 2025-present, tinyBigGAMES LLC
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | 1. Redistributions of source code must retain the above copyright notice, this
9 | list of conditions and the following disclaimer.
10 |
11 | 2. Redistributions in binary form must reproduce the above copyright notice,
12 | this list of conditions and the following disclaimer in the documentation
13 | and/or other materials provided with the distribution.
14 |
15 | 3. Neither the name of the copyright holder nor the names of its
16 | contributors may be used to endorse or promote products derived from
17 | this software without specific prior written permission.
18 |
19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
20 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
27 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
28 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | 
2 | [](https://discord.gg/tPWjMwK)
3 | [](https://bsky.app/profile/tinybiggames.com)
4 |
5 | # 🖥️ Console
6 |
7 | **Console** is a powerful static class that brings modern terminal capabilities to your Delphi Win32 console applications. From vibrant ANSI text formatting to precise cursor control and interactive input handling, it gives your apps a professional polish — all with zero dependencies and written entirely in Pascal.
8 |
9 | > ✨ Print. 🎞️ Animate. 🎮 Control.
10 | > All in pure 🐘 Delphi.
11 |
12 | ## 🚀 Features
13 |
14 | - 🎨 **ANSI Styling** – Set foreground/background colors, RGB or named, and bold text
15 | - 🖋️ **Formatted Output** – Print and PrintLn support standard arguments and text wrapping
16 | - ⌨️ **Input Handling** – Detect key presses/releases, read individual keys or typed input
17 | - 📺 **Cursor Management** – Move, show/hide, save/restore, and query cursor position
18 | - 🧼 **Screen Control** – Clear screen, lines, or portions of a line with color support
19 | - 🎬 **Teletype Simulation** – Animate output character-by-character with dynamic delays
20 | - 🎲 **Utility Methods** – Random values, terminal title management, safe delays, and more
21 | - 🧪 **Delphi IDE-aware** – Automatically adapts when run inside the Delphi IDE
22 |
23 | ## 📦 Usage
24 |
25 | ```pascal
26 | uses Console;
27 |
28 | begin
29 | TConsole.Init('My Console', POS_CENTER, POS_CENTER, 110, 30, 20);
30 | try
31 | TConsole.ClearScreen();
32 | TConsole.SetTitle('Demo');
33 | TConsole.PrintLn('Welcome to Console!');
34 | TConsole.Teletype(CSIFGGreen+'Simulated output... one char at a time.');
35 | TConsole.WaitForAnyKey();
36 | except
37 | TConsole.Shutdown();
38 | end;
39 | end.
40 | ```
41 |
42 | ## 🧱 API Overview
43 |
44 | ### 🖨 Output
45 | - `Print`, `PrintLn` – With or without arguments
46 | - `Teletype` – Simulate typewriter-style printing
47 | - `WrapTextEx` – Word-wrap long text intelligently
48 |
49 | ### 🎨 Styling
50 | - `SetForegroundColor`, `SetBackgroundColor` – Named ANSI colors
51 | - `SetForegroundRGB`, `SetBackgroundRGB` – Full RGB color support
52 | - `SetBoldText`, `ResetTextFormat` – Styling control
53 |
54 | ### 🎯 Cursor
55 | - `SetCursorPos`, `GetCursorPos` – Move or retrieve cursor position
56 | - `MoveCursorUp/Down/Forward/Back` – Relative movement
57 | - `SaveCursorPos`, `RestoreCursorPos`
58 | - `ShowCursor`, `HideCursor`, `SetCursorVisible`
59 |
60 | ### 🧼 Screen
61 | - `ClearScreen`, `ClearLine`, `ClearToEndOfLine`
62 | - `ClearLineFromCursor` – In color!
63 |
64 | ### ⌨️ Input
65 | - `ReadKey`, `ReadLnX` – Get typed characters
66 | - `WaitForAnyKey`, `AnyKeyPressed`
67 | - `IsKeyPressed`, `WasKeyPressed`, `WasKeyReleased`
68 | - `ClearKeyStates`, `ClearKeyboardBuffer`
69 |
70 | ### 🛠 Utilities
71 | - `SetTitle`, `GetTitle`
72 | - `GetSize` – Terminal width and height
73 | - `Pause` – Print a pause message and wait
74 | - `Wait` – Delay in milliseconds
75 | - `RandomBool`, `RandomRange`
76 |
77 | ### 🧠 Environment-Aware
78 | - `HasOutput` – Detect if console has valid output stream
79 | - `WasRunFrom`, `IsStartedFromDelphiIDE` – Detect development environment
80 |
81 | ## 📋 Requirements
82 |
83 | - Should work with any Delphi version with Unicode support.
84 | - **Windows 10+ Console** with ANSI support (Virtual Terminal Sequences)
85 | - Developed and tested using **Delphi 12.3**, Windows 11 (64 bits)
86 |
87 | ## 📁 Project Structure
88 |
89 | - `Console.pas` – Main unit (pure static class)
90 | - No dependencies, no DLLs, no third-party units — just drop it in and go.
91 |
92 | ## 🖼️ Media
93 | **Console demos**
94 |
95 | [](https://www.youtube.com/watch?v=5NAvbLvyK28)
96 | *click image to [open video](https://www.youtube.com/watch?v=5NAvbLvyK28)*
97 |
98 |
99 |
100 | > 🚧️ **This repository is currently under construction.**
101 | >
102 | > Console is actively being developed. Features, APIs, and internal structure are subject to change.
103 | >
104 | > Contributions, feedback, and issue reports are welcome as the project evolves.
105 |
106 |
107 | ## 🛠️ Support and Resources
108 |
109 | - 🐞 **Report issues** via the [Issue Tracker](https://github.com/tinyBigGAMES/Console/issues).
110 | - 💬 **Engage in discussions** on the [Forum](https://github.com/tinyBigGAMES/Console/discussions) and [Discord](https://discord.gg/tPWjMwK).
111 | - 📚 **Learn more** at [Learn Delphi](https://learndelphi.org).
112 |
113 | ## 🤝 Contributing
114 |
115 | Contributions to **✨ Console** are highly encouraged! 🌟
116 | - 🐛 **Report Issues:** Submit issues if you encounter bugs or need help.
117 | - 💡 **Suggest Features:** Share your ideas to make **Console** even better.
118 | - 🔧 **Create Pull Requests:** Help expand the capabilities and robustness of the library.
119 |
120 | Your contributions make a difference! 🙌✨
121 |
122 | #### Contributors 👥🤝
123 |
124 |
125 |
126 |
127 |
128 |
129 | ## 📜 Licensing
130 |
131 | **Console** is distributed under the **🆓 BSD-3-Clause License**, allowing for redistribution and use in both source and binary forms, with or without modification, under specific conditions.
132 | See the [📜 LICENSE](https://github.com/tinyBigGAMES/Console?tab=BSD-3-Clause-1-ov-file#BSD-3-Clause-1-ov-file) file for more details.
133 |
134 | ---
135 |
136 | 🖥️ Console — Modern Console Power for Delphi. ✨ Print. 🎞️ Animate. 🎮 Control. All in pure 🐘 Pascal.
137 |
138 |
139 |
140 |
141 |
142 |
143 | Made with ❤️ in Delphi
--------------------------------------------------------------------------------
/examples/testbed/Testbed.dpr:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 | ===============================================================================}
15 |
16 | program Testbed;
17 |
18 | //{$APPTYPE CONSOLE}
19 | {$APPTYPE GUI}
20 |
21 | {$R *.res}
22 |
23 | uses
24 | System.SysUtils,
25 | Console in '..\..\src\Console.pas',
26 | UTestbed in 'UTestbed.pas',
27 | Console.Buffer in '..\..\src\Console.Buffer.pas',
28 | UDemo.Buffer in 'UDemo.Buffer.pas',
29 | UDemo.SpaceInvaders in 'UDemo.SpaceInvaders.pas',
30 | UDemo.StellarAssault in 'UDemo.StellarAssault.pas',
31 | UDemo.Sprite in 'UDemo.Sprite.pas',
32 | UDemo.StellarDefender in 'UDemo.StellarDefender.pas',
33 | UCommon in 'UCommon.pas',
34 | Console.Sprite in '..\..\src\Console.Sprite.pas';
35 |
36 | begin
37 | RunTests();
38 | end.
39 |
--------------------------------------------------------------------------------
/examples/testbed/Testbed.dproj:
--------------------------------------------------------------------------------
1 |
2 |
3 | {5910F10E-5BF6-443C-95C6-02B1FA88E2C9}
4 | 20.3
5 | None
6 | True
7 | Debug
8 | Win64
9 | Testbed
10 | 2
11 | Console
12 | Testbed.dpr
13 |
14 |
15 | true
16 |
17 |
18 | true
19 | Base
20 | true
21 |
22 |
23 | true
24 | Base
25 | true
26 |
27 |
28 | true
29 | Base
30 | true
31 |
32 |
33 | true
34 | Cfg_1
35 | true
36 | true
37 |
38 |
39 | true
40 | Cfg_1
41 | true
42 | true
43 |
44 |
45 | true
46 | Base
47 | true
48 |
49 |
50 | true
51 | Cfg_2
52 | true
53 | true
54 |
55 |
56 | .\$(Platform)\$(Config)
57 | .\$(Platform)\$(Config)
58 | false
59 | false
60 | false
61 | false
62 | false
63 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
64 | Testbed
65 |
66 |
67 | RaizeComponentsVcl;vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;SVGIconImageListRestClient;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;JclVcl;soapmidas;SVGIconImageListFMX;vclactnband;fmxFireDAC;dbexpress;Jcl;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;Skia.Package.FMX;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;JclDeveloperTools;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;JclContainers;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;SVGIconImageList;soapserver;FireDACIBDriver;$(DCC_UsePackage)
68 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
69 | Debug
70 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
71 | 1033
72 | true
73 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
74 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
75 |
76 |
77 | RaizeComponentsVcl;vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;SVGIconImageListRestClient;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;soapmidas;SVGIconImageListFMX;vclactnband;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;DatasnapConnectorsFreePascal;soaprtl;SVGIconImageList;soapserver;FireDACIBDriver;$(DCC_UsePackage)
78 | true
79 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
80 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
81 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
82 | Debug
83 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
84 | 1033
85 | ..\..\bin
86 | $(BDS)\bin\default_app.manifest
87 | PerMonitorV2
88 | Testbed_Icon.ico
89 |
90 |
91 | DEBUG;$(DCC_Define)
92 | true
93 | false
94 | true
95 | true
96 | true
97 | true
98 | true
99 |
100 |
101 | false
102 |
103 |
104 | 1033
105 |
106 |
107 | false
108 | RELEASE;$(DCC_Define)
109 | 0
110 | 0
111 |
112 |
113 | 1033
114 |
115 |
116 |
117 | MainSource
118 |
119 |
120 |
121 |
122 |
123 |
124 |
125 |
126 |
127 |
128 |
129 |
130 | Base
131 |
132 |
133 | Cfg_1
134 | Base
135 |
136 |
137 | Cfg_2
138 | Base
139 |
140 |
141 |
142 | Delphi.Personality.12
143 | Application
144 |
145 |
146 |
147 | Testbed.dpr
148 |
149 |
150 | Embarcadero C++Builder Office 2000 Servers Package
151 | Embarcadero C++Builder Office XP Servers Package
152 | Microsoft Office 2000 Sample Automation Server Wrapper Components
153 | Microsoft Office XP Sample Automation Server Wrapper Components
154 |
155 |
156 |
157 |
158 |
159 | true
160 |
161 |
162 |
163 |
164 | true
165 |
166 |
167 |
168 |
169 | true
170 |
171 |
172 |
173 |
174 | Testbed.exe
175 | true
176 |
177 |
178 |
179 |
180 | Testbed.exe
181 | true
182 |
183 |
184 |
185 |
186 | Testbed.rsm
187 | true
188 |
189 |
190 |
191 |
192 | Testbed.exe
193 | true
194 |
195 |
196 |
197 |
198 | 1
199 |
200 |
201 | Contents\MacOS
202 | 1
203 |
204 |
205 | 0
206 |
207 |
208 |
209 |
210 | res\xml
211 | 1
212 |
213 |
214 | res\xml
215 | 1
216 |
217 |
218 |
219 |
220 | library\lib\armeabi
221 | 1
222 |
223 |
224 | library\lib\armeabi
225 | 1
226 |
227 |
228 |
229 |
230 | library\lib\armeabi-v7a
231 | 1
232 |
233 |
234 |
235 |
236 | library\lib\mips
237 | 1
238 |
239 |
240 | library\lib\mips
241 | 1
242 |
243 |
244 |
245 |
246 | library\lib\armeabi-v7a
247 | 1
248 |
249 |
250 | library\lib\arm64-v8a
251 | 1
252 |
253 |
254 |
255 |
256 | library\lib\armeabi-v7a
257 | 1
258 |
259 |
260 |
261 |
262 | res\drawable
263 | 1
264 |
265 |
266 | res\drawable
267 | 1
268 |
269 |
270 |
271 |
272 | res\drawable-anydpi-v21
273 | 1
274 |
275 |
276 | res\drawable-anydpi-v21
277 | 1
278 |
279 |
280 |
281 |
282 | res\values
283 | 1
284 |
285 |
286 | res\values
287 | 1
288 |
289 |
290 |
291 |
292 | res\values-v21
293 | 1
294 |
295 |
296 | res\values-v21
297 | 1
298 |
299 |
300 |
301 |
302 | res\values-v31
303 | 1
304 |
305 |
306 | res\values-v31
307 | 1
308 |
309 |
310 |
311 |
312 | res\values-v35
313 | 1
314 |
315 |
316 | res\values-v35
317 | 1
318 |
319 |
320 |
321 |
322 | res\drawable-anydpi-v26
323 | 1
324 |
325 |
326 | res\drawable-anydpi-v26
327 | 1
328 |
329 |
330 |
331 |
332 | res\drawable
333 | 1
334 |
335 |
336 | res\drawable
337 | 1
338 |
339 |
340 |
341 |
342 | res\drawable
343 | 1
344 |
345 |
346 | res\drawable
347 | 1
348 |
349 |
350 |
351 |
352 | res\drawable
353 | 1
354 |
355 |
356 | res\drawable
357 | 1
358 |
359 |
360 |
361 |
362 | res\drawable-anydpi-v33
363 | 1
364 |
365 |
366 | res\drawable-anydpi-v33
367 | 1
368 |
369 |
370 |
371 |
372 | res\values
373 | 1
374 |
375 |
376 | res\values
377 | 1
378 |
379 |
380 |
381 |
382 | res\values-night-v21
383 | 1
384 |
385 |
386 | res\values-night-v21
387 | 1
388 |
389 |
390 |
391 |
392 | res\drawable
393 | 1
394 |
395 |
396 | res\drawable
397 | 1
398 |
399 |
400 |
401 |
402 | res\drawable-xxhdpi
403 | 1
404 |
405 |
406 | res\drawable-xxhdpi
407 | 1
408 |
409 |
410 |
411 |
412 | res\drawable-xxxhdpi
413 | 1
414 |
415 |
416 | res\drawable-xxxhdpi
417 | 1
418 |
419 |
420 |
421 |
422 | res\drawable-ldpi
423 | 1
424 |
425 |
426 | res\drawable-ldpi
427 | 1
428 |
429 |
430 |
431 |
432 | res\drawable-mdpi
433 | 1
434 |
435 |
436 | res\drawable-mdpi
437 | 1
438 |
439 |
440 |
441 |
442 | res\drawable-hdpi
443 | 1
444 |
445 |
446 | res\drawable-hdpi
447 | 1
448 |
449 |
450 |
451 |
452 | res\drawable-xhdpi
453 | 1
454 |
455 |
456 | res\drawable-xhdpi
457 | 1
458 |
459 |
460 |
461 |
462 | res\drawable-mdpi
463 | 1
464 |
465 |
466 | res\drawable-mdpi
467 | 1
468 |
469 |
470 |
471 |
472 | res\drawable-hdpi
473 | 1
474 |
475 |
476 | res\drawable-hdpi
477 | 1
478 |
479 |
480 |
481 |
482 | res\drawable-xhdpi
483 | 1
484 |
485 |
486 | res\drawable-xhdpi
487 | 1
488 |
489 |
490 |
491 |
492 | res\drawable-xxhdpi
493 | 1
494 |
495 |
496 | res\drawable-xxhdpi
497 | 1
498 |
499 |
500 |
501 |
502 | res\drawable-xxxhdpi
503 | 1
504 |
505 |
506 | res\drawable-xxxhdpi
507 | 1
508 |
509 |
510 |
511 |
512 | res\drawable-small
513 | 1
514 |
515 |
516 | res\drawable-small
517 | 1
518 |
519 |
520 |
521 |
522 | res\drawable-normal
523 | 1
524 |
525 |
526 | res\drawable-normal
527 | 1
528 |
529 |
530 |
531 |
532 | res\drawable-large
533 | 1
534 |
535 |
536 | res\drawable-large
537 | 1
538 |
539 |
540 |
541 |
542 | res\drawable-xlarge
543 | 1
544 |
545 |
546 | res\drawable-xlarge
547 | 1
548 |
549 |
550 |
551 |
552 | res\values
553 | 1
554 |
555 |
556 | res\values
557 | 1
558 |
559 |
560 |
561 |
562 | res\drawable-anydpi-v24
563 | 1
564 |
565 |
566 | res\drawable-anydpi-v24
567 | 1
568 |
569 |
570 |
571 |
572 | res\drawable
573 | 1
574 |
575 |
576 | res\drawable
577 | 1
578 |
579 |
580 |
581 |
582 | res\drawable-night-anydpi-v21
583 | 1
584 |
585 |
586 | res\drawable-night-anydpi-v21
587 | 1
588 |
589 |
590 |
591 |
592 | res\drawable-anydpi-v31
593 | 1
594 |
595 |
596 | res\drawable-anydpi-v31
597 | 1
598 |
599 |
600 |
601 |
602 | res\drawable-night-anydpi-v31
603 | 1
604 |
605 |
606 | res\drawable-night-anydpi-v31
607 | 1
608 |
609 |
610 |
611 |
612 | 1
613 |
614 |
615 | Contents\MacOS
616 | 1
617 |
618 |
619 | 0
620 |
621 |
622 |
623 |
624 | Contents\MacOS
625 | 1
626 | .framework
627 |
628 |
629 | Contents\MacOS
630 | 1
631 | .framework
632 |
633 |
634 | Contents\MacOS
635 | 1
636 | .framework
637 |
638 |
639 | 0
640 |
641 |
642 |
643 |
644 | 1
645 | .dylib
646 |
647 |
648 | 1
649 | .dylib
650 |
651 |
652 | 1
653 | .dylib
654 |
655 |
656 | Contents\MacOS
657 | 1
658 | .dylib
659 |
660 |
661 | Contents\MacOS
662 | 1
663 | .dylib
664 |
665 |
666 | Contents\MacOS
667 | 1
668 | .dylib
669 |
670 |
671 | 0
672 | .dll;.bpl
673 |
674 |
675 |
676 |
677 | 1
678 | .dylib
679 |
680 |
681 | 1
682 | .dylib
683 |
684 |
685 | 1
686 | .dylib
687 |
688 |
689 | Contents\MacOS
690 | 1
691 | .dylib
692 |
693 |
694 | Contents\MacOS
695 | 1
696 | .dylib
697 |
698 |
699 | Contents\MacOS
700 | 1
701 | .dylib
702 |
703 |
704 | 0
705 | .bpl
706 |
707 |
708 |
709 |
710 | 0
711 |
712 |
713 | 0
714 |
715 |
716 | 0
717 |
718 |
719 | 0
720 |
721 |
722 | 0
723 |
724 |
725 | Contents\Resources\StartUp\
726 | 0
727 |
728 |
729 | Contents\Resources\StartUp\
730 | 0
731 |
732 |
733 | Contents\Resources\StartUp\
734 | 0
735 |
736 |
737 | 0
738 |
739 |
740 |
741 |
742 | 1
743 |
744 |
745 | 1
746 |
747 |
748 |
749 |
750 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
751 | 1
752 |
753 |
754 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
755 | 1
756 |
757 |
758 |
759 |
760 | ..\
761 | 1
762 |
763 |
764 | ..\
765 | 1
766 |
767 |
768 | ..\
769 | 1
770 |
771 |
772 |
773 |
774 | Contents
775 | 1
776 |
777 |
778 | Contents
779 | 1
780 |
781 |
782 | Contents
783 | 1
784 |
785 |
786 |
787 |
788 | Contents\Resources
789 | 1
790 |
791 |
792 | Contents\Resources
793 | 1
794 |
795 |
796 | Contents\Resources
797 | 1
798 |
799 |
800 |
801 |
802 | library\lib\armeabi-v7a
803 | 1
804 |
805 |
806 | library\lib\arm64-v8a
807 | 1
808 |
809 |
810 | 1
811 |
812 |
813 | 1
814 |
815 |
816 | 1
817 |
818 |
819 | 1
820 |
821 |
822 | Contents\MacOS
823 | 1
824 |
825 |
826 | Contents\MacOS
827 | 1
828 |
829 |
830 | Contents\MacOS
831 | 1
832 |
833 |
834 | 0
835 |
836 |
837 |
838 |
839 | library\lib\armeabi-v7a
840 | 1
841 |
842 |
843 |
844 |
845 | 1
846 |
847 |
848 | 1
849 |
850 |
851 | 1
852 |
853 |
854 |
855 |
856 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
857 | 1
858 |
859 |
860 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
861 | 1
862 |
863 |
864 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
865 | 1
866 |
867 |
868 |
869 |
870 | ..\
871 | 1
872 |
873 |
874 | ..\
875 | 1
876 |
877 |
878 | ..\
879 | 1
880 |
881 |
882 |
883 |
884 | 1
885 |
886 |
887 | 1
888 |
889 |
890 | 1
891 |
892 |
893 |
894 |
895 | ..\$(PROJECTNAME).launchscreen
896 | 64
897 |
898 |
899 | ..\$(PROJECTNAME).launchscreen
900 | 64
901 |
902 |
903 |
904 |
905 | 1
906 |
907 |
908 | 1
909 |
910 |
911 | 1
912 |
913 |
914 |
915 |
916 | Assets
917 | 1
918 |
919 |
920 | Assets
921 | 1
922 |
923 |
924 |
925 |
926 | Assets
927 | 1
928 |
929 |
930 | Assets
931 | 1
932 |
933 |
934 |
935 |
936 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
937 | 1
938 |
939 |
940 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
941 | 1
942 |
943 |
944 |
945 |
946 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
947 | 1
948 |
949 |
950 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
951 | 1
952 |
953 |
954 |
955 |
956 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
957 | 1
958 |
959 |
960 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
961 | 1
962 |
963 |
964 |
965 |
966 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
967 | 1
968 |
969 |
970 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
971 | 1
972 |
973 |
974 |
975 |
976 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
977 | 1
978 |
979 |
980 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
981 | 1
982 |
983 |
984 |
985 |
986 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
987 | 1
988 |
989 |
990 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
991 | 1
992 |
993 |
994 |
995 |
996 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
997 | 1
998 |
999 |
1000 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1001 | 1
1002 |
1003 |
1004 |
1005 |
1006 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1007 | 1
1008 |
1009 |
1010 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1011 | 1
1012 |
1013 |
1014 |
1015 |
1016 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1017 | 1
1018 |
1019 |
1020 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1021 | 1
1022 |
1023 |
1024 |
1025 |
1026 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1027 | 1
1028 |
1029 |
1030 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1031 | 1
1032 |
1033 |
1034 |
1035 |
1036 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1037 | 1
1038 |
1039 |
1040 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1041 | 1
1042 |
1043 |
1044 |
1045 |
1046 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1047 | 1
1048 |
1049 |
1050 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1051 | 1
1052 |
1053 |
1054 |
1055 |
1056 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1057 | 1
1058 |
1059 |
1060 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1061 | 1
1062 |
1063 |
1064 |
1065 |
1066 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1067 | 1
1068 |
1069 |
1070 | ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset
1071 | 1
1072 |
1073 |
1074 |
1075 |
1076 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1077 | 1
1078 |
1079 |
1080 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1081 | 1
1082 |
1083 |
1084 |
1085 |
1086 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1087 | 1
1088 |
1089 |
1090 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1091 | 1
1092 |
1093 |
1094 |
1095 |
1096 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1097 | 1
1098 |
1099 |
1100 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1101 | 1
1102 |
1103 |
1104 |
1105 |
1106 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1107 | 1
1108 |
1109 |
1110 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1111 | 1
1112 |
1113 |
1114 |
1115 |
1116 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1117 | 1
1118 |
1119 |
1120 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1121 | 1
1122 |
1123 |
1124 |
1125 |
1126 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1127 | 1
1128 |
1129 |
1130 | ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset
1131 | 1
1132 |
1133 |
1134 |
1135 |
1136 |
1137 |
1138 |
1139 |
1140 |
1141 |
1142 |
1143 |
1144 |
1145 |
1146 |
1147 |
1148 | False
1149 | True
1150 |
1151 |
1152 | 12
1153 |
1154 |
1155 |
1156 |
1157 |
1158 |
--------------------------------------------------------------------------------
/examples/testbed/Testbed.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/tinyBigGAMES/Console/8f1d28c961fc4b746cd12a83a11575c0838d5065/examples/testbed/Testbed.res
--------------------------------------------------------------------------------
/examples/testbed/Testbed_Icon.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/tinyBigGAMES/Console/8f1d28c961fc4b746cd12a83a11575c0838d5065/examples/testbed/Testbed_Icon.ico
--------------------------------------------------------------------------------
/examples/testbed/UCommon.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 | ===============================================================================}
15 |
16 | unit UCommon;
17 |
18 | interface
19 |
20 | uses
21 | System.SysUtils,
22 | Console;
23 |
24 | procedure ClearInput();
25 | function IfThen(const Condition: Boolean; const TrueValue, FalseValue: string): string;
26 |
27 | implementation
28 |
29 | procedure ClearInput();
30 | begin
31 | while (TConsole.IsKeyPressed(VK_ESC) = True) or (TConsole.IsKeyPressed(Ord('S')) = True) do
32 | begin
33 | TConsole.ProcessMessages();
34 | end;
35 | TConsole.ClearKeyStates();
36 | end;
37 |
38 | function IfThen(const Condition: Boolean; const TrueValue, FalseValue: string): string;
39 | begin
40 | if Condition then
41 | Result := TrueValue
42 | else
43 | Result := FalseValue;
44 | end;
45 |
46 | end.
47 |
--------------------------------------------------------------------------------
/examples/testbed/UDemo.Buffer.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 | ===============================================================================}
15 |
16 | unit UDemo.Buffer;
17 |
18 | interface
19 |
20 | uses
21 | WinApi.Windows,
22 | System.SysUtils,
23 | Console,
24 | Console.Buffer;
25 |
26 | procedure Demo_AsciiBuffer;
27 |
28 | implementation
29 |
30 | procedure Demo_AsciiBuffer;
31 | var
32 | Buffer: TAsciiBuffer;
33 | X, Y, DX, DY: Integer;
34 | MaxW, MaxH: Integer;
35 | KeyPressed: Boolean;
36 | StatusLine: string;
37 | LastX, LastY: Integer;
38 | StarChar: WideChar;
39 | LocalFrameCount: Integer; // Added local frame counter
40 | begin
41 | TConsole.SetTitle('TConsole: ASCII Buffer Demo');
42 |
43 | TConsole.ClearScreen();
44 | TConsole.SetCursorVisible(False);
45 | TConsole.GetSize(@MaxW, @MaxH);
46 |
47 | Buffer := TAsciiBuffer.Create(MaxW, MaxH);
48 | try
49 | // Request higher frame rate
50 | Buffer.TargetFPS := 120; // Aim higher than 60 to account for overhead
51 |
52 | // Initial setup
53 | X := 10;
54 | Y := 5;
55 | DX := 1;
56 | DY := 1;
57 | //LastX := X;
58 | //LastY := Y;
59 | StarChar := '*';
60 | LocalFrameCount := 0; // Initialize frame counter
61 |
62 | // Initial clear of the buffer - do this only once
63 | Buffer.Clear(' ', CSIDim+CSIFGWhite, CSIBGBlack);
64 |
65 | // Draw initial position
66 | Buffer.PutChar(X, Y, StarChar, CSIFGGreen, CSIBGBlack);
67 |
68 | KeyPressed := False;
69 | while not KeyPressed do
70 | begin
71 | // Check for keypress without waiting
72 | KeyPressed := TConsole.AnyKeyPressed;
73 |
74 | // Wait for next frame timing
75 | if Buffer.BeginFrame then
76 | begin
77 | // Increment frame counter
78 | Inc(LocalFrameCount);
79 |
80 | // Remember last position before updating
81 | LastX := X;
82 | LastY := Y;
83 |
84 | // Update position
85 | Inc(X, DX);
86 | Inc(Y, DY);
87 |
88 | // Handle collisions
89 | if (X <= 0) or (X >= Buffer.Width - 1) then DX := -DX;
90 | if (Y <= 0) or (Y >= Buffer.Height - 1) then DY := -DY;
91 |
92 | // Clear only the previous position
93 | Buffer.PutChar(LastX, LastY, ' ', CSIDim+CSIFGWhite, CSIBGBlack);
94 |
95 | // Draw at new position
96 | Buffer.PutChar(X, Y, StarChar, CSIFGGreen, CSIBGBlack);
97 |
98 | // Only update status every few frames to reduce overhead
99 | if LocalFrameCount mod 10 = 0 then
100 | begin
101 | // Display status info at bottom of screen
102 | StatusLine := Format('Position: (%d,%d) FPS: %.1f Target: %d',
103 | [X, Y, Buffer.ActualFPS, Buffer.TargetFPS]);
104 |
105 | // Only update status line if it changed
106 | for var i := 0 to Length(StatusLine) - 1 do
107 | if i < Buffer.Width then
108 | Buffer.PutChar(i, Buffer.Height - 1, StatusLine[i+1], CSIFGYellow, CSIBGBlack);
109 | end;
110 |
111 | // Finalize frame
112 | Buffer.EndFrame;
113 | end;
114 | end;
115 | finally
116 | Buffer.Free;
117 | TConsole.SetCursorVisible(True);
118 | TConsole.ClearScreen();
119 | end;
120 | end;
121 |
122 | end.
123 |
--------------------------------------------------------------------------------
/examples/testbed/UDemo.SpaceInvaders.pas:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/tinyBigGAMES/Console/8f1d28c961fc4b746cd12a83a11575c0838d5065/examples/testbed/UDemo.SpaceInvaders.pas
--------------------------------------------------------------------------------
/examples/testbed/UDemo.Sprite.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 | ===============================================================================}
15 |
16 | unit UDemo.Sprite;
17 |
18 | interface
19 |
20 | uses
21 | System.SysUtils,
22 | System.Classes,
23 | System.Math,
24 | Winapi.Windows,
25 | Console,
26 | Console.Buffer,
27 | Console.Sprite;
28 |
29 | procedure Demo_Sprite;
30 |
31 | implementation
32 |
33 | var
34 | PlayerSprite, EnemySprite, ExplosionSprite: TAsciiSprite;
35 | LargeShipSprite, AsteroidSprite, BossSprite: TAsciiSprite;
36 |
37 | // Create and initialize the sprites
38 | procedure InitSprites;
39 | var
40 | I: Integer;
41 | begin
42 | // Create player ship sprite (5x3)
43 | PlayerSprite := TAsciiSprite.Create(5, 3);
44 | PlayerSprite.LoadFromString(
45 | ' ^ ' + #13#10 +
46 | ' /|\ ' + #13#10 +
47 | '/===\',
48 | CSIFGCyan, CSIBGBlack);
49 |
50 | // Create enemy ship sprite (5x3)
51 | EnemySprite := TAsciiSprite.Create(5, 3);
52 | EnemySprite.LoadFromString(
53 | '\===/' + #13#10 +
54 | ' \|/ ' + #13#10 +
55 | ' v ',
56 | CSIFGRed, CSIBGBlack);
57 |
58 | // Create explosion sprite (5x3)
59 | ExplosionSprite := TAsciiSprite.Create(5, 3);
60 | ExplosionSprite.LoadFromString(
61 | '\* */' + #13#10 +
62 | ' *** ' + #13#10 +
63 | '/* *\',
64 | CSIFGYellow, CSIBGBlack);
65 |
66 | // Create a larger spaceship (15x7)
67 | LargeShipSprite := TAsciiSprite.Create(15, 7);
68 | LargeShipSprite.LoadFromString(
69 | ' /^\ ' + #13#10 +
70 | ' /___\ ' + #13#10 +
71 | ' /| |\ ' + #13#10 +
72 | ' __/||---||\\_ ' + #13#10 +
73 | '/___||___||___\' + #13#10 +
74 | ' \|___|/ ' + #13#10 +
75 | ' \___/ ',
76 | CSIFGCyan, CSIBGBlack);
77 |
78 | // Create an asteroid sprite (10x5)
79 | AsteroidSprite := TAsciiSprite.Create(10, 5);
80 | AsteroidSprite.LoadFromString(
81 | ' __ ' + #13#10 +
82 | ' _/ \_ ' + #13#10 +
83 | ' / \ ' + #13#10 +
84 | ' \__/\__/ ' + #13#10 +
85 | ' \/ ',
86 | CSIFGWhite, CSIBGBlack);
87 |
88 | // Create a boss enemy sprite (15x10)
89 | BossSprite := TAsciiSprite.Create(15, 10);
90 | BossSprite.LoadFromString(
91 | ' /=======\ ' + #13#10 +
92 | ' / _______ \ ' + #13#10 +
93 | ' //| |\ \' + #13#10 +
94 | '|| | (O) | ||' + #13#10 +
95 | '||/ \||' + #13#10 +
96 | '||\_______/||' + #13#10 +
97 | ' \\\=====/// ' + #13#10 +
98 | ' \||| |||/ ' + #13#10 +
99 | ' ||| ||| ' + #13#10 +
100 | ' \\\_/// ',
101 | CSIFGRed, CSIBGBlack);
102 |
103 | // Add color variations within a sprite
104 | BossSprite.SetChar(7, 3, 'O', CSIFGYellow, CSIBGBlack); // Yellow eye
105 |
106 | // Highlight a row
107 |
108 | for I := 0 to 14 do
109 | BossSprite.SetChar(I, 6, '=', CSIFGRed + CSIBold, CSIBGBlack);
110 | end;
111 |
112 | procedure Demo_Sprite;
113 | var
114 | Buffer: TAsciiBuffer;
115 | MaxW, MaxH: Integer;
116 | Running: Boolean;
117 | Time: Integer;
118 | X, Y: Integer;
119 | FPSStr: string;
120 | InstructionStr: string;
121 | I: Integer;
122 | begin
123 | TConsole.SetTitle('TConsole: Sprite Demo');
124 |
125 | TConsole.ClearKeyStates();
126 | TConsole.ClearScreen();
127 | TConsole.SetCursorVisible(False);
128 | TConsole.GetSize(@MaxW, @MaxH);
129 |
130 | // Create buffer
131 | Buffer := TAsciiBuffer.Create(MaxW, MaxH);
132 |
133 | try
134 | // Initialize sprites
135 | InitSprites;
136 |
137 | // Set frame rate
138 | Buffer.TargetFPS := 60;
139 |
140 | // Main loop
141 | Running := True;
142 | Time := 0;
143 |
144 | while Running do
145 | begin
146 | // Check for exit key
147 | if TConsole.AnyKeyPressed() then
148 | Running := False;
149 |
150 | // Wait for next frame
151 | if Buffer.BeginFrame then
152 | begin
153 | // Clear buffer
154 | Buffer.Clear(' ', CSIFGWhite, CSIBGBlack);
155 |
156 | // Increment time
157 | Inc(Time);
158 |
159 | // Draw sprites at different positions
160 |
161 | // Small sprite demos - moving in a circle
162 | X := Round(MaxW / 4 + Cos(Time / 20) * 10);
163 | Y := Round(MaxH / 4 + Sin(Time / 20) * 5);
164 | Buffer.PutSprite(X, Y, PlayerSprite);
165 |
166 | X := Round(MaxW / 4 + Cos(Time / 20 + PI) * 10);
167 | Y := Round(MaxH / 4 + Sin(Time / 20 + PI) * 5);
168 | Buffer.PutSprite(X, Y, EnemySprite);
169 |
170 | // Only show explosion periodically
171 | if (Time mod 60) < 30 then
172 | begin
173 | X := Round(MaxW / 4);
174 | Y := Round(MaxH / 4);
175 | Buffer.PutSprite(X, Y, ExplosionSprite);
176 | end;
177 |
178 | // Large ship demo - moving side to side
179 | X := Round(MaxW / 2 - LargeShipSprite.Width / 2 + Sin(Time / 30) * (MaxW / 4));
180 | Y := Round(MaxH / 2 - LargeShipSprite.Height / 2);
181 | Buffer.PutSprite(X, Y, LargeShipSprite);
182 |
183 | // Asteroid orbiting
184 | X := Round(MaxW / 2 + Cos(Time / 15) * 20);
185 | Y := Round(MaxH / 2 + Sin(Time / 15) * 10);
186 | Buffer.PutSprite(X, Y, AsteroidSprite);
187 |
188 | // Boss sprite at bottom
189 | X := Round(MaxW / 2 - BossSprite.Width / 2);
190 | Y := MaxH - BossSprite.Height - 2;
191 | Buffer.PutSprite(X, Y, BossSprite);
192 |
193 | // Display FPS and instructions
194 | Buffer.PutChar(2, 2, 'F', CSIFGWhite, CSIBGBlack);
195 | Buffer.PutChar(3, 2, 'P', CSIFGWhite, CSIBGBlack);
196 | Buffer.PutChar(4, 2, 'S', CSIFGWhite, CSIBGBlack);
197 | Buffer.PutChar(5, 2, ':', CSIFGWhite, CSIBGBlack);
198 |
199 | // Convert FPS to string
200 | FPSStr := Format('%.1f', [Buffer.ActualFPS]);
201 | for I := 0 to Length(FPSStr) - 1 do
202 | Buffer.PutChar(7 + I, 2, FPSStr[I+1], CSIFGGreen, CSIBGBlack);
203 |
204 | // Display instructions
205 | InstructionStr := 'Press any key to exit';
206 | for I := 0 to Length(InstructionStr) - 1 do
207 | Buffer.PutChar(MaxW - Length(InstructionStr) - 2 + I, 2, InstructionStr[I+1], CSIFGYellow, CSIBGBlack);
208 |
209 | // Complete frame
210 | Buffer.EndFrame;
211 | end;
212 | end;
213 |
214 | finally
215 | // Free sprites
216 | PlayerSprite.Free;
217 | EnemySprite.Free;
218 | ExplosionSprite.Free;
219 | LargeShipSprite.Free;
220 | AsteroidSprite.Free;
221 | BossSprite.Free;
222 |
223 | // Free buffer
224 | Buffer.Free;
225 |
226 | TConsole.SetCursorVisible(True);
227 | TConsole.ClearScreen();
228 | end;
229 | end;
230 |
231 | end.
232 |
--------------------------------------------------------------------------------
/examples/testbed/UDemo.StellarAssault.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 | ===============================================================================}
15 |
16 | unit UDemo.StellarAssault;
17 |
18 | interface
19 |
20 | uses
21 | System.SysUtils,
22 | System.Classes,
23 | System.Math,
24 | Winapi.Windows,
25 | Console,
26 | Console.Buffer;
27 |
28 | procedure Demo_StellarAssault;
29 |
30 | implementation
31 |
32 | const
33 | // Game constants
34 | PLAYER_SHIP = '^';
35 | PLAYER_SHIP_LEFT = '<';
36 | PLAYER_SHIP_RIGHT = '>';
37 | PLAYER_THRUSTER = '|';
38 |
39 | ASTEROID_CHARS: array[0..3] of WideChar = ('O', '@', '0', 'Q');
40 |
41 | ENEMY_SHIP_A = 'M';
42 | ENEMY_SHIP_B = 'W';
43 | ENEMY_SHIP_C = 'X';
44 |
45 | PLAYER_BULLET = '|';
46 | ENEMY_BULLET = '.';
47 |
48 | EXPLOSION_CHARS: array[0..4] of WideChar = ('*', '+', '#', 'x', 'X');
49 |
50 | STAR_CHARS: array[0..2] of WideChar = ('.', '·', '*');
51 |
52 | // Game colors
53 | PLAYER_COLOR = CSIFGCyan;
54 | PLAYER_THRUSTER_COLOR = CSIFGYellow;
55 | ASTEROID_COLOR = CSIFGWhite;
56 | ENEMY_COLOR_A = CSIFGRed;
57 | ENEMY_COLOR_B = CSIFGMagenta;
58 | ENEMY_COLOR_C = CSIFGYellow;
59 | PLAYER_BULLET_COLOR = CSIFGGreen;
60 | ENEMY_BULLET_COLOR = CSIFGRed;
61 | EXPLOSION_COLOR = CSIFGMagenta;
62 | STAR_COLORS: array[0..3] of string = (CSIFGWhite + CSIDim, CSIFGCyan + CSIDim, CSIFGYellow + CSIDim, CSIFGBlue + CSIDim);
63 |
64 | // Game states
65 | GAME_STATE_TITLE = 0;
66 | GAME_STATE_PLAYING = 1;
67 | GAME_STATE_GAME_OVER = 2;
68 |
69 | // Enemy movement patterns
70 | ENEMY_PATTERN_STRAIGHT = 0;
71 | ENEMY_PATTERN_SINE = 1;
72 | ENEMY_PATTERN_CIRCLE = 2;
73 | ENEMY_PATTERN_DIVE = 3;
74 |
75 | type
76 | TEntityType = (etPlayer, etEnemy, etAsteroid, etPlayerBullet, etEnemyBullet, etExplosion, etPowerup, etStar);
77 |
78 | TEntity = record
79 | EntityType: TEntityType;
80 | X, Y: Double;
81 | VelX, VelY: Double;
82 | Char: WideChar;
83 | Color: string;
84 | BgColor: string;
85 | Active: Boolean;
86 | Health: Integer;
87 | Size: Integer;
88 | AnimFrame: Integer;
89 | AnimTimer: Integer;
90 | Pattern: Integer;
91 | PatternParam: Double;
92 | Value: Integer;
93 | end;
94 |
95 | TParticle = record
96 | X, Y: Double;
97 | VelX, VelY: Double;
98 | Life: Integer;
99 | Color: string;
100 | Char: WideChar;
101 | Active: Boolean;
102 | end;
103 |
104 | // We'll implement a pooled entity system for better performance
105 | const
106 | MAX_ENTITIES = 200;
107 | MAX_PARTICLES = 100;
108 |
109 | var
110 | // Game entities
111 | Entities: array[0..MAX_ENTITIES-1] of TEntity;
112 | Particles: array[0..MAX_PARTICLES-1] of TParticle;
113 |
114 | // Game variables
115 | Score: Integer;
116 | Level: Integer;
117 | Lives: Integer;
118 | GameState: Integer;
119 | SpawnTimer: Integer;
120 | PowerupTimer: Integer;
121 | GameTime: Integer;
122 | PlayerInvulnerable: Boolean;
123 | PlayerInvulnerableTimer: Integer;
124 |
125 | // Global references
126 | PlayerIndex: Integer;
127 |
128 | // Create a new entity
129 | function CreateEntity(EntityType: TEntityType; X, Y: Double): Integer;
130 | var
131 | I: Integer;
132 | begin
133 | Result := -1;
134 |
135 | // Find an inactive entity slot
136 | for I := 0 to MAX_ENTITIES-1 do
137 | begin
138 | if not Entities[I].Active then
139 | begin
140 | Result := I;
141 | FillChar(Entities[I], SizeOf(TEntity), 0);
142 | Entities[I].EntityType := EntityType;
143 | Entities[I].X := X;
144 | Entities[I].Y := Y;
145 | Entities[I].Active := True;
146 | Entities[I].Health := 1;
147 | Entities[I].Size := 1;
148 | Entities[I].BgColor := CSIBGBlack;
149 |
150 | // Initialize entity based on type
151 | case EntityType of
152 | etPlayer:
153 | begin
154 | Entities[I].Char := PLAYER_SHIP;
155 | Entities[I].Color := PLAYER_COLOR;
156 | Entities[I].Health := 3;
157 | PlayerIndex := I;
158 | end;
159 |
160 | etEnemy:
161 | begin
162 | // Random enemy type
163 | case TConsole.RandomRange(0, 3) of
164 | 0:
165 | begin
166 | Entities[I].Char := ENEMY_SHIP_A;
167 | Entities[I].Color := ENEMY_COLOR_A;
168 | Entities[I].Pattern := ENEMY_PATTERN_STRAIGHT;
169 | Entities[I].VelY := 0.1 + 0.05 * Level;
170 | Entities[I].Value := 10;
171 | end;
172 | 1:
173 | begin
174 | Entities[I].Char := ENEMY_SHIP_B;
175 | Entities[I].Color := ENEMY_COLOR_B;
176 | Entities[I].Pattern := ENEMY_PATTERN_SINE;
177 | Entities[I].VelY := 0.08 + 0.03 * Level;
178 | Entities[I].PatternParam := TConsole.RandomRange(0, 628) / 100; // Random phase
179 | Entities[I].Value := 20;
180 | end;
181 | 2:
182 | begin
183 | Entities[I].Char := ENEMY_SHIP_C;
184 | Entities[I].Color := ENEMY_COLOR_C;
185 | Entities[I].Pattern := ENEMY_PATTERN_DIVE;
186 | Entities[I].VelY := 0.05 + 0.03 * Level;
187 | Entities[I].PatternParam := 0; // Dive timer
188 | Entities[I].Value := 30;
189 | end;
190 | end;
191 | end;
192 |
193 | etAsteroid:
194 | begin
195 | Entities[I].Char := ASTEROID_CHARS[TConsole.RandomRange(0, Length(ASTEROID_CHARS))];
196 | Entities[I].Color := ASTEROID_COLOR;
197 | Entities[I].VelX := (TConsole.RandomRange(-20, 20) / 100);
198 | Entities[I].VelY := 0.1 + (TConsole.RandomRange(0, 10) / 100);
199 | Entities[I].Value := 5;
200 | end;
201 |
202 | etPlayerBullet:
203 | begin
204 | Entities[I].Char := PLAYER_BULLET;
205 | Entities[I].Color := PLAYER_BULLET_COLOR;
206 | Entities[I].VelY := -0.8; // Fast upward movement
207 | end;
208 |
209 | etEnemyBullet:
210 | begin
211 | Entities[I].Char := ENEMY_BULLET;
212 | Entities[I].Color := ENEMY_BULLET_COLOR;
213 | Entities[I].VelY := 0.3 + 0.05 * Level; // Downward movement
214 | end;
215 |
216 | etExplosion:
217 | begin
218 | Entities[I].Char := EXPLOSION_CHARS[0];
219 | Entities[I].Color := EXPLOSION_COLOR;
220 | Entities[I].AnimTimer := 3; // Frames between animation changes
221 | Entities[I].AnimFrame := 0;
222 | Entities[I].Health := 15; // Life of explosion
223 | end;
224 |
225 | etPowerup:
226 | begin
227 | Entities[I].Char := 'P';
228 | Entities[I].Color := CSIFGGreen;
229 | Entities[I].VelY := 0.1;
230 | Entities[I].Value := TConsole.RandomRange(0, 3); // Powerup type
231 | end;
232 |
233 | etStar:
234 | begin
235 | Entities[I].Char := STAR_CHARS[TConsole.RandomRange(0, Length(STAR_CHARS))];
236 | Entities[I].Color := STAR_COLORS[TConsole.RandomRange(0, Length(STAR_COLORS))];
237 | Entities[I].VelY := 0.05 + (TConsole.RandomRange(0, 10) / 100);
238 | end;
239 | end;
240 |
241 | Break;
242 | end;
243 | end;
244 | end;
245 |
246 | // Create a particle effect
247 | procedure CreateParticle(X, Y: Double; Color: string; VelX, VelY: Double; Life: Integer);
248 | var
249 | I: Integer;
250 | LFound: Boolean;
251 | begin
252 | LFound := False;
253 |
254 | for I := 0 to MAX_PARTICLES-1 do
255 | begin
256 | if not Particles[I].Active then
257 | begin
258 | // Clear any existing values
259 | Particles[I].Color := '';
260 |
261 | // Set new values
262 | Particles[I].X := X;
263 | Particles[I].Y := Y;
264 | Particles[I].VelX := VelX + (TConsole.RandomRange(-20, 20) / 100);
265 | Particles[I].VelY := VelY + (TConsole.RandomRange(-20, 20) / 100);
266 | Particles[I].Color := Color;
267 | Particles[I].Char := EXPLOSION_CHARS[TConsole.RandomRange(0, Length(EXPLOSION_CHARS))];
268 | Particles[I].Life := Life;
269 | Particles[I].Active := True;
270 |
271 | LFound := True;
272 | Break;
273 | end;
274 | end;
275 |
276 | // If no inactive particles, force cleanup of the oldest one
277 | if not LFound then
278 | begin
279 | // Find the oldest particle and reuse it
280 | Particles[0].Color := '';
281 | Particles[0].X := X;
282 | Particles[0].Y := Y;
283 | Particles[0].VelX := VelX + (TConsole.RandomRange(-20, 20) / 100);
284 | Particles[0].VelY := VelY + (TConsole.RandomRange(-20, 20) / 100);
285 | Particles[0].Color := Color;
286 | Particles[0].Char := EXPLOSION_CHARS[TConsole.RandomRange(0, Length(EXPLOSION_CHARS))];
287 | Particles[0].Life := Life;
288 | Particles[0].Active := True;
289 | end;
290 | end;
291 |
292 | // Create an explosion effect
293 | procedure CreateExplosion(X, Y: Double; Size: Integer);
294 | var
295 | I, ExplosionIndex: Integer;
296 | begin
297 | // Create main explosion entity
298 | ExplosionIndex := CreateEntity(etExplosion, X, Y);
299 |
300 | // Create particle effects
301 | if ExplosionIndex >= 0 then
302 | begin
303 | for I := 0 to 5 + Size * 3 do
304 | begin
305 | CreateParticle(X, Y, EXPLOSION_COLOR, 0, 0, 10 + TConsole.RandomRange(0, 10));
306 | end;
307 | end;
308 | end;
309 |
310 | procedure SpawnStarField;
311 | var
312 | I, W, H: Integer;
313 | begin
314 | TConsole.GetSize(@W, @H);
315 | for I := 0 to 50 do
316 | CreateEntity(etStar, TConsole.RandomRange(0, W), TConsole.RandomRange(0, H));
317 | end;
318 |
319 | // Initialize the game
320 | procedure InitGame;
321 | var
322 | I: Integer;
323 | ConsoleWidth, ConsoleHeight: Integer;
324 | begin
325 | // Reset game state
326 | Score := 0;
327 | Level := 1;
328 | Lives := 3;
329 | GameState := GAME_STATE_TITLE;
330 | SpawnTimer := 0;
331 | PowerupTimer := 0;
332 | GameTime := 0;
333 | PlayerInvulnerable := False;
334 | PlayerInvulnerableTimer := 0;
335 |
336 | // Clear all entities
337 | for I := 0 to MAX_ENTITIES-1 do
338 | Entities[I].Active := False;
339 |
340 | // Clear all particles
341 | for I := 0 to MAX_PARTICLES-1 do
342 | Particles[I].Active := False;
343 |
344 | // Get console dimensions
345 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
346 |
347 | // Create player ship
348 | PlayerIndex := CreateEntity(etPlayer, ConsoleWidth / 2, ConsoleHeight - 5);
349 |
350 | // Create initial star field
351 | SpawnStarField();
352 | end;
353 |
354 | procedure CleanupGame;
355 | var
356 | I: Integer;
357 | begin
358 | // Clear all entities
359 | for I := 0 to MAX_ENTITIES-1 do
360 | begin
361 | // For Entities that have Color or BgColor strings, clear them properly
362 | Entities[I].Color := '';
363 | Entities[I].BgColor := '';
364 |
365 | // Mark as inactive
366 | Entities[I].Active := False;
367 | end;
368 |
369 | // Clear all particles
370 | for I := 0 to MAX_PARTICLES-1 do
371 | begin
372 | // Clear color string
373 | Particles[I].Color := '';
374 |
375 | // Mark as inactive
376 | Particles[I].Active := False;
377 | end;
378 |
379 | // Reset any other global state
380 | PlayerIndex := -1;
381 |
382 | // Reset game timers that might affect entity creation
383 | SpawnTimer := 0;
384 | PowerupTimer := 0;
385 | GameTime := 0;
386 |
387 | // Make sure game state is reset
388 | GameState := GAME_STATE_TITLE;
389 | end;
390 |
391 | // Start a new game level
392 | procedure StartLevel;
393 | var
394 | I, ConsoleWidth: Integer;
395 | begin
396 | TConsole.GetSize(@ConsoleWidth, nil);
397 |
398 | // Clear enemies and bullets
399 | for I := 0 to MAX_ENTITIES-1 do
400 | begin
401 | if Entities[I].Active and
402 | ((Entities[I].EntityType = etEnemy) or
403 | (Entities[I].EntityType = etEnemyBullet) or
404 | (Entities[I].EntityType = etAsteroid) or
405 | (Entities[I].EntityType = etPowerup)) then
406 | begin
407 | Entities[I].Active := False;
408 | end;
409 | end;
410 |
411 | // Create initial asteroids
412 | for I := 0 to 4 + Level do
413 | begin
414 | CreateEntity(etAsteroid, TConsole.RandomRange(0, ConsoleWidth), TConsole.RandomRange(2, 10));
415 | end;
416 |
417 | // Reset timers
418 | SpawnTimer := 0;
419 | PowerupTimer := 0;
420 |
421 | // Make player temporarily invulnerable
422 | PlayerInvulnerable := True;
423 | PlayerInvulnerableTimer := 60;
424 | end;
425 |
426 | // Update player movement and actions
427 | procedure UpdatePlayer(var Buffer: TAsciiBuffer);
428 | var
429 | ConsoleWidth, ConsoleHeight: Integer;
430 | ThrusterX, ThrusterY: Integer;
431 | K: Integer;
432 | begin
433 | if (PlayerIndex >= 0) and Entities[PlayerIndex].Active then
434 | begin
435 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
436 |
437 | // Handle player input
438 | if TConsole.IsKeyPressed(VK_LEFT) then
439 | begin
440 | Entities[PlayerIndex].VelX := Max(Entities[PlayerIndex].VelX - 0.04, -0.5);
441 | Entities[PlayerIndex].Char := PLAYER_SHIP_LEFT;
442 | end
443 | else if TConsole.IsKeyPressed(VK_RIGHT) then
444 | begin
445 | Entities[PlayerIndex].VelX := Min(Entities[PlayerIndex].VelX + 0.04, 0.5);
446 | Entities[PlayerIndex].Char := PLAYER_SHIP_RIGHT;
447 | end
448 | else
449 | begin
450 | // Gradual slow down if no keys pressed
451 | Entities[PlayerIndex].VelX := Entities[PlayerIndex].VelX * 0.9;
452 | Entities[PlayerIndex].Char := PLAYER_SHIP;
453 | end;
454 |
455 | // Apply velocity
456 | Entities[PlayerIndex].X := Entities[PlayerIndex].X + Entities[PlayerIndex].VelX;
457 |
458 | // Boundary checking
459 | if Entities[PlayerIndex].X < 1 then
460 | begin
461 | Entities[PlayerIndex].X := 1;
462 | Entities[PlayerIndex].VelX := 0;
463 | end
464 | else if Entities[PlayerIndex].X > ConsoleWidth - 2 then
465 | begin
466 | Entities[PlayerIndex].X := ConsoleWidth - 2;
467 | Entities[PlayerIndex].VelX := 0;
468 | end;
469 |
470 | // Fire bullet with space
471 | if TConsole.WasKeyPressed(VK_SPACE) then
472 | begin
473 | CreateEntity(etPlayerBullet, Entities[PlayerIndex].X, Entities[PlayerIndex].Y - 1);
474 |
475 | // Add thruster particles
476 | for K := 0 to 2 do
477 | begin
478 | CreateParticle(Entities[PlayerIndex].X, Entities[PlayerIndex].Y + 1,
479 | PLAYER_THRUSTER_COLOR, 0, 0.1, 5);
480 | end;
481 | end;
482 |
483 | // Draw thruster
484 | if GameTime mod 4 < 2 then
485 | begin
486 | ThrusterX := Round(Entities[PlayerIndex].X);
487 | ThrusterY := Round(Entities[PlayerIndex].Y) + 1;
488 |
489 | if (ThrusterX >= 0) and (ThrusterX < ConsoleWidth) and
490 | (ThrusterY >= 0) and (ThrusterY < ConsoleHeight) then
491 | begin
492 | Buffer.PutChar(ThrusterX, ThrusterY, PLAYER_THRUSTER, PLAYER_THRUSTER_COLOR, CSIBGBlack);
493 | end;
494 | end;
495 |
496 | // Handle invulnerability timer
497 | if PlayerInvulnerable then
498 | begin
499 | Dec(PlayerInvulnerableTimer);
500 | if PlayerInvulnerableTimer <= 0 then
501 | PlayerInvulnerable := False;
502 | end;
503 | end;
504 | end;
505 |
506 | procedure UpdateEntities;
507 | var
508 | I, J: Integer;
509 | ConsoleWidth, ConsoleHeight: Integer;
510 | DX, DY, Distance: Double;
511 |
512 | procedure DeactivateEntity(var E: TEntity);
513 | begin
514 | E.Color := '';
515 | E.BgColor := '';
516 | E.Active := False;
517 | end;
518 |
519 | begin
520 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
521 |
522 | for I := 0 to MAX_ENTITIES - 1 do
523 | begin
524 | if Entities[I].Active then
525 | begin
526 | case Entities[I].EntityType of
527 | etPlayer:
528 | ; // No movement handling here
529 |
530 | etEnemy:
531 | begin
532 | case Entities[I].Pattern of
533 | ENEMY_PATTERN_STRAIGHT:
534 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
535 |
536 | ENEMY_PATTERN_SINE:
537 | begin
538 | Entities[I].PatternParam := Entities[I].PatternParam + 0.1;
539 | Entities[I].X := Entities[I].X + Sin(Entities[I].PatternParam) * 0.2;
540 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
541 | end;
542 |
543 | ENEMY_PATTERN_CIRCLE:
544 | begin
545 | Entities[I].PatternParam := Entities[I].PatternParam + 0.05;
546 | Entities[I].X := Entities[I].X + Cos(Entities[I].PatternParam) * 0.3;
547 | Entities[I].Y := Entities[I].Y + Sin(Entities[I].PatternParam) * 0.3 + 0.05;
548 | end;
549 |
550 | ENEMY_PATTERN_DIVE:
551 | begin
552 | Entities[I].PatternParam := Entities[I].PatternParam + 1;
553 | if (Entities[I].PatternParam > 30) and (PlayerIndex >= 0) and Entities[PlayerIndex].Active then
554 | begin
555 | DX := Entities[PlayerIndex].X - Entities[I].X;
556 | DY := Entities[PlayerIndex].Y - Entities[I].Y;
557 | Distance := Sqrt(DX * DX + DY * DY);
558 |
559 | if Distance > 0 then
560 | begin
561 | Entities[I].VelX := DX / Distance * 0.3;
562 | Entities[I].VelY := DY / Distance * 0.3;
563 | end;
564 |
565 | Entities[I].Pattern := ENEMY_PATTERN_STRAIGHT;
566 | end
567 | else
568 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
569 | end;
570 | end;
571 |
572 | if (TConsole.RandomRange(0, 100) < 1 + Level) and
573 | (Entities[I].Y < ConsoleHeight - 10) then
574 | begin
575 | CreateEntity(etEnemyBullet, Entities[I].X, Entities[I].Y + 1);
576 | end;
577 |
578 | Entities[I].X := Entities[I].X + Entities[I].VelX;
579 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
580 |
581 | if (Entities[I].Y > ConsoleHeight + 1) or
582 | (Entities[I].X < -2) or (Entities[I].X > ConsoleWidth + 1) then
583 | DeactivateEntity(Entities[I]);
584 | end;
585 |
586 | etAsteroid:
587 | begin
588 | if GameTime mod 10 = 0 then
589 | Entities[I].Char := ASTEROID_CHARS[TConsole.RandomRange(0, Length(ASTEROID_CHARS))];
590 |
591 | Entities[I].X := Entities[I].X + Entities[I].VelX;
592 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
593 |
594 | if Entities[I].X < -1 then
595 | Entities[I].X := ConsoleWidth
596 | else if Entities[I].X > ConsoleWidth then
597 | Entities[I].X := 0;
598 |
599 | if Entities[I].Y > ConsoleHeight + 1 then
600 | DeactivateEntity(Entities[I]);
601 | end;
602 |
603 | etPlayerBullet:
604 | begin
605 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
606 |
607 | if Entities[I].Y < 0 then
608 | DeactivateEntity(Entities[I])
609 | else
610 | begin
611 | for J := 0 to MAX_ENTITIES - 1 do
612 | begin
613 | if Entities[J].Active and
614 | ((Entities[J].EntityType = etEnemy) or
615 | (Entities[J].EntityType = etAsteroid)) then
616 | begin
617 | if (Round(Entities[I].X) = Round(Entities[J].X)) and
618 | (Round(Entities[I].Y) = Round(Entities[J].Y)) then
619 | begin
620 | Dec(Entities[J].Health);
621 | if Entities[J].Health <= 0 then
622 | begin
623 | Inc(Score, Entities[J].Value);
624 | CreateExplosion(Entities[J].X, Entities[J].Y, 1);
625 | DeactivateEntity(Entities[J]);
626 |
627 | if (Entities[J].EntityType = etEnemy) and
628 | (TConsole.RandomRange(0, 10) < 2) then
629 | begin
630 | CreateEntity(etPowerup, Entities[J].X, Entities[J].Y);
631 | end;
632 | end;
633 | DeactivateEntity(Entities[I]);
634 | Break;
635 | end;
636 | end;
637 | end;
638 | end;
639 | end;
640 |
641 | etEnemyBullet:
642 | begin
643 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
644 |
645 | if Entities[I].Y > ConsoleHeight then
646 | DeactivateEntity(Entities[I])
647 | else if (PlayerIndex >= 0) and Entities[PlayerIndex].Active and
648 | (not PlayerInvulnerable) and
649 | (Round(Entities[I].X) = Round(Entities[PlayerIndex].X)) and
650 | (Round(Entities[I].Y) = Round(Entities[PlayerIndex].Y)) then
651 | begin
652 | DeactivateEntity(Entities[I]);
653 | Dec(Entities[PlayerIndex].Health);
654 | CreateExplosion(Entities[PlayerIndex].X, Entities[PlayerIndex].Y, 1);
655 |
656 | if Entities[PlayerIndex].Health <= 0 then
657 | begin
658 | CreateExplosion(Entities[PlayerIndex].X, Entities[PlayerIndex].Y, 2);
659 | DeactivateEntity(Entities[PlayerIndex]);
660 | Dec(Lives);
661 | if Lives <= 0 then
662 | GameState := GAME_STATE_GAME_OVER
663 | else
664 | begin
665 | PlayerIndex := CreateEntity(etPlayer, ConsoleWidth / 2, ConsoleHeight - 5);
666 | PlayerInvulnerable := True;
667 | PlayerInvulnerableTimer := 60;
668 | end;
669 | end
670 | else
671 | begin
672 | PlayerInvulnerable := True;
673 | PlayerInvulnerableTimer := 60;
674 | end;
675 | end;
676 | end;
677 |
678 | etExplosion:
679 | begin
680 | Dec(Entities[I].AnimTimer);
681 | if Entities[I].AnimTimer <= 0 then
682 | begin
683 | Entities[I].AnimTimer := 2;
684 | Inc(Entities[I].AnimFrame);
685 | if Entities[I].AnimFrame < Length(EXPLOSION_CHARS) then
686 | Entities[I].Char := EXPLOSION_CHARS[Entities[I].AnimFrame]
687 | else
688 | Entities[I].AnimFrame := 0;
689 | end;
690 | Dec(Entities[I].Health);
691 | if Entities[I].Health <= 0 then
692 | DeactivateEntity(Entities[I]);
693 | end;
694 |
695 | etPowerup:
696 | begin
697 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
698 | if Entities[I].Y > ConsoleHeight then
699 | DeactivateEntity(Entities[I])
700 | else if (PlayerIndex >= 0) and Entities[PlayerIndex].Active and
701 | (Round(Entities[I].X) = Round(Entities[PlayerIndex].X)) and
702 | (Round(Entities[I].Y) = Round(Entities[PlayerIndex].Y)) then
703 | begin
704 | case Entities[I].Value of
705 | 0: Inc(Score, 50);
706 | 1: Inc(Entities[PlayerIndex].Health);
707 | 2: Inc(Lives);
708 | end;
709 |
710 | for J := 0 to 10 do
711 | CreateParticle(Entities[I].X, Entities[I].Y, CSIFGGreen, 0, 0, 10);
712 |
713 | DeactivateEntity(Entities[I]);
714 | end;
715 | end;
716 |
717 | etStar:
718 | begin
719 | Entities[I].Y := Entities[I].Y + Entities[I].VelY;
720 | if Entities[I].Y > ConsoleHeight then
721 | begin
722 | Entities[I].Y := 0;
723 | Entities[I].X := TConsole.RandomRange(0, ConsoleWidth);
724 | end;
725 | end;
726 | end;
727 | end;
728 | end;
729 | end;
730 |
731 |
732 | // Update all particles
733 | procedure UpdateParticles;
734 | var
735 | I: Integer;
736 | begin
737 | for I := 0 to MAX_PARTICLES-1 do
738 | begin
739 | if Particles[I].Active then
740 | begin
741 | // Apply velocity
742 | Particles[I].X := Particles[I].X + Particles[I].VelX;
743 | Particles[I].Y := Particles[I].Y + Particles[I].VelY;
744 |
745 | // Reduce life
746 | Dec(Particles[I].Life);
747 | if Particles[I].Life <= 0 then
748 | Particles[I].Active := False;
749 | end;
750 | end;
751 | end;
752 |
753 | // Spawn new enemies and asteroids
754 | procedure SpawnEnemies;
755 | var
756 | ConsoleWidth: Integer;
757 | begin
758 | Inc(SpawnTimer);
759 |
760 | // Spawn rate decreases as level increases
761 | if SpawnTimer >= Max(30 - Level * 2, 10) then
762 | begin
763 | SpawnTimer := 0;
764 |
765 | TConsole.GetSize(@ConsoleWidth, nil);
766 |
767 | // Random enemy or asteroid
768 | if TConsole.RandomRange(0, 10) < 7 then
769 | begin
770 | // Spawn enemy
771 | CreateEntity(etEnemy, TConsole.RandomRange(5, ConsoleWidth - 5), 0);
772 | end
773 | else
774 | begin
775 | // Spawn asteroid
776 | CreateEntity(etAsteroid, TConsole.RandomRange(0, ConsoleWidth), 0);
777 | end;
778 | end;
779 |
780 | // Spawn powerups occasionally
781 | Inc(PowerupTimer);
782 | if PowerupTimer >= 500 then
783 | begin
784 | PowerupTimer := 0;
785 |
786 | TConsole.GetSize(@ConsoleWidth, nil);
787 | CreateEntity(etPowerup, TConsole.RandomRange(5, ConsoleWidth - 5), 0);
788 | end;
789 | end;
790 |
791 | // Render all entities to buffer
792 | procedure RenderEntities(var Buffer: TAsciiBuffer);
793 | var
794 | I: Integer;
795 | X, Y: Integer;
796 | ConsoleWidth, ConsoleHeight: Integer;
797 | LTitle: string; // Changed to LTitle as per requirements
798 | LStatusLine: string; // Changed to LStatusLine as per requirements
799 | begin
800 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
801 |
802 | // Clear buffer
803 | Buffer.Clear(' ', CSIDim + CSIFGWhite, CSIBGBlack);
804 |
805 | // Handle different game states
806 | case GameState of
807 | GAME_STATE_TITLE:
808 | begin
809 | // Draw title screen
810 | LTitle := '* STELLAR ASSAULT *';
811 | for I := 0 to Length(LTitle) - 1 do
812 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 - 8,
813 | LTitle[I+1], CSIFGCyan, CSIBGBlack);
814 |
815 | LTitle := 'A Space Shooter Adventure';
816 | for I := 0 to Length(LTitle) - 1 do
817 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 - 6,
818 | LTitle[I+1], CSIFGWhite, CSIBGBlack);
819 |
820 | LTitle := 'Controls:';
821 | for I := 0 to Length(LTitle) - 1 do
822 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 - 3,
823 | LTitle[I+1], CSIFGYellow, CSIBGBlack);
824 |
825 | LTitle := 'LEFT/RIGHT - Move Ship';
826 | for I := 0 to Length(LTitle) - 1 do
827 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 - 1,
828 | LTitle[I+1], CSIFGWhite, CSIBGBlack);
829 |
830 | LTitle := 'SPACE - Fire Weapon';
831 | for I := 0 to Length(LTitle) - 1 do
832 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2,
833 | LTitle[I+1], CSIFGWhite, CSIBGBlack);
834 |
835 | LTitle := 'ESC - Quit Game';
836 | for I := 0 to Length(LTitle) - 1 do
837 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 + 1,
838 | LTitle[I+1], CSIFGWhite, CSIBGBlack);
839 |
840 | LTitle := 'Press [S] to Start!';
841 | for I := 0 to Length(LTitle) - 1 do
842 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 + 4,
843 | LTitle[I+1], CSIFGMagenta, CSIBGBlack);
844 |
845 | // Clear string to free memory
846 | LTitle := '';
847 |
848 | // Draw stars for background
849 | for I := 0 to MAX_ENTITIES-1 do
850 | begin
851 | if Entities[I].Active and (Entities[I].EntityType = etStar) then
852 | begin
853 | X := Round(Entities[I].X);
854 | Y := Round(Entities[I].Y);
855 |
856 | if (X >= 0) and (X < ConsoleWidth) and
857 | (Y >= 0) and (Y < ConsoleHeight) then
858 | begin
859 | Buffer.PutChar(X, Y, Entities[I].Char, Entities[I].Color, CSIBGBlack);
860 | end;
861 | end;
862 | end;
863 | end;
864 |
865 | GAME_STATE_PLAYING:
866 | begin
867 | // Render stars first (background)
868 | for I := 0 to MAX_ENTITIES-1 do
869 | begin
870 | if Entities[I].Active and (Entities[I].EntityType = etStar) then
871 | begin
872 | X := Round(Entities[I].X);
873 | Y := Round(Entities[I].Y);
874 |
875 | if (X >= 0) and (X < ConsoleWidth) and
876 | (Y >= 0) and (Y < ConsoleHeight) then
877 | begin
878 | Buffer.PutChar(X, Y, Entities[I].Char, Entities[I].Color, CSIBGBlack);
879 | end;
880 | end;
881 | end;
882 |
883 | // Render particles
884 | for I := 0 to MAX_PARTICLES-1 do
885 | begin
886 | if Particles[I].Active then
887 | begin
888 | X := Round(Particles[I].X);
889 | Y := Round(Particles[I].Y);
890 |
891 | if (X >= 0) and (X < ConsoleWidth) and
892 | (Y >= 0) and (Y < ConsoleHeight) then
893 | begin
894 | Buffer.PutChar(X, Y, Particles[I].Char, Particles[I].Color, CSIBGBlack);
895 | end;
896 | end;
897 | end;
898 |
899 | // Render other entities
900 | for I := 0 to MAX_ENTITIES-1 do
901 | begin
902 | if Entities[I].Active and (Entities[I].EntityType <> etStar) then
903 | begin
904 | // Skip rendering player if flashing during invulnerability
905 | if (Entities[I].EntityType = etPlayer) and
906 | PlayerInvulnerable and (GameTime mod 6 < 3) then
907 | Continue;
908 |
909 | X := Round(Entities[I].X);
910 | Y := Round(Entities[I].Y);
911 |
912 | if (X >= 0) and (X < ConsoleWidth) and
913 | (Y >= 0) and (Y < ConsoleHeight) then
914 | begin
915 | Buffer.PutChar(X, Y, Entities[I].Char, Entities[I].Color, Entities[I].BgColor);
916 | end;
917 | end;
918 | end;
919 |
920 | // Render UI
921 | // Status line at top
922 | if PlayerIndex >= 0 then
923 | begin
924 | LStatusLine := Format('LEVEL: %d SCORE: %d LIVES: %d HEALTH: %d',
925 | [Level, Score, Lives, Entities[PlayerIndex].Health]);
926 |
927 | for I := 0 to Length(LStatusLine) - 1 do
928 | Buffer.PutChar(2 + I, 1, LStatusLine[I+1], CSIFGWhite, CSIBGBlack);
929 |
930 | // Clear string to free memory
931 | LStatusLine := '';
932 | end;
933 |
934 | // Health bar
935 | if PlayerIndex >= 0 then
936 | begin
937 | Buffer.PutChar(ConsoleWidth - 12, 1, '[', CSIFGWhite, CSIBGBlack);
938 |
939 | for I := 0 to 9 do
940 | begin
941 | if I < Entities[PlayerIndex].Health then
942 | Buffer.PutChar(ConsoleWidth - 11 + I, 1, '=', CSIFGGreen, CSIBGBlack)
943 | else
944 | Buffer.PutChar(ConsoleWidth - 11 + I, 1, '-', CSIFGRed, CSIBGBlack);
945 | end;
946 |
947 | Buffer.PutChar(ConsoleWidth - 1, 1, ']', CSIFGWhite, CSIBGBlack);
948 | end;
949 |
950 | // Level indicator
951 | for I := 0 to Min(Level, 10) - 1 do
952 | Buffer.PutChar(ConsoleWidth - 2 - I, ConsoleHeight - 2, '*', CSIFGYellow, CSIBGBlack);
953 | end;
954 |
955 | GAME_STATE_GAME_OVER:
956 | begin
957 | // Draw stars for background
958 | for I := 0 to MAX_ENTITIES-1 do
959 | begin
960 | if Entities[I].Active and (Entities[I].EntityType = etStar) then
961 | begin
962 | X := Round(Entities[I].X);
963 | Y := Round(Entities[I].Y);
964 |
965 | if (X >= 0) and (X < ConsoleWidth) and
966 | (Y >= 0) and (Y < ConsoleHeight) then
967 | begin
968 | Buffer.PutChar(X, Y, Entities[I].Char, Entities[I].Color, CSIBGBlack);
969 | end;
970 | end;
971 | end;
972 |
973 | // Draw game over screen
974 | LTitle := 'GAME OVER';
975 | for I := 0 to Length(LTitle) - 1 do
976 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 - 5,
977 | LTitle[I+1], CSIFGRed, CSIBGBlack);
978 |
979 | LTitle := Format('Final Score: %d', [Score]);
980 | for I := 0 to Length(LTitle) - 1 do
981 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 - 3,
982 | LTitle[I+1], CSIFGWhite, CSIBGBlack);
983 |
984 | LTitle := Format('Levels Completed: %d', [Level - 1]);
985 | for I := 0 to Length(LTitle) - 1 do
986 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 - 2,
987 | LTitle[I+1], CSIFGWhite, CSIBGBlack);
988 |
989 | LTitle := 'Press [S] to Play Again';
990 | for I := 0 to Length(LTitle) - 1 do
991 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 + 1,
992 | LTitle[I+1], CSIFGYellow, CSIBGBlack);
993 |
994 | LTitle := 'Press ESC to Quit';
995 | for I := 0 to Length(LTitle) - 1 do
996 | Buffer.PutChar((ConsoleWidth div 2) - (Length(LTitle) div 2) + I, ConsoleHeight div 2 + 3,
997 | LTitle[I+1], CSIFGWhite, CSIBGBlack);
998 |
999 | // Clear string to free memory
1000 | LTitle := '';
1001 | end;
1002 | end;
1003 | end;
1004 |
1005 | // Main game procedure
1006 | procedure Demo_StellarAssault;
1007 | var
1008 | Buffer: TAsciiBuffer;
1009 | MaxW, MaxH: Integer;
1010 | GameRunning: Boolean;
1011 | LCleanedUp: Boolean;
1012 | begin
1013 | TConsole.SetTitle('TConsole: Stellar Assault Demo');
1014 |
1015 | TConsole.ClearKeyStates();
1016 | TConsole.ClearScreen();
1017 | TConsole.SetCursorVisible(False);
1018 | TConsole.GetSize(@MaxW, @MaxH);
1019 |
1020 | // Initialize flag to track if cleanup has been done
1021 | LCleanedUp := False;
1022 |
1023 | Buffer := TAsciiBuffer.Create(MaxW, MaxH);
1024 | try
1025 | // Set target frame rate
1026 | Buffer.TargetFPS := 60;
1027 |
1028 | // Initialize game
1029 | InitGame;
1030 |
1031 | // Main game loop
1032 | GameRunning := True;
1033 | while GameRunning do
1034 | begin
1035 | // Process input
1036 | if TConsole.WasKeyPressed(VK_ESCAPE) then
1037 | begin
1038 | if GameState = GAME_STATE_PLAYING then
1039 | begin
1040 | CleanupGame;
1041 | GameState := GAME_STATE_TITLE;
1042 | InitGame;
1043 | Continue; // go to next frame
1044 | end
1045 | else
1046 | begin
1047 | LCleanedUp := True;
1048 | GameRunning := False;
1049 | Break;
1050 | end;
1051 | end;
1052 |
1053 |
1054 | // Wait for next frame
1055 | if Buffer.BeginFrame then
1056 | begin
1057 | // Increment game time
1058 | Inc(GameTime);
1059 |
1060 | // Handle game state
1061 | case GameState of
1062 | GAME_STATE_TITLE:
1063 | begin
1064 | // Update stars for background effect
1065 | UpdateEntities;
1066 |
1067 | if TConsole.WasKeyPressed(Ord('S')) then
1068 | begin
1069 | GameState := GAME_STATE_PLAYING;
1070 | StartLevel;
1071 | end;
1072 | end;
1073 |
1074 | GAME_STATE_PLAYING:
1075 | begin
1076 | // Update player
1077 | UpdatePlayer(Buffer);
1078 |
1079 | // Update game entities
1080 | UpdateEntities;
1081 |
1082 | // Update particles
1083 | UpdateParticles;
1084 |
1085 | // Spawn new enemies
1086 | SpawnEnemies;
1087 |
1088 | // Check if level complete
1089 | if (GameTime mod 1000 = 0) and (GameTime > 0) then
1090 | begin
1091 | Inc(Level);
1092 | StartLevel;
1093 | end;
1094 | end;
1095 |
1096 | GAME_STATE_GAME_OVER:
1097 | begin
1098 | // Update stars for background effect
1099 | UpdateEntities;
1100 |
1101 | if TConsole.WasKeyPressed(Ord('S')) then
1102 | begin
1103 | // Reset game
1104 | InitGame;
1105 | GameState := GAME_STATE_PLAYING;
1106 | StartLevel;
1107 | end;
1108 | end;
1109 | end;
1110 |
1111 | // Render game
1112 | RenderEntities(Buffer);
1113 |
1114 | // Complete frame
1115 | Buffer.EndFrame;
1116 | end;
1117 | end;
1118 |
1119 | // Final cleanup if not done already
1120 | if not LCleanedUp then
1121 | begin
1122 | CleanupGame;
1123 | end;
1124 |
1125 | finally
1126 | // Free buffer
1127 | Buffer.Free;
1128 | TConsole.SetCursorVisible(True);
1129 | TConsole.ClearScreen();
1130 | end;
1131 | end;
1132 |
1133 | end.
1134 |
--------------------------------------------------------------------------------
/examples/testbed/UDemo.StellarDefender.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 | ===============================================================================}
15 |
16 | unit UDemo.StellarDefender;
17 |
18 | interface
19 |
20 | uses
21 | System.SysUtils,
22 | System.Classes,
23 | System.Math,
24 | Winapi.Windows,
25 | Console,
26 | Console.Buffer,
27 | Console.Sprite;
28 |
29 | procedure Demo_StellarDefender;
30 |
31 | implementation
32 |
33 | type
34 |
35 | TEntityType = (etPlayer, etEnemy, etAsteroid, etBullet, etExplosion, etPowerup, etBackground);
36 |
37 | TCollisionShape = (csNone, csPoint, csRect, csCircle);
38 |
39 | TEntity = class
40 | private
41 | FType: TEntityType;
42 | FX, FY: Double;
43 | FVelX, FVelY: Double;
44 | FSprite: TAsciiSprite;
45 | FAnimation: TAsciiSpriteAnimation;
46 | FCollisionShape: TCollisionShape;
47 | FCollisionRadius: Double;
48 | FCollisionWidth, FCollisionHeight: Integer;
49 | FActive: Boolean;
50 | FHealth: Integer;
51 | FLifetime: Integer;
52 | FValue: Integer;
53 | FTag: Integer;
54 | FOwnsSprite: Boolean; // Added: flag to indicate if we own the sprite
55 | public
56 | constructor Create(EntityType: TEntityType; X, Y: Double);
57 | destructor Destroy; override;
58 | procedure Update; virtual;
59 | function CheckCollision(Other: TEntity): Boolean;
60 | property EntityType: TEntityType read FType;
61 | property X: Double read FX write FX;
62 | property Y: Double read FY write FY;
63 | property VelX: Double read FVelX write FVelX;
64 | property VelY: Double read FVelY write FVelY;
65 | property Sprite: TAsciiSprite read FSprite write FSprite;
66 | property Animation: TAsciiSpriteAnimation read FAnimation write FAnimation;
67 | property Active: Boolean read FActive write FActive;
68 | property Health: Integer read FHealth write FHealth;
69 | property Lifetime: Integer read FLifetime write FLifetime;
70 | property Value: Integer read FValue write FValue;
71 | property Tag: Integer read FTag write FTag;
72 | property CollisionShape: TCollisionShape read FCollisionShape write FCollisionShape;
73 | property OwnsSprite: Boolean read FOwnsSprite write FOwnsSprite; // Added property
74 | procedure DecreaseHealth(Amount: Integer = 1);
75 | procedure IncreaseHealth(Amount: Integer = 1);
76 | procedure SetSpriteWithOwnership(ASprite: TAsciiSprite; AOwnSprite: Boolean = True); // New method
77 | end;
78 |
79 | TParticleSystem = class
80 | private
81 | FParticles: array of record
82 | X, Y: Double;
83 | VelX, VelY: Double;
84 | Char: WideChar;
85 | Color: string;
86 | Lifetime: Integer;
87 | Active: Boolean;
88 | end;
89 | FMaxParticles: Integer;
90 | public
91 | constructor Create(MaxParticles: Integer);
92 | procedure Emit(X, Y: Double; Count: Integer; Color: string; VelX, VelY, Spread: Double; Lifetime: Integer);
93 | procedure Update;
94 | procedure Render(Buffer: TAsciiBuffer);
95 | end;
96 |
97 | TGameManager = class
98 | private
99 | FBuffer: TAsciiBuffer;
100 | FEntities: TList;
101 | FParticleSystem: TParticleSystem;
102 | FPlayerIndex: Integer;
103 | FScore: Integer;
104 | FLevel: Integer;
105 | FLives: Integer;
106 | FGameState: Integer;
107 | FGameTime: Integer;
108 | FSpawnTimer: Integer;
109 | FPowerupTimer: Integer;
110 |
111 | // Sprites and animations
112 | FPlayerSprite: TAsciiSprite;
113 | FEnemySprites: array[0..2] of TAsciiSprite;
114 | FAsteroidSprites: array[0..2] of TAsciiSprite;
115 | FBulletSprite: TAsciiSprite;
116 | FExplosionAnimation: TAsciiSpriteAnimation;
117 | FPowerupSprite: TAsciiSprite;
118 | FBackgroundSprites: array[0..9] of TAsciiSprite;
119 |
120 | procedure LoadSprites;
121 | procedure InitGame;
122 | procedure UpdateEntities;
123 | procedure CheckCollisions;
124 | procedure UpdatePlayer;
125 | procedure SpawnEnemies;
126 | procedure RenderGame;
127 | procedure RenderUI;
128 | function FindPlayerEntity: TEntity;
129 | procedure CreateExplosion(X, Y: Double; Size: Integer);
130 | procedure CreatePlayerBullet(X, Y: Double);
131 | procedure CreateEnemyBullet(X, Y: Double);
132 | procedure CreateEnemy(X, Y: Double; EnemyType: Integer);
133 | procedure CreateAsteroid(X, Y: Double; Size: Integer);
134 | procedure CreatePowerup(X, Y: Double);
135 | procedure GameOver;
136 | procedure NextLevel;
137 | public
138 | constructor Create(ABuffer: TAsciiBuffer);
139 | destructor Destroy; override;
140 | procedure Run;
141 | end;
142 |
143 | const
144 | // Game states
145 | GAME_STATE_TITLE = 0;
146 | GAME_STATE_PLAYING = 1;
147 | GAME_STATE_GAME_OVER = 2;
148 |
149 | // Colors
150 | PLAYER_COLOR = CSIFGCyan;
151 | ENEMY_COLOR_A = CSIFGRed;
152 | ENEMY_COLOR_B = CSIFGMagenta;
153 | ENEMY_COLOR_C = CSIFGYellow;
154 | BULLET_COLOR = CSIFGGreen;
155 | EXPLOSION_COLOR = CSIFGRed;
156 | POWERUP_COLOR = CSIFGGreen;
157 |
158 | // Sprite definitions
159 | PLAYER_SPRITE =
160 | ' ^ ' + #13#10 +
161 | ' /|\\ ' + #13#10 +
162 | '/===\\';
163 |
164 | PLAYER_SPRITE_LEFT =
165 | ' ^ ' + #13#10 +
166 | ' //\\ ' + #13#10 +
167 | '/===\\';
168 |
169 | PLAYER_SPRITE_RIGHT =
170 | ' ^ ' + #13#10 +
171 | ' /\\\\ ' + #13#10 +
172 | '/===\\';
173 |
174 | ENEMY_SPRITE_A =
175 | '\\===/' + #13#10 +
176 | ' \\|/ ' + #13#10 +
177 | ' v ';
178 |
179 | ENEMY_SPRITE_B =
180 | ' /-\\ ' + #13#10 +
181 | '|-O-|' + #13#10 +
182 | ' \\-/ ';
183 |
184 | ENEMY_SPRITE_C =
185 | ' /^\\ ' + #13#10 +
186 | '/| |\\' + #13#10 +
187 | '\\___/';
188 |
189 | ASTEROID_SPRITE_LARGE =
190 | ' __ ' + #13#10 +
191 | ' / \\ ' + #13#10 +
192 | '| |' + #13#10 +
193 | ' \\__/ ';
194 |
195 | ASTEROID_SPRITE_MEDIUM =
196 | ' /\\ ' + #13#10 +
197 | '| |' + #13#10 +
198 | ' \\/ ';
199 |
200 | ASTEROID_SPRITE_SMALL =
201 | '/\\' + #13#10 +
202 | '\\/';
203 |
204 | BULLET_SPRITE =
205 | '|' + #13#10 +
206 | '|';
207 |
208 | POWERUP_SPRITE =
209 | '/P\\' + #13#10 +
210 | '\\-/';
211 |
212 | // Explosion animation frames
213 | EXPLOSION_FRAME_1 =
214 | ' * ' + #13#10 +
215 | '* *' + #13#10 +
216 | ' * ';
217 |
218 | EXPLOSION_FRAME_2 =
219 | '\\*/' + #13#10 +
220 | '-*-' + #13#10 +
221 | '/*\\';
222 |
223 | EXPLOSION_FRAME_3 =
224 | '\\|/' + #13#10 +
225 | '-O-' + #13#10 +
226 | '/|\\';
227 |
228 | EXPLOSION_FRAME_4 =
229 | ' . ' + #13#10 +
230 | '. .' + #13#10 +
231 | ' . ';
232 |
233 | { TEntity Implementation }
234 |
235 | constructor TEntity.Create(EntityType: TEntityType; X, Y: Double);
236 | begin
237 | inherited Create;
238 | FType := EntityType;
239 | FX := X;
240 | FY := Y;
241 | FVelX := 0;
242 | FVelY := 0;
243 | FSprite := nil;
244 | FAnimation := nil;
245 | FCollisionShape := csNone;
246 | FCollisionRadius := 0;
247 | FCollisionWidth := 0;
248 | FCollisionHeight := 0;
249 | FActive := True;
250 | FHealth := 1;
251 | FLifetime := -1; // -1 means infinite lifetime
252 | FValue := 0;
253 | FTag := 0;
254 | FOwnsSprite := False; // Default: don't own sprite
255 | end;
256 |
257 | destructor TEntity.Destroy;
258 | begin
259 | // Free sprite if we own it
260 | if FOwnsSprite and Assigned(FSprite) then
261 | FSprite.Free;
262 |
263 | // Note: We don't free FAnimation as that's managed elsewhere
264 | inherited;
265 | end;
266 |
267 | procedure TEntity.SetSpriteWithOwnership(ASprite: TAsciiSprite; AOwnSprite: Boolean = True);
268 | begin
269 | // Free old sprite if we own it
270 | if FOwnsSprite and Assigned(FSprite) then
271 | FSprite.Free;
272 |
273 | // Set new sprite and ownership flag
274 | FSprite := ASprite;
275 | FOwnsSprite := AOwnSprite;
276 | end;
277 |
278 | procedure TEntity.Update;
279 | begin
280 | // Update position based on velocity
281 | FX := FX + FVelX;
282 | FY := FY + FVelY;
283 |
284 | // Update animation if present
285 | if Assigned(FAnimation) then
286 | FAnimation.Update;
287 |
288 | // Update lifetime if set
289 | if FLifetime > 0 then
290 | begin
291 | Dec(FLifetime);
292 | if FLifetime <= 0 then
293 | FActive := False;
294 | end;
295 | end;
296 |
297 | procedure TEntity.DecreaseHealth(Amount: Integer = 1);
298 | begin
299 | FHealth := FHealth - Amount;
300 | end;
301 |
302 | procedure TEntity.IncreaseHealth(Amount: Integer = 1);
303 | begin
304 | FHealth := FHealth + Amount;
305 | end;
306 |
307 | function TEntity.CheckCollision(Other: TEntity): Boolean;
308 | var
309 | Distance, RadiusSum: Double;
310 | Dx, Dy: Double;
311 | begin
312 | Result := False;
313 |
314 | // Skip if either entity has no collision shape
315 | if (FCollisionShape = csNone) or (Other.FCollisionShape = csNone) then
316 | Exit;
317 |
318 | // Get distance between entities - used by many collision checks
319 | Dx := FX - Other.FX;
320 | Dy := FY - Other.FY;
321 | Distance := Sqrt(Dx * Dx + Dy * Dy);
322 |
323 | // Special case for bullets - be more lenient
324 | if (EntityType = etBullet) or (Other.EntityType = etBullet) then
325 | begin
326 | // More forgiving bullet collision - if close enough, count as hit
327 | Result := Distance < 2.5; // Increased from 2.0 for better hit detection
328 | Exit;
329 | end;
330 |
331 | case FCollisionShape of
332 | csPoint:
333 | begin
334 | case Other.FCollisionShape of
335 | csPoint:
336 | Result := (Round(FX) = Round(Other.FX)) and (Round(FY) = Round(Other.FY));
337 |
338 | csRect:
339 | Result := (FX >= Other.FX - Other.FCollisionWidth / 2) and
340 | (FX <= Other.FX + Other.FCollisionWidth / 2) and
341 | (FY >= Other.FY - Other.FCollisionHeight / 2) and
342 | (FY <= Other.FY + Other.FCollisionHeight / 2);
343 |
344 | csCircle:
345 | Result := Distance <= Other.FCollisionRadius + 0.5; // Add small buffer
346 | end;
347 | end;
348 |
349 | csRect:
350 | begin
351 | case Other.FCollisionShape of
352 | csPoint:
353 | Result := (Other.FX >= FX - FCollisionWidth / 2) and
354 | (Other.FX <= FX + FCollisionWidth / 2) and
355 | (Other.FY >= FY - FCollisionHeight / 2) and
356 | (Other.FY <= FY + FCollisionHeight / 2);
357 |
358 | csRect:
359 | Result := not ((FX + FCollisionWidth / 2 < Other.FX - Other.FCollisionWidth / 2) or
360 | (FX - FCollisionWidth / 2 > Other.FX + Other.FCollisionWidth / 2) or
361 | (FY + FCollisionHeight / 2 < Other.FY - Other.FCollisionHeight / 2) or
362 | (FY - FCollisionHeight / 2 > Other.FY + Other.FCollisionHeight / 2));
363 |
364 | csCircle:
365 | begin
366 | // Simplified rect vs circle collision
367 | Result := Distance <= Other.FCollisionRadius +
368 | (FCollisionWidth + FCollisionHeight) / 4 + 0.5; // Add buffer
369 | end;
370 | end;
371 | end;
372 |
373 | csCircle:
374 | begin
375 | case Other.FCollisionShape of
376 | csPoint:
377 | Result := Distance <= FCollisionRadius + 0.5; // Add small buffer
378 |
379 | csRect:
380 | begin
381 | // Simplified circle vs rect collision
382 | Result := Distance <= FCollisionRadius +
383 | (Other.FCollisionWidth + Other.FCollisionHeight) / 4 + 0.5; // Add buffer
384 | end;
385 |
386 | csCircle:
387 | begin
388 | RadiusSum := FCollisionRadius + Other.FCollisionRadius + 0.5; // Add buffer
389 | Result := Distance <= RadiusSum;
390 | end;
391 | end;
392 | end;
393 | end;
394 | end;
395 |
396 | { TParticleSystem Implementation }
397 |
398 | constructor TParticleSystem.Create(MaxParticles: Integer);
399 | var
400 | I: Integer;
401 | begin
402 | inherited Create;
403 | FMaxParticles := MaxParticles;
404 | SetLength(FParticles, FMaxParticles);
405 |
406 | for I := 0 to FMaxParticles - 1 do
407 | FParticles[I].Active := False;
408 | end;
409 |
410 | procedure TParticleSystem.Emit(X, Y: Double; Count: Integer; Color: string; VelX, VelY, Spread: Double; Lifetime: Integer);
411 | var
412 | I, J: Integer;
413 | Angle: Double;
414 | Speed: Double;
415 | ParticleChars: array[0..5] of WideChar;
416 | begin
417 | // Define possible particle characters
418 | ParticleChars[0] := '.';
419 | ParticleChars[1] := '*';
420 | ParticleChars[2] := '+';
421 | ParticleChars[3] := 'o';
422 | ParticleChars[4] := 'x';
423 | ParticleChars[5] := '#';
424 |
425 | // Find inactive particles and activate them
426 | J := 0;
427 | for I := 0 to FMaxParticles - 1 do
428 | begin
429 | if not FParticles[I].Active then
430 | begin
431 | // Set particle properties
432 | FParticles[I].X := X;
433 | FParticles[I].Y := Y;
434 |
435 | // Calculate random velocity direction within spread
436 | Angle := TConsole.RandomRange(0, 628) / 100;
437 | Speed := 0.5 + TConsole.RandomRange(0, 50) / 100;
438 |
439 | FParticles[I].VelX := VelX + Cos(Angle) * Speed * Spread;
440 | FParticles[I].VelY := VelY + Sin(Angle) * Speed * Spread;
441 |
442 | // Set random character and color
443 | FParticles[I].Char := ParticleChars[TConsole.RandomRange(0, Length(ParticleChars))];
444 | FParticles[I].Color := Color;
445 |
446 | // Set lifetime with some randomness
447 | FParticles[I].Lifetime := Lifetime + TConsole.RandomRange(-3, 4);
448 | FParticles[I].Active := True;
449 |
450 | // Count particles created
451 | Inc(J);
452 | if J >= Count then
453 | Break;
454 | end;
455 | end;
456 | end;
457 |
458 | procedure TParticleSystem.Update;
459 | var
460 | I: Integer;
461 | begin
462 | for I := 0 to FMaxParticles - 1 do
463 | begin
464 | if FParticles[I].Active then
465 | begin
466 | // Update position
467 | FParticles[I].X := FParticles[I].X + FParticles[I].VelX;
468 | FParticles[I].Y := FParticles[I].Y + FParticles[I].VelY;
469 |
470 | // Apply gravity
471 | FParticles[I].VelY := FParticles[I].VelY + 0.01;
472 |
473 | // Reduce lifetime
474 | Dec(FParticles[I].Lifetime);
475 | if FParticles[I].Lifetime <= 0 then
476 | FParticles[I].Active := False;
477 | end;
478 | end;
479 | end;
480 |
481 | procedure TParticleSystem.Render(Buffer: TAsciiBuffer);
482 | var
483 | I: Integer;
484 | X, Y: Integer;
485 | begin
486 | for I := 0 to FMaxParticles - 1 do
487 | begin
488 | if FParticles[I].Active then
489 | begin
490 | X := Round(FParticles[I].X);
491 | Y := Round(FParticles[I].Y);
492 |
493 | Buffer.PutChar(X, Y, FParticles[I].Char, FParticles[I].Color, CSIBGBlack);
494 | end;
495 | end;
496 | end;
497 |
498 | { TGameManager Implementation }
499 |
500 | constructor TGameManager.Create(ABuffer: TAsciiBuffer);
501 | begin
502 | inherited Create;
503 | FBuffer := ABuffer;
504 | FEntities := TList.Create;
505 | FParticleSystem := TParticleSystem.Create(300);
506 |
507 | // Start in title screen state
508 | FGameState := GAME_STATE_TITLE;
509 |
510 | LoadSprites;
511 | InitGame;
512 | end;
513 |
514 | destructor TGameManager.Destroy;
515 | var
516 | I: Integer;
517 | LEntity: TEntity;
518 | begin
519 | // Free all entities
520 | for I := 0 to FEntities.Count - 1 do
521 | begin
522 | LEntity := TEntity(FEntities[I]);
523 | LEntity.Free;
524 | end;
525 | FEntities.Free;
526 |
527 | // Free particle system
528 | FParticleSystem.Free;
529 |
530 | // Free sprites
531 | FPlayerSprite.Free;
532 | for I := 0 to Length(FEnemySprites) - 1 do
533 | FEnemySprites[I].Free;
534 | for I := 0 to Length(FAsteroidSprites) - 1 do
535 | FAsteroidSprites[I].Free;
536 | FBulletSprite.Free;
537 | FExplosionAnimation.Free; // Just free the animation, the frames are managed internally
538 | FPowerupSprite.Free;
539 | for I := 0 to Length(FBackgroundSprites) - 1 do
540 | if Assigned(FBackgroundSprites[I]) then
541 | FBackgroundSprites[I].Free;
542 |
543 | inherited;
544 | end;
545 |
546 | procedure TGameManager.LoadSprites;
547 | var
548 | ExplosionFrame: TAsciiSprite;
549 | I: Integer;
550 | begin
551 | // Player sprite
552 | FPlayerSprite := TAsciiSprite.Create(5, 3);
553 | FPlayerSprite.LoadFromString(PLAYER_SPRITE, PLAYER_COLOR, CSIBGBlack);
554 |
555 | // Enemy sprites
556 | FEnemySprites[0] := TAsciiSprite.Create(5, 3);
557 | FEnemySprites[0].LoadFromString(ENEMY_SPRITE_A, ENEMY_COLOR_A, CSIBGBlack);
558 |
559 | FEnemySprites[1] := TAsciiSprite.Create(5, 3);
560 | FEnemySprites[1].LoadFromString(ENEMY_SPRITE_B, ENEMY_COLOR_B, CSIBGBlack);
561 |
562 | FEnemySprites[2] := TAsciiSprite.Create(5, 3);
563 | FEnemySprites[2].LoadFromString(ENEMY_SPRITE_C, ENEMY_COLOR_C, CSIBGBlack);
564 |
565 | // Asteroid sprites
566 | FAsteroidSprites[0] := TAsciiSprite.Create(6, 4);
567 | FAsteroidSprites[0].LoadFromString(ASTEROID_SPRITE_LARGE, CSIFGWhite, CSIBGBlack);
568 |
569 | FAsteroidSprites[1] := TAsciiSprite.Create(4, 3);
570 | FAsteroidSprites[1].LoadFromString(ASTEROID_SPRITE_MEDIUM, CSIFGWhite, CSIBGBlack);
571 |
572 | FAsteroidSprites[2] := TAsciiSprite.Create(2, 2);
573 | FAsteroidSprites[2].LoadFromString(ASTEROID_SPRITE_SMALL, CSIFGWhite, CSIBGBlack);
574 |
575 | // Bullet sprite
576 | FBulletSprite := TAsciiSprite.Create(1, 2);
577 | FBulletSprite.LoadFromString(BULLET_SPRITE, BULLET_COLOR, CSIBGBlack);
578 |
579 | // Explosion animation
580 | FExplosionAnimation := TAsciiSpriteAnimation.Create(3, False);
581 |
582 | ExplosionFrame := TAsciiSprite.Create(3, 3);
583 | ExplosionFrame.LoadFromString(EXPLOSION_FRAME_1, EXPLOSION_COLOR, CSIBGBlack);
584 | FExplosionAnimation.AddFrame(ExplosionFrame);
585 |
586 | ExplosionFrame := TAsciiSprite.Create(3, 3);
587 | ExplosionFrame.LoadFromString(EXPLOSION_FRAME_2, EXPLOSION_COLOR, CSIBGBlack);
588 | FExplosionAnimation.AddFrame(ExplosionFrame);
589 |
590 | ExplosionFrame := TAsciiSprite.Create(3, 3);
591 | ExplosionFrame.LoadFromString(EXPLOSION_FRAME_3, EXPLOSION_COLOR, CSIBGBlack);
592 | FExplosionAnimation.AddFrame(ExplosionFrame);
593 |
594 | ExplosionFrame := TAsciiSprite.Create(3, 3);
595 | ExplosionFrame.LoadFromString(EXPLOSION_FRAME_4, EXPLOSION_COLOR, CSIBGBlack);
596 | FExplosionAnimation.AddFrame(ExplosionFrame);
597 |
598 | // Powerup sprite
599 | FPowerupSprite := TAsciiSprite.Create(3, 2);
600 | FPowerupSprite.LoadFromString(POWERUP_SPRITE, POWERUP_COLOR, CSIBGBlack);
601 |
602 | // Initialize background sprites array (will be filled in InitGame)
603 | for I := 0 to Length(FBackgroundSprites) - 1 do
604 | FBackgroundSprites[I] := nil;
605 | end;
606 |
607 | procedure TGameManager.InitGame;
608 | var
609 | I: Integer;
610 | ConsoleWidth, ConsoleHeight: Integer;
611 | LStarEntity: TEntity;
612 | LStarSprite: TAsciiSprite;
613 | begin
614 | // Get console dimensions
615 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
616 |
617 | // Clear all existing entities
618 | for I := 0 to FEntities.Count - 1 do
619 | TEntity(FEntities[I]).Free;
620 | FEntities.Clear;
621 |
622 | // Reset game state
623 | FScore := 0;
624 | FLevel := 1;
625 | FLives := 3;
626 | // Don't change FGameState here - leave it as is
627 | FGameTime := 0;
628 | FSpawnTimer := 0;
629 | FPowerupTimer := 0;
630 |
631 | // Create player entity
632 | FPlayerIndex := FEntities.Add(TEntity.Create(etPlayer, ConsoleWidth / 2, ConsoleHeight - 5));
633 | TEntity(FEntities[FPlayerIndex]).SetSpriteWithOwnership(FPlayerSprite, False); // Don't own shared sprite
634 | TEntity(FEntities[FPlayerIndex]).Health := 3;
635 | TEntity(FEntities[FPlayerIndex]).CollisionShape := csRect;
636 | TEntity(FEntities[FPlayerIndex]).FCollisionWidth := 5;
637 | TEntity(FEntities[FPlayerIndex]).FCollisionHeight := 3;
638 |
639 | // Create background stars
640 | for I := 0 to 30 do
641 | begin
642 | LStarEntity := TEntity.Create(etBackground, TConsole.RandomRange(0, ConsoleWidth),
643 | TConsole.RandomRange(0, ConsoleHeight));
644 |
645 | // Create star sprite - this one is owned by the entity
646 | LStarSprite := TAsciiSprite.Create(1, 1);
647 | LStarSprite.SetChar(0, 0, '.', CSIFGWhite + CSIDim, CSIBGBlack);
648 |
649 | LStarEntity.SetSpriteWithOwnership(LStarSprite, True); // Entity owns this sprite
650 | LStarEntity.VelY := 0.1 + TConsole.RandomRange(0, 20) / 100;
651 | FEntities.Add(LStarEntity);
652 | end;
653 | end;
654 |
655 | function TGameManager.FindPlayerEntity: TEntity;
656 | begin
657 | if (FPlayerIndex >= 0) and (FPlayerIndex < FEntities.Count) then
658 | Result := TEntity(FEntities[FPlayerIndex])
659 | else
660 | Result := nil;
661 | end;
662 |
663 | procedure TGameManager.CreateExplosion(X, Y: Double; Size: Integer);
664 | var
665 | Explosion: TEntity;
666 | I: Integer;
667 | LOffsetX, LOffsetY: Double;
668 | begin
669 | // Create explosion entity
670 | Explosion := TEntity.Create(etExplosion, X, Y);
671 | Explosion.Animation := FExplosionAnimation;
672 | Explosion.Animation.Reset;
673 | Explosion.Lifetime := 12;
674 | FEntities.Add(Explosion);
675 |
676 | // Create particle effects
677 | FParticleSystem.Emit(X, Y, 10 + Size * 5, EXPLOSION_COLOR, 0, 0, 1.0, 15);
678 |
679 | // Add explosion effects for large explosions
680 | if Size >= 2 then
681 | begin
682 | for I := 0 to 2 do
683 | begin
684 | LOffsetX := TConsole.RandomRange(-2, 3);
685 | LOffsetY := TConsole.RandomRange(-2, 3);
686 |
687 | Explosion := TEntity.Create(etExplosion, X + LOffsetX, Y + LOffsetY);
688 | Explosion.Animation := FExplosionAnimation; // Use same shared animation
689 | Explosion.Animation.Reset;
690 | Explosion.Lifetime := 8 + TConsole.RandomRange(0, 5);
691 | FEntities.Add(Explosion);
692 | end;
693 | end;
694 | end;
695 |
696 | procedure TGameManager.CreatePlayerBullet(X, Y: Double);
697 | var
698 | Bullet: TEntity;
699 | begin
700 | Bullet := TEntity.Create(etBullet, X, Y);
701 | Bullet.SetSpriteWithOwnership(FBulletSprite, False); // Don't own shared sprite
702 | Bullet.VelY := -0.8; // Fast upward movement
703 | Bullet.Tag := 1; // Player bullet
704 |
705 | // Fix collision detection for bullets
706 | Bullet.CollisionShape := csPoint; // Point-based collision for better detection
707 |
708 | FEntities.Add(Bullet);
709 |
710 | // Add thruster particles
711 | FParticleSystem.Emit(X, Y + 1, 3, BULLET_COLOR, 0, 0.2, 0.3, 5);
712 | end;
713 |
714 | procedure TGameManager.CreateEnemyBullet(X, Y: Double);
715 | var
716 | Bullet: TEntity;
717 | begin
718 | Bullet := TEntity.Create(etBullet, X, Y);
719 | Bullet.SetSpriteWithOwnership(FBulletSprite, False); // Don't own shared sprite
720 | Bullet.VelY := 0.5;
721 | Bullet.Tag := 2; // Enemy bullet
722 | Bullet.CollisionShape := csRect;
723 | Bullet.FCollisionWidth := 1;
724 | Bullet.FCollisionHeight := 2;
725 | FEntities.Add(Bullet);
726 | end;
727 |
728 | procedure TGameManager.CreateEnemy(X, Y: Double; EnemyType: Integer);
729 | var
730 | Enemy: TEntity;
731 | begin
732 | Enemy := TEntity.Create(etEnemy, X, Y);
733 | Enemy.SetSpriteWithOwnership(FEnemySprites[EnemyType mod 3], False); // Don't own shared sprite
734 | Enemy.Tag := EnemyType;
735 | Enemy.Health := 1 + (EnemyType div 3);
736 | Enemy.Value := 10 * (EnemyType + 1);
737 |
738 | // Different movement patterns based on type
739 | case EnemyType mod 3 of
740 | 0: begin
741 | Enemy.VelY := 0.2;
742 | Enemy.VelX := 0;
743 | end;
744 | 1: begin
745 | Enemy.VelY := 0.15;
746 | Enemy.VelX := 0.1 * Sin(FGameTime / 20);
747 | end;
748 | 2: begin
749 | Enemy.VelY := 0.12;
750 | Enemy.VelX := 0.2;
751 | Enemy.Tag := EnemyType + 10; // Special tag for tracking sine movement
752 | end;
753 | end;
754 |
755 | // Improve collision detection
756 | Enemy.CollisionShape := csCircle; // Circle for better detection
757 | Enemy.FCollisionRadius := 2.5; // About half the width of enemy sprites
758 |
759 | FEntities.Add(Enemy);
760 | end;
761 |
762 | procedure TGameManager.CreateAsteroid(X, Y: Double; Size: Integer);
763 | var
764 | Asteroid: TEntity;
765 | begin
766 | Asteroid := TEntity.Create(etAsteroid, X, Y);
767 | Asteroid.SetSpriteWithOwnership(FAsteroidSprites[Size], False); // Don't own shared sprite
768 | Asteroid.Tag := Size;
769 | Asteroid.Health := Size + 1;
770 | Asteroid.Value := 5 * (3 - Size);
771 |
772 | // Random velocity based on size
773 | Asteroid.VelX := (TConsole.RandomRange(-20, 21) / 100) * (3 - Size);
774 | Asteroid.VelY := 0.1 + (TConsole.RandomRange(0, 20) / 100) * (3 - Size);
775 |
776 | Asteroid.CollisionShape := csCircle;
777 | case Size of
778 | 0: Asteroid.FCollisionRadius := 3;
779 | 1: Asteroid.FCollisionRadius := 2;
780 | 2: Asteroid.FCollisionRadius := 1;
781 | end;
782 |
783 | FEntities.Add(Asteroid);
784 | end;
785 |
786 | procedure TGameManager.CreatePowerup(X, Y: Double);
787 | var
788 | Powerup: TEntity;
789 | begin
790 | Powerup := TEntity.Create(etPowerup, X, Y);
791 | Powerup.SetSpriteWithOwnership(FPowerupSprite, False); // Don't own shared sprite
792 | Powerup.VelY := 0.2;
793 | Powerup.Tag := TConsole.RandomRange(0, 3); // Random powerup type
794 | Powerup.CollisionShape := csRect;
795 | Powerup.FCollisionWidth := 3;
796 | Powerup.FCollisionHeight := 2;
797 |
798 | FEntities.Add(Powerup);
799 | end;
800 |
801 | procedure TGameManager.UpdateEntities;
802 | var
803 | I: Integer;
804 | Entity: TEntity;
805 | ConsoleWidth, ConsoleHeight: Integer;
806 | begin
807 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
808 |
809 | // Update all entities
810 | I := 0;
811 | while I < FEntities.Count do
812 | begin
813 | Entity := TEntity(FEntities[I]);
814 |
815 | if Entity.Active then
816 | begin
817 | // Update entity
818 | Entity.Update;
819 |
820 | // Special handling based on entity type
821 | case Entity.EntityType of
822 | etEnemy:
823 | begin
824 | // Check if enemy is out of bounds
825 | if (Entity.Y > ConsoleHeight + 2) or
826 | (Entity.X < -5) or (Entity.X > ConsoleWidth + 5) then
827 | begin
828 | Entity.Active := False;
829 | end
830 | else
831 | begin
832 | // Special movement patterns
833 | if (Entity.Tag >= 10) then
834 | begin
835 | // Sine wave movement
836 | Entity.VelX := 0.2 * Sin(FGameTime / 20);
837 | end;
838 |
839 | // Fire bullets randomly
840 | if (TConsole.RandomRange(0, 100) < 1 + FLevel) and (Entity.Y < ConsoleHeight - 10) then
841 | CreateEnemyBullet(Entity.X, Entity.Y + 2);
842 | end;
843 | end;
844 |
845 | etAsteroid:
846 | begin
847 | // Check if asteroid is out of bounds
848 | if (Entity.Y > ConsoleHeight + 5) then
849 | begin
850 | Entity.Active := False;
851 | end
852 | else
853 | begin
854 | // Screen wrapping for asteroids
855 | if Entity.X < -5 then
856 | Entity.X := ConsoleWidth + 4
857 | else if Entity.X > ConsoleWidth + 5 then
858 | Entity.X := -4;
859 | end;
860 | end;
861 |
862 | etBullet:
863 | begin
864 | // Check if bullet is out of bounds
865 | if (Entity.Y < -2) or (Entity.Y > ConsoleHeight + 2) then
866 | Entity.Active := False;
867 | end;
868 |
869 | etPowerup:
870 | begin
871 | // Check if powerup is out of bounds
872 | if Entity.Y > ConsoleHeight + 2 then
873 | Entity.Active := False;
874 | end;
875 |
876 | etBackground:
877 | begin
878 | // Wrap around screen for background elements
879 | if Entity.Y > ConsoleHeight then
880 | begin
881 | Entity.Y := 0;
882 | Entity.X := TConsole.RandomRange(0, ConsoleWidth);
883 | end;
884 | end;
885 | end;
886 |
887 | Inc(I);
888 | end
889 | else
890 | begin
891 | // Remove inactive entities
892 | Entity.Free;
893 | FEntities.Delete(I);
894 |
895 | // Adjust player index if needed
896 | if I <= FPlayerIndex then
897 | Dec(FPlayerIndex);
898 | end;
899 | end;
900 | end;
901 |
902 | procedure TGameManager.UpdatePlayer;
903 | var
904 | Player: TEntity;
905 | ConsoleWidth, ConsoleHeight: Integer;
906 | LNewSprite: TAsciiSprite;
907 | begin
908 | Player := FindPlayerEntity;
909 | if not Assigned(Player) or not Player.Active then
910 | Exit;
911 |
912 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
913 |
914 | // Handle player movement
915 | if TConsole.IsKeyPressed(VK_LEFT) then
916 | begin
917 | Player.VelX := Player.VelX - 0.1;
918 | if Player.VelX < -0.6 then
919 | Player.VelX := -0.6;
920 |
921 | // Change sprite to left-tilting ship
922 | if Player.Sprite <> FPlayerSprite then
923 | begin
924 | // Player already has a custom sprite - just update it
925 | if Player.OwnsSprite then
926 | begin
927 | // Already has an owned sprite, just update its content
928 | Player.Sprite.LoadFromString(PLAYER_SPRITE_LEFT, PLAYER_COLOR, CSIBGBlack);
929 | end
930 | else
931 | begin
932 | // Create a new sprite
933 | LNewSprite := TAsciiSprite.Create(5, 3);
934 | LNewSprite.LoadFromString(PLAYER_SPRITE_LEFT, PLAYER_COLOR, CSIBGBlack);
935 | Player.SetSpriteWithOwnership(LNewSprite, True);
936 | end;
937 | end;
938 | end
939 | else if TConsole.IsKeyPressed(VK_RIGHT) then
940 | begin
941 | Player.VelX := Player.VelX + 0.1;
942 | if Player.VelX > 0.6 then
943 | Player.VelX := 0.6;
944 |
945 | // Change sprite to right-tilting ship
946 | if Player.Sprite <> FPlayerSprite then
947 | begin
948 | // Player already has a custom sprite - just update it
949 | if Player.OwnsSprite then
950 | begin
951 | // Already has an owned sprite, just update its content
952 | Player.Sprite.LoadFromString(PLAYER_SPRITE_RIGHT, PLAYER_COLOR, CSIBGBlack);
953 | end
954 | else
955 | begin
956 | // Create a new sprite
957 | LNewSprite := TAsciiSprite.Create(5, 3);
958 | LNewSprite.LoadFromString(PLAYER_SPRITE_RIGHT, PLAYER_COLOR, CSIBGBlack);
959 | Player.SetSpriteWithOwnership(LNewSprite, True);
960 | end;
961 | end;
962 | end
963 | else
964 | begin
965 | // Decelerate when no keys pressed
966 | Player.VelX := Player.VelX * 0.9;
967 |
968 | // If not already using the normal sprite, switch to it
969 | if Player.Sprite <> FPlayerSprite then
970 | begin
971 | Player.SetSpriteWithOwnership(FPlayerSprite, False);
972 | end;
973 | end;
974 |
975 | // Fire bullet with spacebar
976 | if TConsole.WasKeyPressed(VK_SPACE) then
977 | begin
978 | CreatePlayerBullet(Player.X, Player.Y - 2);
979 |
980 | // Add thruster particles
981 | FParticleSystem.Emit(Player.X, Player.Y + 2, 5, CSIFGYellow, 0, 0.2, 0.8, 10);
982 | end;
983 |
984 | // Screen boundary checks
985 | if Player.X < 3 then
986 | begin
987 | Player.X := 3;
988 | Player.VelX := 0;
989 | end
990 | else if Player.X > ConsoleWidth - 3 then
991 | begin
992 | Player.X := ConsoleWidth - 3;
993 | Player.VelX := 0;
994 | end;
995 |
996 | // Add engine particle effects
997 | if FGameTime mod 5 = 0 then
998 | FParticleSystem.Emit(Player.X, Player.Y + 2, 1, CSIFGYellow, 0, 0.2, 0.4, 10);
999 | end;
1000 |
1001 | procedure TGameManager.CheckCollisions;
1002 | var
1003 | I, J, K: Integer;
1004 | EntityA, EntityB: TEntity;
1005 | Bullet, Target, Enemy, PlayerEntity: TEntity;
1006 | LConsoleWidth, LConsoleHeight: Integer;
1007 | begin
1008 | for I := 0 to FEntities.Count - 1 do
1009 | begin
1010 | EntityA := TEntity(FEntities[I]);
1011 | if not EntityA.Active then
1012 | Continue;
1013 |
1014 | for J := I + 1 to FEntities.Count - 1 do
1015 | begin
1016 | EntityB := TEntity(FEntities[J]);
1017 | if not EntityB.Active then
1018 | Continue;
1019 |
1020 | // Skip collision checks between certain types
1021 | if (EntityA.EntityType = etBackground) or (EntityB.EntityType = etBackground) or
1022 | (EntityA.EntityType = etExplosion) or (EntityB.EntityType = etExplosion) then
1023 | Continue;
1024 |
1025 | // Check for collision
1026 | if EntityA.CheckCollision(EntityB) then
1027 | begin
1028 | // Player bullets vs enemies/asteroids
1029 | if ((EntityA.EntityType = etBullet) and (EntityA.Tag = 1) and
1030 | ((EntityB.EntityType = etEnemy) or (EntityB.EntityType = etAsteroid))) or
1031 | ((EntityB.EntityType = etBullet) and (EntityB.Tag = 1) and
1032 | ((EntityA.EntityType = etEnemy) or (EntityA.EntityType = etAsteroid))) then
1033 | begin
1034 | // Determine which entity is the bullet and which is the target
1035 | if (EntityA.EntityType = etBullet) then
1036 | begin
1037 | Bullet := EntityA;
1038 | Target := EntityB;
1039 | end
1040 | else
1041 | begin
1042 | Bullet := EntityB;
1043 | Target := EntityA;
1044 | end;
1045 |
1046 | // Damage enemy/asteroid
1047 | Target.DecreaseHealth;
1048 | Bullet.Active := False;
1049 |
1050 | // Create hit effect
1051 | FParticleSystem.Emit(Bullet.X, Bullet.Y, 5, CSIFGWhite, 0, 0, 0.7, 8);
1052 |
1053 | if Target.Health <= 0 then
1054 | begin
1055 | // Add score
1056 | Inc(FScore, Target.Value);
1057 |
1058 | // Create explosion
1059 | CreateExplosion(Target.X, Target.Y, 1);
1060 |
1061 | // Split asteroids into smaller ones
1062 | if (Target.EntityType = etAsteroid) and (Target.Tag < 2) then
1063 | begin
1064 | for K := 0 to 1 do
1065 | begin
1066 | CreateAsteroid(Target.X, Target.Y, Target.Tag + 1);
1067 | end;
1068 | end;
1069 |
1070 | // Small chance of powerup from enemies
1071 | if (Target.EntityType = etEnemy) and (TConsole.RandomRange(0, 10) < 2) then
1072 | CreatePowerup(Target.X, Target.Y);
1073 |
1074 | Target.Active := False;
1075 | end
1076 | else
1077 | begin
1078 | // Flash effect for hit
1079 | if Target.EntityType = etEnemy then
1080 | FParticleSystem.Emit(Bullet.X, Bullet.Y, 3, ENEMY_COLOR_A, 0, 0, 0.5, 5)
1081 | else
1082 | FParticleSystem.Emit(Bullet.X, Bullet.Y, 3, CSIFGWhite, 0, 0, 0.5, 5);
1083 | end;
1084 | end
1085 | // Enemy bullets vs player
1086 | else if ((EntityA.EntityType = etBullet) and (EntityA.Tag = 2) and (EntityB.EntityType = etPlayer)) or
1087 | ((EntityB.EntityType = etBullet) and (EntityB.Tag = 2) and (EntityA.EntityType = etPlayer)) then
1088 | begin
1089 | // Determine which entity is the bullet and which is the player
1090 | if (EntityA.EntityType = etBullet) then
1091 | begin
1092 | Bullet := EntityA;
1093 | PlayerEntity := EntityB;
1094 | end
1095 | else
1096 | begin
1097 | Bullet := EntityB;
1098 | PlayerEntity := EntityA;
1099 | end;
1100 |
1101 | // Damage player
1102 | PlayerEntity.DecreaseHealth;
1103 | Bullet.Active := False;
1104 |
1105 | // Create small explosion
1106 | CreateExplosion(Bullet.X, Bullet.Y, 1);
1107 |
1108 | if PlayerEntity.Health <= 0 then
1109 | begin
1110 | // Player destroyed
1111 | CreateExplosion(PlayerEntity.X, PlayerEntity.Y, 2);
1112 | PlayerEntity.Active := False;
1113 |
1114 | Dec(FLives);
1115 | if FLives <= 0 then
1116 | GameOver
1117 | else
1118 | begin
1119 | // Respawn player
1120 | TConsole.GetSize(@LConsoleWidth, @LConsoleHeight);
1121 |
1122 | // Create new player entity
1123 | var LPlayerEntity := TEntity.Create(etPlayer, LConsoleWidth / 2, LConsoleHeight - 5);
1124 | LPlayerEntity.SetSpriteWithOwnership(FPlayerSprite, False); // Don't own shared sprite
1125 | LPlayerEntity.Health := 3;
1126 | LPlayerEntity.CollisionShape := csRect;
1127 | LPlayerEntity.FCollisionWidth := 5;
1128 | LPlayerEntity.FCollisionHeight := 3;
1129 |
1130 | FPlayerIndex := FEntities.Add(LPlayerEntity);
1131 | end;
1132 | end;
1133 | end
1134 | // Enemy or asteroid vs player
1135 | else if (((EntityA.EntityType = etEnemy) or (EntityA.EntityType = etAsteroid)) and
1136 | (EntityB.EntityType = etPlayer)) or
1137 | (((EntityB.EntityType = etEnemy) or (EntityB.EntityType = etAsteroid)) and
1138 | (EntityA.EntityType = etPlayer)) then
1139 | begin
1140 | // Determine which entity is the enemy/asteroid and which is the player
1141 | if (EntityA.EntityType = etPlayer) then
1142 | begin
1143 | PlayerEntity := EntityA;
1144 | Enemy := EntityB;
1145 | end
1146 | else
1147 | begin
1148 | PlayerEntity := EntityB;
1149 | Enemy := EntityA;
1150 | end;
1151 |
1152 | // Major collision - damage both
1153 | Enemy.DecreaseHealth;
1154 | PlayerEntity.DecreaseHealth(2);
1155 |
1156 | // Create explosion
1157 | CreateExplosion((Enemy.X + PlayerEntity.X) / 2, (Enemy.Y + PlayerEntity.Y) / 2, 2);
1158 |
1159 | if Enemy.Health <= 0 then
1160 | Enemy.Active := False;
1161 |
1162 | if PlayerEntity.Health <= 0 then
1163 | begin
1164 | // Player destroyed
1165 | CreateExplosion(PlayerEntity.X, PlayerEntity.Y, 2);
1166 | PlayerEntity.Active := False;
1167 |
1168 | Dec(FLives);
1169 | if FLives <= 0 then
1170 | GameOver
1171 | else
1172 | begin
1173 | // Respawn player
1174 | TConsole.GetSize(@LConsoleWidth, @LConsoleHeight);
1175 |
1176 | // Create new player entity with fixed variable name
1177 | var LPlayerEntity := TEntity.Create(etPlayer, LConsoleWidth / 2, LConsoleHeight - 5);
1178 | LPlayerEntity.SetSpriteWithOwnership(FPlayerSprite, False); // Don't own shared sprite
1179 | LPlayerEntity.Health := 3;
1180 | LPlayerEntity.CollisionShape := csRect;
1181 | LPlayerEntity.FCollisionWidth := 5;
1182 | LPlayerEntity.FCollisionHeight := 3;
1183 |
1184 | FPlayerIndex := FEntities.Add(LPlayerEntity);
1185 | end;
1186 | end;
1187 | end
1188 | // Powerup vs player
1189 | else if ((EntityA.EntityType = etPowerup) and (EntityB.EntityType = etPlayer)) or
1190 | ((EntityB.EntityType = etPowerup) and (EntityA.EntityType = etPlayer)) then
1191 | begin
1192 | // Determine which entity is the powerup
1193 | var LPowerup: TEntity;
1194 | if (EntityA.EntityType = etPowerup) then
1195 | LPowerup := EntityA
1196 | else
1197 | LPowerup := EntityB;
1198 |
1199 | // Apply powerup effect
1200 | case LPowerup.Tag of
1201 | 0: begin // Extra points
1202 | Inc(FScore, 50);
1203 | FParticleSystem.Emit(LPowerup.X, LPowerup.Y, 10, CSIFGGreen, 0, -0.2, 0.5, 15);
1204 | end;
1205 | 1: begin // Extra health
1206 | if (EntityA.EntityType = etPlayer) then
1207 | EntityA.IncreaseHealth
1208 | else
1209 | EntityB.IncreaseHealth;
1210 |
1211 | FParticleSystem.Emit(LPowerup.X, LPowerup.Y, 10, CSIFGCyan, 0, -0.2, 0.5, 15);
1212 | end;
1213 | 2: begin // Extra life
1214 | Inc(FLives);
1215 | FParticleSystem.Emit(LPowerup.X, LPowerup.Y, 10, CSIFGMagenta, 0, -0.2, 0.5, 15);
1216 | end;
1217 | end;
1218 |
1219 | LPowerup.Active := False;
1220 | end;
1221 | end;
1222 | end;
1223 | end;
1224 | end;
1225 |
1226 | procedure TGameManager.SpawnEnemies;
1227 | var
1228 | ConsoleWidth: Integer;
1229 | //I: Integer;
1230 | begin
1231 | Inc(FSpawnTimer);
1232 | Inc(FPowerupTimer);
1233 |
1234 | TConsole.GetSize(@ConsoleWidth, nil);
1235 |
1236 | // Spawn rate decreases as level increases
1237 | if FSpawnTimer >= Max(60 - FLevel * 5, 20) then
1238 | begin
1239 | FSpawnTimer := 0;
1240 |
1241 | // Random enemy or asteroid
1242 | if TConsole.RandomRange(0, 10) < 7 then
1243 | begin
1244 | // Spawn enemy
1245 | CreateEnemy(TConsole.RandomRange(10, ConsoleWidth - 10), 0, TConsole.RandomRange(0, 3));
1246 | end
1247 | else
1248 | begin
1249 | // Spawn asteroid
1250 | CreateAsteroid(TConsole.RandomRange(5, ConsoleWidth - 5), 0, 0);
1251 | end;
1252 | end;
1253 |
1254 | // Spawn powerups occasionally
1255 | if FPowerupTimer >= 500 then
1256 | begin
1257 | FPowerupTimer := 0;
1258 |
1259 | CreatePowerup(TConsole.RandomRange(10, ConsoleWidth - 10), 0);
1260 | end;
1261 | end;
1262 |
1263 | procedure TGameManager.GameOver;
1264 | begin
1265 | FGameState := GAME_STATE_GAME_OVER;
1266 | end;
1267 |
1268 | procedure TGameManager.NextLevel;
1269 | var
1270 | ConsoleWidth: Integer;
1271 | I: Integer;
1272 | begin
1273 | Inc(FLevel);
1274 |
1275 | // Increase difficulty
1276 | FSpawnTimer := 0;
1277 | FPowerupTimer := 0;
1278 |
1279 | // Bonus points for completing level
1280 | Inc(FScore, FLevel * 100);
1281 |
1282 | // Spawn wave of asteroids
1283 | TConsole.GetSize(@ConsoleWidth, nil);
1284 |
1285 | for I := 0 to 3 + FLevel do
1286 | CreateAsteroid(TConsole.RandomRange(5, ConsoleWidth - 5), 0, 0);
1287 | end;
1288 |
1289 | procedure TGameManager.RenderGame;
1290 | var
1291 | I: Integer;
1292 | Entity: TEntity;
1293 | ConsoleWidth, ConsoleHeight: Integer;
1294 | Title, GameOverTitle, ScoreText, LevelText, ReplayText, QuitText: string;
1295 | HealthChar: WideChar;
1296 | begin
1297 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
1298 |
1299 | // Clear the buffer
1300 | FBuffer.Clear(' ', CSIDim + CSIFGWhite, CSIBGBlack);
1301 |
1302 | // Handle different game states
1303 | case FGameState of
1304 | GAME_STATE_TITLE:
1305 | begin
1306 | // Draw title screen
1307 | Title := '* STELLAR DEFENDER *';
1308 | for I := 0 to Length(Title) - 1 do
1309 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(Title) div 2) + I, ConsoleHeight div 2 - 8,
1310 | Title[I+1], CSIFGCyan, CSIBGBlack);
1311 |
1312 | Title := 'A Space Shooter Adventure';
1313 | for I := 0 to Length(Title) - 1 do
1314 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(Title) div 2) + I, ConsoleHeight div 2 - 6,
1315 | Title[I+1], CSIFGWhite, CSIBGBlack);
1316 |
1317 | Title := 'Controls:';
1318 | for I := 0 to Length(Title) - 1 do
1319 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(Title) div 2) + I, ConsoleHeight div 2 - 3,
1320 | Title[I+1], CSIFGYellow, CSIBGBlack);
1321 |
1322 | Title := 'LEFT/RIGHT - Move Ship';
1323 | for I := 0 to Length(Title) - 1 do
1324 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(Title) div 2) + I, ConsoleHeight div 2 - 1,
1325 | Title[I+1], CSIFGWhite, CSIBGBlack);
1326 |
1327 | Title := 'SPACE - Fire Weapon';
1328 | for I := 0 to Length(Title) - 1 do
1329 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(Title) div 2) + I, ConsoleHeight div 2,
1330 | Title[I+1], CSIFGWhite, CSIBGBlack);
1331 |
1332 | Title := 'ESC - Quit Game';
1333 | for I := 0 to Length(Title) - 1 do
1334 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(Title) div 2) + I, ConsoleHeight div 2 + 1,
1335 | Title[I+1], CSIFGWhite, CSIBGBlack);
1336 |
1337 | Title := 'Press [S] to Start!';
1338 | for I := 0 to Length(Title) - 1 do
1339 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(Title) div 2) + I, ConsoleHeight div 2 + 4,
1340 | Title[I+1], CSIFGMagenta, CSIBGBlack);
1341 |
1342 | // Draw background stars
1343 | for I := 0 to FEntities.Count - 1 do
1344 | begin
1345 | Entity := TEntity(FEntities[I]);
1346 | if Entity.EntityType = etBackground then
1347 | FBuffer.PutSprite(Round(Entity.X), Round(Entity.Y), Entity.Sprite);
1348 | end;
1349 | end;
1350 |
1351 | GAME_STATE_PLAYING, GAME_STATE_GAME_OVER:
1352 | begin
1353 | // Draw all entities
1354 | for I := 0 to FEntities.Count - 1 do
1355 | begin
1356 | Entity := TEntity(FEntities[I]);
1357 |
1358 | if Entity.Active then
1359 | begin
1360 | if Assigned(Entity.Animation) then
1361 | FBuffer.PutSprite(Round(Entity.X), Round(Entity.Y), Entity.Animation.CurrentFrame)
1362 | else if Assigned(Entity.Sprite) then
1363 | FBuffer.PutSprite(Round(Entity.X), Round(Entity.Y), Entity.Sprite);
1364 |
1365 | // Add debug health display for enemies and asteroids
1366 | if (Entity.EntityType = etEnemy) or (Entity.EntityType = etAsteroid) then
1367 | begin
1368 | HealthChar := Chr(Ord('0') + Entity.Health);
1369 | FBuffer.PutChar(Round(Entity.X), Round(Entity.Y) - 1, HealthChar, CSIFGRed, CSIBGBlack);
1370 | end;
1371 | end;
1372 | end;
1373 |
1374 | // Draw particles
1375 | FParticleSystem.Render(FBuffer);
1376 |
1377 | // Render UI
1378 | RenderUI;
1379 |
1380 | // Draw game over screen if needed
1381 | if FGameState = GAME_STATE_GAME_OVER then
1382 | begin
1383 | GameOverTitle := 'GAME OVER';
1384 | for I := 0 to Length(GameOverTitle) - 1 do
1385 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(GameOverTitle) div 2) + I, ConsoleHeight div 2 - 5,
1386 | GameOverTitle[I+1], CSIFGRed, CSIBGBlack);
1387 |
1388 | ScoreText := Format('Final Score: %d', [FScore]);
1389 | for I := 0 to Length(ScoreText) - 1 do
1390 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(ScoreText) div 2) + I, ConsoleHeight div 2 - 2,
1391 | ScoreText[I+1], CSIFGWhite, CSIBGBlack);
1392 |
1393 | LevelText := Format('Levels Completed: %d', [FLevel - 1]);
1394 | for I := 0 to Length(LevelText) - 1 do
1395 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(LevelText) div 2) + I, ConsoleHeight div 2,
1396 | LevelText[I+1], CSIFGWhite, CSIBGBlack);
1397 |
1398 | ReplayText := 'Press [S] to Play Again';
1399 | for I := 0 to Length(ReplayText) - 1 do
1400 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(ReplayText) div 2) + I, ConsoleHeight div 2 + 3,
1401 | ReplayText[I+1], CSIFGYellow, CSIBGBlack);
1402 |
1403 | QuitText := 'Press ESC to Quit';
1404 | for I := 0 to Length(QuitText) - 1 do
1405 | FBuffer.PutChar((ConsoleWidth div 2) - (Length(QuitText) div 2) + I, ConsoleHeight div 2 + 5,
1406 | QuitText[I+1], CSIFGWhite, CSIBGBlack);
1407 | end;
1408 | end;
1409 | end;
1410 | end;
1411 |
1412 | procedure TGameManager.RenderUI;
1413 | var
1414 | I: Integer;
1415 | ConsoleWidth, ConsoleHeight: Integer;
1416 | StatusText, HealthBar, FPSText: string;
1417 | Player: TEntity;
1418 | begin
1419 | TConsole.GetSize(@ConsoleWidth, @ConsoleHeight);
1420 |
1421 | // Render top status bar
1422 | StatusText := Format('LEVEL: %d SCORE: %d LIVES: %d', [FLevel, FScore, FLives]);
1423 | for I := 0 to Length(StatusText) - 1 do
1424 | FBuffer.PutChar(2 + I, 1, StatusText[I+1], CSIFGWhite, CSIBGBlack);
1425 |
1426 | // Render health bar
1427 | Player := FindPlayerEntity;
1428 | if Assigned(Player) and Player.Active then
1429 | begin
1430 | HealthBar := Format('HEALTH: [%s]', [StringOfChar('=', Player.Health) +
1431 | StringOfChar('-', 5 - Player.Health)]);
1432 |
1433 | for I := 0 to Length(HealthBar) - 1 do
1434 | begin
1435 | if (I >= 8) and (I < 8 + Player.Health) then
1436 | FBuffer.PutChar(ConsoleWidth - Length(HealthBar) - 2 + I, 1, HealthBar[I+1], CSIFGGreen, CSIBGBlack)
1437 | else if I >= 8 then
1438 | FBuffer.PutChar(ConsoleWidth - Length(HealthBar) - 2 + I, 1, HealthBar[I+1], CSIFGRed, CSIBGBlack)
1439 | else
1440 | FBuffer.PutChar(ConsoleWidth - Length(HealthBar) - 2 + I, 1, HealthBar[I+1], CSIFGWhite, CSIBGBlack);
1441 | end;
1442 | end;
1443 |
1444 | // Show FPS in debug corner
1445 | FPSText := Format('FPS: %.1f', [FBuffer.ActualFPS]);
1446 | for I := 0 to Length(FPSText) - 1 do
1447 | FBuffer.PutChar(ConsoleWidth - Length(FPSText) - 1 + I, ConsoleHeight - 1, FPSText[I+1],
1448 | CSIFGWhite + CSIDim, CSIBGBlack);
1449 | end;
1450 |
1451 | procedure TGameManager.Run;
1452 | var
1453 | Running: Boolean;
1454 | begin
1455 | // Main game loop
1456 | Running := True;
1457 |
1458 | while Running do
1459 | begin
1460 | TConsole.ProcessMessages();
1461 |
1462 | // Process input
1463 | if TConsole.WasKeyPressed(VK_ESCAPE) then
1464 | begin
1465 | if FGameState = GAME_STATE_PLAYING then
1466 | begin
1467 | FGameState := GAME_STATE_TITLE;
1468 | //InitGame;
1469 | end
1470 | else
1471 | Running := False;
1472 | end;
1473 |
1474 | // Wait for next frame
1475 | if FBuffer.BeginFrame then
1476 | begin
1477 | // Increment game time
1478 | Inc(FGameTime);
1479 |
1480 | // Handle state-specific updates
1481 | case FGameState of
1482 | GAME_STATE_TITLE:
1483 | begin
1484 | // Update background stars
1485 | UpdateEntities;
1486 |
1487 | // Start game on space
1488 | if TConsole.WasKeyPressed(Ord('S')) then
1489 | begin
1490 | FGameState := GAME_STATE_PLAYING;
1491 | InitGame;
1492 | end;
1493 | end;
1494 |
1495 | GAME_STATE_PLAYING:
1496 | begin
1497 | // Update player
1498 | UpdatePlayer;
1499 |
1500 | // Update all entities
1501 | UpdateEntities;
1502 |
1503 | // Particle system update
1504 | FParticleSystem.Update;
1505 |
1506 | // Check for collisions
1507 | CheckCollisions;
1508 |
1509 | // Spawn new enemies
1510 | SpawnEnemies;
1511 |
1512 | // Check for level advancement
1513 | if (FGameTime mod 2000 = 0) and (FGameTime > 0) then
1514 | NextLevel;
1515 | end;
1516 |
1517 | GAME_STATE_GAME_OVER:
1518 | begin
1519 | // Update background elements
1520 | UpdateEntities;
1521 |
1522 | // Particle system update
1523 | FParticleSystem.Update;
1524 |
1525 | // Restart game on space
1526 | if TConsole.WasKeyPressed(Ord('S')) then
1527 | begin
1528 | InitGame;
1529 | FGameState := GAME_STATE_PLAYING;
1530 | end;
1531 | end;
1532 | end;
1533 |
1534 | // Render the game
1535 | RenderGame;
1536 |
1537 | // Complete the frame
1538 | FBuffer.EndFrame;
1539 | end;
1540 | end;
1541 | end;
1542 |
1543 | procedure Demo_StellarDefender;
1544 | var
1545 | Buffer: TAsciiBuffer;
1546 | MaxW, MaxH: Integer;
1547 | GameManager: TGameManager;
1548 | begin
1549 | TConsole.SetTitle('TConsole: Stellar Defender Demo');
1550 |
1551 | TConsole.ClearKeyStates();
1552 | TConsole.ClearScreen();
1553 | TConsole.SetCursorVisible(False);
1554 | TConsole.GetSize(@MaxW, @MaxH);
1555 |
1556 | Buffer := TAsciiBuffer.Create(MaxW, MaxH);
1557 | try
1558 | // Set target frame rate
1559 | Buffer.TargetFPS := 60;
1560 |
1561 | // Create and run game manager
1562 | GameManager := TGameManager.Create(Buffer);
1563 | try
1564 | GameManager.Run;
1565 | finally
1566 | GameManager.Free;
1567 | end;
1568 | finally
1569 | Buffer.Free;
1570 | TConsole.SetCursorVisible(True);
1571 | TConsole.ClearScreen();
1572 | end;
1573 | end;
1574 |
1575 | end.
1576 |
--------------------------------------------------------------------------------
/examples/testbed/UTestbed.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 | ===============================================================================}
15 |
16 | unit UTestbed;
17 |
18 | interface
19 |
20 | uses
21 | WinApi.Windows,
22 | System.SysUtils,
23 | System.Math,
24 | Console,
25 | Console.Buffer,
26 | UCommon,
27 | UDemo.Effects,
28 | UDemo.Buffer,
29 | UDemo.Sprite,
30 | UDemo.SpaceInvaders,
31 | UDemo.StellarAssault,
32 | UDemo.StellarDefender;
33 |
34 | procedure RunTests();
35 |
36 | implementation
37 |
38 | const
39 | CMainMenuTitle = 'TConsole: Main Menu';
40 |
41 | procedure RunTests();
42 | const
43 | // Menu constants
44 | MENU_ITEMS_COUNT = 21;
45 | MENU_START_Y = 7;
46 |
47 | // Colors
48 | TITLE_COLOR = CSIFGCyan;
49 | NORMAL_ITEM_COLOR = CSIFGWhite;
50 | SELECTED_ITEM_COLOR = CSIFGBrightYellow;
51 | SELECTED_ITEM_BG = CSIBGBlue;
52 |
53 | type
54 | TDemoType = (
55 | dtClockDisplay,
56 | dtDashboard,
57 | dtAnimationPlayer,
58 | dtBouncingText,
59 | dtWaveText,
60 | dtKaleidoscope,
61 | dtFractalTree,
62 | dtRainEffect,
63 | dtFireEffect,
64 | dtParticleSystem,
65 | dtColorTunnel,
66 | dtFlowingText,
67 | dtAdvancedAnimations,
68 | dtAdvancedEffects,
69 | dtAsciiBuffer,
70 | dtSprite,
71 | dtStellarAssault,
72 | dtSpaceInvaders,
73 | dtStellarDefender,
74 | dtPipeWrite,
75 | dtQuit
76 | );
77 |
78 | TMenuItem = record
79 | Title: string;
80 | DemoType: TDemoType;
81 | ShortcutKey: Char;
82 | end;
83 |
84 | var
85 | LDone: Boolean;
86 | CurrentSelection, LastSelection: Integer; // Added LastSelection to track changes
87 | MenuItems: array[0..MENU_ITEMS_COUNT-1] of TMenuItem;
88 | //i: Integer;
89 | InitialDraw: Boolean; // Flag for initial draw
90 |
91 | // Draw the menu - Initial full draw or selective update
92 | procedure DrawMenu(FullDraw: Boolean);
93 | var
94 | i: Integer;
95 | begin
96 | if FullDraw then
97 | begin
98 | // Clear screen and draw header only on full draw
99 | TConsole.ClearScreen();
100 | TConsole.PrintLogo(CSIFGMagenta);
101 | TConsole.Print(TITLE_COLOR+' Version %s'+CRLF, [TConsole.GetVersion()], False);
102 |
103 | // Draw menu items
104 | for i := 0 to MENU_ITEMS_COUNT-1 do
105 | begin
106 | // Set cursor position
107 | TConsole.SetCursorPos(2, MENU_START_Y + i);
108 |
109 | // Draw item
110 | if i = CurrentSelection then
111 | begin
112 | TConsole.SetForegroundColor(SELECTED_ITEM_COLOR);
113 | TConsole.SetBackgroundColor(SELECTED_ITEM_BG);
114 | TConsole.Print(' → ' + MenuItems[i].ShortcutKey + ') ' + MenuItems[i].Title + ' ', False);
115 | end
116 | else
117 | begin
118 | TConsole.SetForegroundColor(NORMAL_ITEM_COLOR);
119 | TConsole.Print(' ' + MenuItems[i].ShortcutKey + ') ' + MenuItems[i].Title + ' ', False);
120 | end;
121 |
122 | // Reset formatting
123 | TConsole.ResetTextFormat();
124 | end;
125 |
126 | // Draw footer
127 | TConsole.SetCursorPos(2, MENU_START_Y + MENU_ITEMS_COUNT + 2);
128 | TConsole.SetForegroundColor(CSIFGBrightBlack);
129 | TConsole.Print('Use ↑/↓ to navigate, Enter to select, Q to quit', False);
130 | TConsole.ResetTextFormat();
131 | end
132 | else
133 | begin
134 | // Selective update - Only redraw the items that changed
135 | // Redraw previous selection (now unselected)
136 | TConsole.SetCursorPos(2, MENU_START_Y + LastSelection);
137 | TConsole.SetForegroundColor(NORMAL_ITEM_COLOR);
138 | TConsole.Print(' ' + MenuItems[LastSelection].ShortcutKey + ') ' + MenuItems[LastSelection].Title + ' ', False);
139 | TConsole.ResetTextFormat();
140 |
141 | // Redraw new selection (now selected)
142 | TConsole.SetCursorPos(2, MENU_START_Y + CurrentSelection);
143 | TConsole.SetForegroundColor(SELECTED_ITEM_COLOR);
144 | TConsole.SetBackgroundColor(SELECTED_ITEM_BG);
145 | TConsole.Print(' → ' + MenuItems[CurrentSelection].ShortcutKey + ') ' + MenuItems[CurrentSelection].Title + ' ', False);
146 | TConsole.ResetTextFormat();
147 | end;
148 | end;
149 |
150 | // Initialize menu items
151 | procedure InitMenuItems();
152 | begin
153 | MenuItems[0].Title := 'Clock Display Demo';
154 | MenuItems[0].DemoType := dtClockDisplay;
155 | MenuItems[0].ShortcutKey := '1';
156 |
157 | MenuItems[1].Title := 'Dashboard Demo';
158 | MenuItems[1].DemoType := dtDashboard;
159 | MenuItems[1].ShortcutKey := '2';
160 |
161 | MenuItems[2].Title := 'Animation Player Demo';
162 | MenuItems[2].DemoType := dtAnimationPlayer;
163 | MenuItems[2].ShortcutKey := '3';
164 |
165 | MenuItems[3].Title := 'Bouncing Text Demo';
166 | MenuItems[3].DemoType := dtBouncingText;
167 | MenuItems[3].ShortcutKey := '4';
168 |
169 | MenuItems[4].Title := 'Wave Text Demo';
170 | MenuItems[4].DemoType := dtWaveText;
171 | MenuItems[4].ShortcutKey := '5';
172 |
173 | MenuItems[5].Title := 'Kaleidoscope Demo';
174 | MenuItems[5].DemoType := dtKaleidoscope;
175 | MenuItems[5].ShortcutKey := '6';
176 |
177 | MenuItems[6].Title := 'Fractal Tree Demo';
178 | MenuItems[6].DemoType := dtFractalTree;
179 | MenuItems[6].ShortcutKey := '7';
180 |
181 | MenuItems[7].Title := 'Rain Effect Demo';
182 | MenuItems[7].DemoType := dtRainEffect;
183 | MenuItems[7].ShortcutKey := '8';
184 |
185 | MenuItems[8].Title := 'Fire Effect Demo';
186 | MenuItems[8].DemoType := dtFireEffect;
187 | MenuItems[8].ShortcutKey := '9';
188 |
189 | MenuItems[9].Title := 'Particle System Demo';
190 | MenuItems[9].DemoType := dtParticleSystem;
191 | MenuItems[9].ShortcutKey := 'A';
192 |
193 | MenuItems[10].Title := 'Color Tunnel Demo';
194 | MenuItems[10].DemoType := dtColorTunnel;
195 | MenuItems[10].ShortcutKey := 'B';
196 |
197 | MenuItems[11].Title := 'Flowing Text Demo';
198 | MenuItems[11].DemoType := dtFlowingText;
199 | MenuItems[11].ShortcutKey := 'C';
200 |
201 | MenuItems[12].Title := 'Advanced Animations Demo';
202 | MenuItems[12].DemoType := dtAdvancedAnimations;
203 | MenuItems[12].ShortcutKey := 'D';
204 |
205 | MenuItems[13].Title := 'Advanced Effects Demo';
206 | MenuItems[13].DemoType := dtAdvancedEffects;
207 | MenuItems[13].ShortcutKey := 'E';
208 |
209 | MenuItems[14].Title := 'ASCII Buffer Demo';
210 | MenuItems[14].DemoType := dtAsciiBuffer;
211 | MenuItems[14].ShortcutKey := 'F';
212 |
213 | MenuItems[15].Title := 'Sprite Demo';
214 | MenuItems[15].DemoType := dtSprite;
215 | MenuItems[15].ShortcutKey := 'G';
216 |
217 | MenuItems[16].Title := 'Stellar Assault Demo';
218 | MenuItems[16].DemoType := dtStellarAssault;
219 | MenuItems[16].ShortcutKey := 'H';
220 |
221 | MenuItems[17].Title := 'Space Invaders Demo';
222 | MenuItems[17].DemoType := dtSpaceInvaders;
223 | MenuItems[17].ShortcutKey := 'I';
224 |
225 | MenuItems[18].Title := 'Stellar Defender Demo';
226 | MenuItems[18].DemoType := dtStellarDefender;
227 | MenuItems[18].ShortcutKey := 'J';
228 |
229 | MenuItems[19].Title := 'Pipe Write Demo';
230 | MenuItems[19].DemoType := dtPipeWrite;
231 | MenuItems[19].ShortcutKey := 'K';
232 |
233 | MenuItems[20].Title := 'Quit';
234 | MenuItems[20].DemoType := dtQuit;
235 | MenuItems[20].ShortcutKey := 'Q';
236 | end;
237 |
238 | // Run the selected demo
239 | procedure RunSelectedDemo();
240 | begin
241 | // Clear screen
242 | TConsole.ClearScreen();
243 | TConsole.ResetTextFormat();
244 |
245 | // Run the selected demo
246 | case MenuItems[CurrentSelection].DemoType of
247 | dtClockDisplay: Demo_ClockDisplay();
248 | dtDashboard: Demo_Dashboard();
249 | dtAnimationPlayer: Demo_AnimationPlayer();
250 | dtBouncingText: Demo_BouncingText();
251 | dtWaveText: Demo_WaveText();
252 | dtKaleidoscope: Demo_Kaleidoscope();
253 | dtFractalTree: Demo_FractalTree();
254 | dtRainEffect: Demo_RainEffect();
255 | dtFireEffect: Demo_FireEffect();
256 | dtParticleSystem: Demo_ParticleSystem();
257 | dtColorTunnel: Demo_ColorTunnel();
258 | dtFlowingText: Demo_FlowingText();
259 | dtAdvancedAnimations: Demo_AdvancedAnimations();
260 | dtAdvancedEffects: Demo_AdvancedEffects();
261 | dtAsciiBuffer: Demo_AsciiBuffer();
262 | dtSprite: Demo_Sprite();
263 | dtStellarAssault: Demo_StellarAssault();
264 | dtSpaceInvaders: Demo_SpaceInvaders();
265 | dtStellarDefender: Demo_StellarDefender();
266 | dtPipeWrite: Demo_PipeWrite();
267 | dtQuit:
268 | begin
269 | LDone := True;
270 | Exit;
271 | end;
272 | end;
273 |
274 | TConsole.ClearKeyStates();
275 |
276 | // Need to redraw the full menu after returning from a demo
277 | InitialDraw := True;
278 |
279 | TConsole.SetTitle(CMainMenuTitle);
280 | TConsole.HideCursor();
281 | end;
282 |
283 | // Process keyboard input
284 | procedure ProcessInput();
285 | var
286 | i: Integer;
287 | begin
288 | while not TConsole.AnyKeyPressed() do
289 | begin
290 | Sleep(50); // To reduce CPU usage
291 | end;
292 |
293 | // Save current selection to know what to redraw
294 | LastSelection := CurrentSelection;
295 |
296 | // Check arrow keys
297 | if TConsole.WasKeyPressed(VK_UP) then
298 | begin
299 | if CurrentSelection > 0 then
300 | begin
301 | Dec(CurrentSelection);
302 | // Selective redraw - only when selection changes
303 | DrawMenu(False);
304 | end;
305 | end
306 | else if TConsole.WasKeyPressed(VK_DOWN) then
307 | begin
308 | if CurrentSelection < MENU_ITEMS_COUNT-1 then
309 | begin
310 | Inc(CurrentSelection);
311 | // Selective redraw - only when selection changes
312 | DrawMenu(False);
313 | end;
314 | end
315 | else if TConsole.WasKeyPressed(VK_RETURN) then
316 | begin
317 | ClearInput();
318 | RunSelectedDemo();
319 | end
320 | else if TConsole.WasKeyPressed(Ord('Q')) or TConsole.WasKeyPressed(Ord('q')) then
321 | begin
322 | LDone := True;
323 | end
324 | else
325 | begin
326 | // Check for shortcut keys
327 | for i := 0 to MENU_ITEMS_COUNT-1 do
328 | begin
329 | // Check for both uppercase and lowercase of the shortcut key
330 | if TConsole.WasKeyPressed(Ord(MenuItems[i].ShortcutKey)) or
331 | TConsole.WasKeyPressed(Ord(LowerCase(MenuItems[i].ShortcutKey)[1])) then
332 | begin
333 | CurrentSelection := i;
334 | RunSelectedDemo();
335 | Break;
336 | end;
337 | end;
338 | end;
339 | end;
340 |
341 | begin
342 | TConsole.Init(CMainMenuTitle, POS_CENTER, POS_CENTER, 110, 30, 20);
343 | try
344 | // Initialize
345 | LDone := False;
346 | CurrentSelection := 0;
347 | LastSelection := 0;
348 | InitialDraw := True;
349 | InitMenuItems();
350 |
351 | // Hide cursor
352 | TConsole.HideCursor();
353 |
354 | // Main menu loop
355 | while not LDone do
356 | begin
357 | if InitialDraw then
358 | begin
359 | DrawMenu(True); // Full redraw
360 | InitialDraw := False;
361 | end;
362 | ProcessInput();
363 | end;
364 |
365 | // Clean up
366 | TConsole.ShowCursor();
367 | TConsole.ClearScreen();
368 | TConsole.ResetTextFormat();
369 | except
370 | TConsole.Shutdown();
371 | end;
372 |
373 | end;
374 |
375 | end.
376 |
377 |
--------------------------------------------------------------------------------
/media/console.jpg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/tinyBigGAMES/Console/8f1d28c961fc4b746cd12a83a11575c0838d5065/media/console.jpg
--------------------------------------------------------------------------------
/media/delphi.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/tinyBigGAMES/Console/8f1d28c961fc4b746cd12a83a11575c0838d5065/media/delphi.png
--------------------------------------------------------------------------------
/src/Console.Buffer.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 |
15 | ===============================================================================}
16 |
17 | unit Console.Buffer;
18 |
19 | {$I Console.Defines.inc}
20 |
21 | interface
22 |
23 | uses
24 | Winapi.Windows,
25 | System.SysUtils,
26 | System.Classes,
27 | Console,
28 | Console.Sprite;
29 |
30 | type
31 | { TAsciiChar }
32 | TAsciiChar = record
33 | Ch: WideChar;
34 | FGColor: string;
35 | BGColor: string;
36 | Changed: Boolean;
37 | end;
38 |
39 | { TAsciiBuffer }
40 | TAsciiBuffer = class
41 | private
42 | FWidth, FHeight: Integer;
43 | FBuffer: array of array of TAsciiChar;
44 | FOldBuffer: array of array of TAsciiChar;
45 | FDirty: Boolean;
46 | FTargetFPS: Integer;
47 | FLastFrameTime: Cardinal;
48 | FFrameDelay: Cardinal;
49 | FActualFPS: Single;
50 | FFrameCount: Integer;
51 | FFPSCountStartTime: Cardinal;
52 | procedure SwapBuffers;
53 | procedure UpdateFPSCounter;
54 | public
55 | constructor Create(const AWidth, AHeight: Integer);
56 | destructor Destroy; override;
57 | procedure Clear(const AChar: WideChar = ' '; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
58 | procedure PutChar(const X, Y: Integer; const Ch: WideChar; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
59 | procedure PutSprite(const X, Y: Integer; const ASprite: TAsciiSprite; const ATransparentChar: WideChar = #0);
60 | procedure SetFrameRate(const AFPS: Integer);
61 | function BeginFrame: Boolean;
62 | procedure EndFrame;
63 | function ElapsedTime: Cardinal;
64 | procedure Render;
65 | procedure DrawHLine(const X1, X2, Y: Integer; const Ch: WideChar; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
66 | procedure DrawVLine(const X, Y1, Y2: Integer; const Ch: WideChar; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
67 | procedure DrawRect(const X1, Y1, X2, Y2: Integer; const Ch: WideChar; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
68 | procedure FillRect(const X1, Y1, X2, Y2: Integer; const Ch: WideChar; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
69 | procedure PrintAt(const X, Y: Integer; const AText: string; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
70 | property Width: Integer read FWidth;
71 | property Height: Integer read FHeight;
72 | property TargetFPS: Integer read FTargetFPS write SetFrameRate;
73 | property ActualFPS: Single read FActualFPS;
74 | property FrameCount: Integer read FFrameCount;
75 | end;
76 |
77 | implementation
78 |
79 | { TAsciiBuffer }
80 | constructor TAsciiBuffer.Create(const AWidth, AHeight: Integer);
81 | var
82 | X, Y: Integer;
83 | begin
84 | inherited Create;
85 | FWidth := AWidth;
86 | FHeight := AHeight;
87 | FDirty := True;
88 |
89 | // Default frame rate
90 | FTargetFPS := 60;
91 | FFrameDelay := 1000 div FTargetFPS;
92 | FLastFrameTime := GetTickCount;
93 | FFPSCountStartTime := FLastFrameTime;
94 | FFrameCount := 0;
95 | FActualFPS := 0;
96 |
97 | // Allocate both buffers
98 | SetLength(FBuffer, FHeight, FWidth);
99 | SetLength(FOldBuffer, FHeight, FWidth);
100 |
101 | // Initialize both buffers
102 | for Y := 0 to FHeight - 1 do
103 | for X := 0 to FWidth - 1 do
104 | begin
105 | FBuffer[Y][X].Ch := ' ';
106 | FBuffer[Y][X].FGColor := CSIFGWhite;
107 | FBuffer[Y][X].BGColor := CSIBGBlack;
108 | FBuffer[Y][X].Changed := True;
109 |
110 | FOldBuffer[Y][X].Ch := #0; // Use null char to ensure initial render
111 | FOldBuffer[Y][X].FGColor := '';
112 | FOldBuffer[Y][X].BGColor := '';
113 | FOldBuffer[Y][X].Changed := False;
114 | end;
115 |
116 | // Initial clear screen
117 | TConsole.ClearScreen;
118 | end;
119 |
120 | destructor TAsciiBuffer.Destroy;
121 | begin
122 | FBuffer := nil;
123 | FOldBuffer := nil;
124 | inherited;
125 | end;
126 |
127 | procedure TAsciiBuffer.SetFrameRate(const AFPS: Integer);
128 | var
129 | LFPS: Integer;
130 | begin
131 | LFPS := AFPS;
132 | if LFPS < 1 then LFPS := 1;
133 | if LFPS > 240 then LFPS := 240;
134 | FTargetFPS := LFPS;
135 | FFrameDelay := 1000 div FTargetFPS;
136 | end;
137 |
138 | function TAsciiBuffer.BeginFrame: Boolean;
139 | var
140 | LCurrentTime, LDeltaTime: Cardinal;
141 | LSleepTime: Integer;
142 | begin
143 | // Check if enough time has passed for the next frame
144 | LCurrentTime := GetTickCount;
145 | LDeltaTime := LCurrentTime - FLastFrameTime;
146 |
147 | // If we've reached our frame delay, start a new frame
148 | Result := LDeltaTime >= FFrameDelay;
149 |
150 | if not Result then
151 | begin
152 | // Calculate optimal sleep time
153 | LSleepTime := FFrameDelay - LDeltaTime;
154 |
155 | // Use short sleep for more precise timing
156 | if LSleepTime > 3 then
157 | Sleep(1)
158 | else
159 | Sleep(0); // Yield time slice but return immediately
160 | end;
161 | end;
162 |
163 | function TAsciiBuffer.ElapsedTime: Cardinal;
164 | begin
165 | Result := GetTickCount - FLastFrameTime;
166 | end;
167 |
168 | procedure TAsciiBuffer.EndFrame;
169 | begin
170 | // Render the frame
171 | Render;
172 |
173 | // Update timing information
174 | FLastFrameTime := GetTickCount;
175 |
176 | // Update FPS counter
177 | Inc(FFrameCount);
178 | UpdateFPSCounter;
179 | end;
180 |
181 | procedure TAsciiBuffer.UpdateFPSCounter;
182 | var
183 | LCurrentTime: Cardinal;
184 | LElapsedSeconds: Single;
185 | begin
186 | LCurrentTime := GetTickCount;
187 |
188 | // Calculate FPS every half second
189 | if LCurrentTime - FFPSCountStartTime >= 500 then
190 | begin
191 | LElapsedSeconds := (LCurrentTime - FFPSCountStartTime) / 1000;
192 | FActualFPS := FFrameCount / LElapsedSeconds;
193 |
194 | // Reset counters
195 | FFrameCount := 0;
196 | FFPSCountStartTime := LCurrentTime;
197 | end;
198 | end;
199 |
200 | procedure TAsciiBuffer.Clear(const AChar: WideChar; const AFG, ABG: string);
201 | var
202 | X, Y: Integer;
203 | begin
204 | for Y := 0 to FHeight - 1 do
205 | for X := 0 to FWidth - 1 do
206 | begin
207 | if (FBuffer[Y][X].Ch <> AChar) or
208 | (FBuffer[Y][X].FGColor <> AFG) or
209 | (FBuffer[Y][X].BGColor <> ABG) then
210 | begin
211 | FBuffer[Y][X].Ch := AChar;
212 | FBuffer[Y][X].FGColor := AFG;
213 | FBuffer[Y][X].BGColor := ABG;
214 | FBuffer[Y][X].Changed := True;
215 | FDirty := True;
216 | end;
217 | end;
218 | end;
219 |
220 | procedure TAsciiBuffer.PutChar(const X, Y: Integer; const Ch: WideChar; const AFG, ABG: string);
221 | begin
222 | if (X < 0) or (X >= FWidth) or (Y < 0) or (Y >= FHeight) then
223 | Exit;
224 |
225 | if (FBuffer[Y][X].Ch <> Ch) or
226 | (FBuffer[Y][X].FGColor <> AFG) or
227 | (FBuffer[Y][X].BGColor <> ABG) then
228 | begin
229 | FBuffer[Y][X].Ch := Ch;
230 | FBuffer[Y][X].FGColor := AFG;
231 | FBuffer[Y][X].BGColor := ABG;
232 | FBuffer[Y][X].Changed := True;
233 | FDirty := True;
234 | end;
235 | end;
236 |
237 | procedure TAsciiBuffer.PutSprite(const X, Y: Integer; const ASprite: TAsciiSprite; const ATransparentChar: WideChar);
238 | var
239 | SX, SY, BX, BY: Integer;
240 | Ch: WideChar;
241 | begin
242 | // Render sprite to buffer
243 | for SY := 0 to ASprite.Height - 1 do
244 | begin
245 | BY := Y + SY;
246 | if (BY < 0) or (BY >= FHeight) then
247 | Continue;
248 |
249 | for SX := 0 to ASprite.Width - 1 do
250 | begin
251 | BX := X + SX;
252 | if (BX < 0) or (BX >= FWidth) then
253 | Continue;
254 |
255 | Ch := ASprite.GetChar(SX, SY);
256 |
257 | // Skip transparent characters
258 | if (Ch = ATransparentChar) then
259 | Continue;
260 |
261 | PutChar(BX, BY, Ch, ASprite.GetFGColor(SX, SY), ASprite.GetBGColor(SX, SY));
262 | end;
263 | end;
264 | end;
265 |
266 | procedure TAsciiBuffer.SwapBuffers;
267 | var
268 | X, Y: Integer;
269 | begin
270 | for Y := 0 to FHeight - 1 do
271 | for X := 0 to FWidth - 1 do
272 | begin
273 | FOldBuffer[Y][X] := FBuffer[Y][X];
274 | FBuffer[Y][X].Changed := False;
275 | end;
276 | FDirty := False;
277 | end;
278 |
279 | procedure TAsciiBuffer.Render;
280 | var
281 | X, Y: Integer;
282 | LLastFG, LLastBG: string;
283 | LCurrentLine: string;
284 | LHasChanges: Boolean;
285 | begin
286 | // Skip rendering if nothing has changed
287 | if not FDirty then
288 | Exit;
289 |
290 | // Hide cursor during render for better performance
291 | TConsole.SetCursorVisible(False);
292 |
293 | // Process each line
294 | for Y := 0 to FHeight - 1 do
295 | begin
296 | // Check if this line has any changes
297 | LHasChanges := False;
298 | for X := 0 to FWidth - 1 do
299 | begin
300 | if FBuffer[Y][X].Changed or
301 | (FBuffer[Y][X].Ch <> FOldBuffer[Y][X].Ch) or
302 | (FBuffer[Y][X].FGColor <> FOldBuffer[Y][X].FGColor) or
303 | (FBuffer[Y][X].BGColor <> FOldBuffer[Y][X].BGColor) then
304 | begin
305 | LHasChanges := True;
306 | Break;
307 | end;
308 | end;
309 |
310 | // Skip unchanged lines
311 | if not LHasChanges then
312 | Continue;
313 |
314 | // Build the entire line at once
315 | LCurrentLine := '';
316 | LLastFG := '';
317 | LLastBG := '';
318 |
319 | // Position cursor at start of line
320 | TConsole.SetCursorPos(0, Y);
321 |
322 | // Process characters for this line
323 | for X := 0 to FWidth - 1 do
324 | begin
325 | // If colors change, output what we have so far
326 | if (FBuffer[Y][X].FGColor <> LLastFG) or (FBuffer[Y][X].BGColor <> LLastBG) then
327 | begin
328 | // Output any accumulated text with previous colors
329 | if LCurrentLine <> '' then
330 | begin
331 | TConsole.Print(LCurrentLine);
332 | LCurrentLine := '';
333 | end;
334 |
335 | // Update colors and position
336 | if FBuffer[Y][X].FGColor <> LLastFG then
337 | begin
338 | TConsole.SetForegroundColor(FBuffer[Y][X].FGColor);
339 | LLastFG := FBuffer[Y][X].FGColor;
340 | end;
341 |
342 | if FBuffer[Y][X].BGColor <> LLastBG then
343 | begin
344 | TConsole.SetBackgroundColor(FBuffer[Y][X].BGColor);
345 | LLastBG := FBuffer[Y][X].BGColor;
346 | end;
347 |
348 | // Update cursor position to current position
349 | TConsole.SetCursorPos(X, Y);
350 | end;
351 |
352 | // Add character to current line
353 | LCurrentLine := LCurrentLine + FBuffer[Y][X].Ch;
354 | end;
355 |
356 | // Print any remaining text
357 | if LCurrentLine <> '' then
358 | TConsole.Print(LCurrentLine);
359 | end;
360 |
361 | // Swap buffers for next frame
362 | SwapBuffers;
363 |
364 | // Reset text formatting
365 | TConsole.ResetTextFormat;
366 | end;
367 |
368 | // Draw a horizontal line
369 | procedure TAsciiBuffer.DrawHLine(const X1, X2, Y: Integer; const Ch: WideChar; const AFG: string; const ABG: string);
370 | var
371 | X, LStartX, LEndX: Integer;
372 | begin
373 | // Ensure X1 <= X2
374 | if X1 > X2 then
375 | begin
376 | LStartX := X2;
377 | LEndX := X1;
378 | end
379 | else
380 | begin
381 | LStartX := X1;
382 | LEndX := X2;
383 | end;
384 |
385 | // Draw the line
386 | for X := LStartX to LEndX do
387 | PutChar(X, Y, Ch, AFG, ABG);
388 | end;
389 |
390 | // Draw a vertical line
391 | procedure TAsciiBuffer.DrawVLine(const X, Y1, Y2: Integer; const Ch: WideChar; const AFG: string; const ABG: string);
392 | var
393 | Y, LStartY, LEndY: Integer;
394 | begin
395 | // Ensure Y1 <= Y2
396 | if Y1 > Y2 then
397 | begin
398 | LStartY := Y2;
399 | LEndY := Y1;
400 | end
401 | else
402 | begin
403 | LStartY := Y1;
404 | LEndY := Y2;
405 | end;
406 |
407 | // Draw the line
408 | for Y := LStartY to LEndY do
409 | PutChar(X, Y, Ch, AFG, ABG);
410 | end;
411 |
412 | // Draw a rectangle (outline)
413 | procedure TAsciiBuffer.DrawRect(const X1, Y1, X2, Y2: Integer; const Ch: WideChar; const AFG: string; const ABG: string);
414 | begin
415 | // Draw horizontal lines
416 | DrawHLine(X1, X2, Y1, Ch, AFG, ABG);
417 | DrawHLine(X1, X2, Y2, Ch, AFG, ABG);
418 |
419 | // Draw vertical lines
420 | DrawVLine(X1, Y1, Y2, Ch, AFG, ABG);
421 | DrawVLine(X2, Y1, Y2, Ch, AFG, ABG);
422 | end;
423 |
424 | // Fill a rectangle area
425 | procedure TAsciiBuffer.FillRect(const X1, Y1, X2, Y2: Integer; const Ch: WideChar; const AFG: string; const ABG: string);
426 | var
427 | X, Y: Integer;
428 | LStartX, LEndX, LStartY, LEndY: Integer;
429 | begin
430 | // Ensure X1 <= X2 and Y1 <= Y2
431 | if X1 > X2 then
432 | begin
433 | LStartX := X2;
434 | LEndX := X1;
435 | end
436 | else
437 | begin
438 | LStartX := X1;
439 | LEndX := X2;
440 | end;
441 |
442 | if Y1 > Y2 then
443 | begin
444 | LStartY := Y2;
445 | LEndY := Y1;
446 | end
447 | else
448 | begin
449 | LStartY := Y1;
450 | LEndY := Y2;
451 | end;
452 |
453 | // Fill the rectangle
454 | for Y := LStartY to LEndY do
455 | for X := LStartX to LEndX do
456 | PutChar(X, Y, Ch, AFG, ABG);
457 | end;
458 |
459 | // Print text at position
460 | procedure TAsciiBuffer.PrintAt(const X, Y: Integer; const AText: string; const AFG: string; const ABG: string);
461 | var
462 | I: Integer;
463 | LCurX: Integer;
464 | begin
465 | LCurX := X;
466 |
467 | // Print each character
468 | for I := 1 to Length(AText) do
469 | begin
470 | // Skip out-of-bounds positions
471 | if (LCurX >= 0) and (LCurX < Width) and (Y >= 0) and (Y < Height) then
472 | PutChar(LCurX, Y, AText[I], AFG, ABG);
473 |
474 | // Move to next position
475 | Inc(LCurX);
476 | end;
477 | end;
478 |
479 | end.
480 |
--------------------------------------------------------------------------------
/src/Console.Defines.inc:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 |
15 | ===============================================================================}
16 |
17 | {$WARN SYMBOL_DEPRECATED OFF}
18 | {$WARN SYMBOL_PLATFORM OFF}
19 |
20 | {$WARN UNIT_PLATFORM OFF}
21 | {$WARN UNIT_DEPRECATED OFF}
22 |
23 | {$Z4}
24 | {$A8}
25 |
26 | {$INLINE AUTO}
27 |
28 | {$IFNDEF WIN64}
29 | {$MESSAGE Error 'Unsupported platform'}
30 | {$ENDIF}
31 |
32 | (*
33 | {$IF (CompilerVersion < 36.0)}
34 | {$IFNDEF WIN64}
35 | {$MESSAGE Error 'Must use Delphi 12 or higher'}
36 | {$ENDIF}
37 | {$IFEND}
38 | *)
39 |
--------------------------------------------------------------------------------
/src/Console.Sprite.pas:
--------------------------------------------------------------------------------
1 | {===============================================================================
2 | ___ _
3 | / __|___ _ _ ___ ___| |___™
4 | | (__/ _ \ ' \(_- _ \ / -_)
5 | \___\___/_||_/__/\___/_\___|
6 | Delphi CSI Console
7 |
8 | Copyright © 2025-present tinyBigGAMES™ LLC
9 | All Rights Reserved.
10 |
11 | https://github.com/tinyBigGAMES/Console
12 |
13 | See LICENSE file for license information
14 |
15 | ===============================================================================}
16 |
17 | unit Console.Sprite;
18 |
19 | {$I Console.Defines.inc}
20 |
21 | interface
22 |
23 | uses
24 | System.SysUtils,
25 | System.Classes,
26 | Console;
27 |
28 | type
29 | { TAsciiSprite }
30 | TAsciiSprite = class
31 | private
32 | FWidth, FHeight: Integer;
33 | FChars: array of array of WideChar;
34 | FFGColors: array of array of string;
35 | FBGColors: array of array of string;
36 | public
37 | constructor Create(const AWidth, AHeight: Integer);
38 | destructor Destroy; override;
39 | procedure SetChar(const X, Y: Integer; const Ch: WideChar; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
40 | procedure LoadFromString(const ASpriteStr: string; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
41 | property Width: Integer read FWidth;
42 | property Height: Integer read FHeight;
43 | function GetChar(const X, Y: Integer): WideChar;
44 | function GetFGColor(const X, Y: Integer): string;
45 | function GetBGColor(const X, Y: Integer): string;
46 | end;
47 |
48 | { TSpriteAnimation }
49 | TAsciiSpriteAnimation = class
50 | private
51 | FFrames: array of TAsciiSprite;
52 | FCurrentFrame: Integer;
53 | FFrameDelay: Integer;
54 | FFrameTimer: Integer;
55 | FLooping: Boolean;
56 | FFinished: Boolean;
57 | function GetCurrentFrame: TAsciiSprite;
58 | public
59 | constructor Create(const AFrameDelay: Integer; const ALooping: Boolean);
60 | destructor Destroy; override;
61 | procedure AddFrame(const ASprite: TAsciiSprite);
62 | procedure Update;
63 | procedure Reset;
64 | property CurrentFrame: TAsciiSprite read GetCurrentFrame;
65 | property Finished: Boolean read FFinished;
66 | end;
67 |
68 | implementation
69 |
70 | { TAsciiSprite }
71 | constructor TAsciiSprite.Create(const AWidth, AHeight: Integer);
72 | var
73 | X, Y: Integer;
74 | begin
75 | inherited Create;
76 | FWidth := AWidth;
77 | FHeight := AHeight;
78 |
79 | // Allocate sprite arrays
80 | SetLength(FChars, FHeight, FWidth);
81 | SetLength(FFGColors, FHeight, FWidth);
82 | SetLength(FBGColors, FHeight, FWidth);
83 |
84 | // Initialize with spaces
85 | for Y := 0 to FHeight - 1 do
86 | for X := 0 to FWidth - 1 do
87 | begin
88 | FChars[Y][X] := ' ';
89 | FFGColors[Y][X] := CSIFGWhite;
90 | FBGColors[Y][X] := CSIBGBlack;
91 | end;
92 | end;
93 |
94 | destructor TAsciiSprite.Destroy;
95 | begin
96 | FChars := nil;
97 | FFGColors := nil;
98 | FBGColors := nil;
99 | inherited;
100 | end;
101 |
102 | procedure TAsciiSprite.SetChar(const X, Y: Integer; const Ch: WideChar; const AFG: string; const ABG: string);
103 | begin
104 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
105 | begin
106 | FChars[Y][X] := Ch;
107 | FFGColors[Y][X] := AFG;
108 | FBGColors[Y][X] := ABG;
109 | end;
110 | end;
111 |
112 | procedure TAsciiSprite.LoadFromString(const ASpriteStr: string; const AFG: string = CSIFGWhite; const ABG: string = CSIBGBlack);
113 | var
114 | Lines: TStringList;
115 | X, Y: Integer;
116 | begin
117 | Lines := TStringList.Create;
118 | try
119 | Lines.Text := ASpriteStr;
120 |
121 | // Adjust sprite dimensions if needed
122 | if Lines.Count > FHeight then
123 | FHeight := Lines.Count;
124 |
125 | for Y := 0 to Lines.Count - 1 do
126 | if Length(Lines[Y]) > FWidth then
127 | FWidth := Length(Lines[Y]);
128 |
129 | // Reallocate if size changed
130 | SetLength(FChars, FHeight, FWidth);
131 | SetLength(FFGColors, FHeight, FWidth);
132 | SetLength(FBGColors, FHeight, FWidth);
133 |
134 | // Fill with spaces first
135 | for Y := 0 to FHeight - 1 do
136 | for X := 0 to FWidth - 1 do
137 | begin
138 | FChars[Y][X] := ' ';
139 | FFGColors[Y][X] := AFG;
140 | FBGColors[Y][X] := ABG;
141 | end;
142 |
143 | // Load characters from string
144 | for Y := 0 to Lines.Count - 1 do
145 | for X := 0 to Length(Lines[Y]) - 1 do
146 | begin
147 | if X < FWidth then
148 | begin
149 | FChars[Y][X] := Lines[Y][X+1];
150 | FFGColors[Y][X] := AFG;
151 | FBGColors[Y][X] := ABG;
152 | end;
153 | end;
154 | finally
155 | Lines.Free;
156 | end;
157 | end;
158 |
159 | function TAsciiSprite.GetChar(const X, Y: Integer): WideChar;
160 | begin
161 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
162 | Result := FChars[Y][X]
163 | else
164 | Result := ' ';
165 | end;
166 |
167 | function TAsciiSprite.GetFGColor(const X, Y: Integer): string;
168 | begin
169 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
170 | Result := FFGColors[Y][X]
171 | else
172 | Result := CSIFGWhite;
173 | end;
174 |
175 | function TAsciiSprite.GetBGColor(const X, Y: Integer): string;
176 | begin
177 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
178 | Result := FBGColors[Y][X]
179 | else
180 | Result := CSIBGBlack;
181 | end;
182 |
183 | { TSpriteAnimation }
184 | function TAsciiSpriteAnimation.GetCurrentFrame: TAsciiSprite;
185 | begin
186 | if (Length(FFrames) > 0) and (FCurrentFrame >= 0) and (FCurrentFrame < Length(FFrames)) then
187 | Result := FFrames[FCurrentFrame]
188 | else
189 | Result := nil;
190 | end;
191 |
192 | constructor TAsciiSpriteAnimation.Create(const AFrameDelay: Integer; const ALooping: Boolean);
193 | begin
194 | inherited Create;
195 | FFrameDelay := AFrameDelay;
196 | FLooping := ALooping;
197 | FCurrentFrame := 0;
198 | FFrameTimer := 0;
199 | FFinished := False;
200 | SetLength(FFrames, 0);
201 | end;
202 |
203 | destructor TAsciiSpriteAnimation.Destroy;
204 | var
205 | I: Integer;
206 | begin
207 | for I := 0 to Length(FFrames) - 1 do
208 | FFrames[I].Free;
209 | inherited;
210 | end;
211 |
212 | procedure TAsciiSpriteAnimation.AddFrame(const ASprite: TAsciiSprite);
213 | begin
214 | SetLength(FFrames, Length(FFrames) + 1);
215 | FFrames[Length(FFrames) - 1] := ASprite;
216 | end;
217 |
218 | procedure TAsciiSpriteAnimation.Update;
219 | begin
220 | if (Length(FFrames) = 0) or FFinished then
221 | Exit;
222 |
223 | Inc(FFrameTimer);
224 |
225 | if FFrameTimer >= FFrameDelay then
226 | begin
227 | FFrameTimer := 0;
228 | Inc(FCurrentFrame);
229 |
230 | if FCurrentFrame >= Length(FFrames) then
231 | begin
232 | if FLooping then
233 | FCurrentFrame := 0
234 | else
235 | begin
236 | FCurrentFrame := Length(FFrames) - 1;
237 | FFinished := True;
238 | end;
239 | end;
240 | end;
241 | end;
242 |
243 | procedure TAsciiSpriteAnimation.Reset;
244 | begin
245 | FCurrentFrame := 0;
246 | FFrameTimer := 0;
247 | FFinished := False;
248 | end;
249 |
250 |
251 | end.
252 |
--------------------------------------------------------------------------------